From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Wed, 28 Apr 2021 12:44:30 +0000 (+0200)
Subject: Minor fix to send-network-message.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=sam.git;a=commitdiff_plain;h=b44160ac2c32648bf4728b10f83b2853300c5735

Minor fix to send-network-message.
---

diff --git a/sam.scm b/sam.scm
index 8e8a730..511b953 100644
--- a/sam.scm
+++ b/sam.scm
@@ -25,6 +25,9 @@
             #:port port
             #:path (list '/ id)))
 
+(define address->string uri->string)
+(define string->address uri-reference)
+
 (define (make-local-address . args)
   (make-address this-host
                 this-port
@@ -77,12 +80,15 @@
 
 (define (send-network-message address . message)
   (let ((s (udp-open-socket))
-        (machine (address-machine address)))
+        (machine (address-machine address))
+        (packet (with-output-to-string)
+               (lambda ()
+                 (print (cons (address->string address) message)))))
     (udp-bind! s #f 0)
     (udp-connect! s
                   (machine-host machine)
                   (machine-port machine))
-    (udp-send s message)
+    (udp-send s packet)
     (udp-close-socket s)))
 
 (define (next-local-message)
@@ -147,8 +153,8 @@
          (let-values (((n str) (udp-recv s 1024)))
            (print "Received " n " bytes over network: " str)
            (match (with-input-from-string str read)
-             ((uri-str message ...)
-              (apply send-message (cons (uri-reference uri-str) message)))
+             ((addr-str message ...)
+              (apply send-message (cons (string->address addr-str) message)))
              (else
               (print "Warning: received badly formatted message string '" str "'"))))
          (loop))))))
@@ -188,4 +194,21 @@
 (start-network-listener)
 (start-console)
 
+(define (boot-sam host port)
+  (start-scheduler))
+
 ;; (thread-join! scheduler-thread)
+
+(define (main)
+  (let loop ((args (cdr (argv)))
+             (host "localhost")
+             (port 8000))
+    (match args
+      ((or "-h" "--help")
+       (print-usage))
+      (((or "-p" "--port") pstr rest ...)
+       (loop rest host (string->number pstr)))
+      (("--hostname" hstr rest ...)
+       (loop rest hstr port))
+      (()
+       (boot-sam host port)))))