Move code for finding an available socket.

3 files changed, 56 insertions, 57 deletions

diff --git a/module/calp/server/server.scm b/module/calp/server/server.scm
index 04d33ba5..4c5a0886 100644
--- a/module/calp/server/server.scm
+++ b/module/calp/server/server.scm
@@ -4,29 +4,13 @@
   :use-module ((calp server routes) :select (make-make-routes))
   :use-module (ice-9 threads)
   :use-module (srfi srfi-88)
+  :use-module (calp server socket)
 
   :export (start-server))
 
 ;;; TODO Do I really want this hardcoded here?
 (define handler (make-make-routes))
 
-;; NOTE The default make-default-socket is broken for IPv6.
-;; A patch has been submitted to the mailing list. 2020-03-31
-;;
-;; This sets up the socket manually, and sends that to @code{http-open}.
-(define* (make-default-socket/fixed family addr port)
-  (let ((sock (socket family SOCK_STREAM 0)))
-    (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
-    (bind sock family addr port)
-    sock))
-
-(define* (setup-socket key:
-                       (host #f)
-                       (family AF_INET)
-                       (addr (if host (inet-pton family host)
-                                 INADDR_LOOPBACK))
-                       (port 8080))
-  (make-default-socket/fixed family addr port))
 
 (define (start-server open-params)
   (run-server handler
diff --git a/module/calp/server/socket.scm b/module/calp/server/socket.scm
new file mode 100644
index 00000000..990adfa6
--- /dev/null
+++ b/module/calp/server/socket.scm
@@ -0,0 +1,48 @@
+(define-module (calp server socket)
+  :use-module (srfi srfi-88)
+  :use-module (web server)
+  :export (setup-socket
+           run-at-any-port)
+  )
+
+;; NOTE The default make-default-socket is broken for IPv6.
+;; A patch has been submitted to the mailing list. 2020-03-31
+;;
+;; This sets up the socket manually, and sends that to @code{http-open}.
+(define* (make-default-socket/fixed family addr port)
+  (let ((sock (socket family SOCK_STREAM 0)))
+    (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+    (bind sock family addr port)
+    sock))
+
+(define* (setup-socket key:
+                       (host #f)
+                       (family AF_INET)
+                       (addr (if host (inet-pton family host)
+                                 INADDR_LOOPBACK))
+                       (port 8080))
+  (make-default-socket/fixed family addr port))
+
+
+(define* (run-at-any-port handler key:
+                          (min-port 8081)
+                          msg-port)
+  (unless msg-port
+    (scm-error 'misc-error "run-at-any-port"
+               "msg-port required"
+               '() #f))
+  (let loop ((port min-port))
+    (catch 'system-error
+      (lambda ()
+        (let ((socket (setup-socket port: port)))
+          (let ((addr (format #f "http://localhost:~a~%" port)))
+            (display addr msg-port)
+            (force-output msg-port)
+            (format #t "Server started at ~s~%" addr)
+            (run-server handler 'http
+                        `(socket: ,socket))
+            (format #t "Server closed~%"))))
+      (lambda (err proc fmt args data)
+        (if (= EADDRINUSE (car data))
+            (loop (1+ port))
+            (apply throw err proc fmt args data))))))
diff --git a/tests/litmus.scm b/tests/litmus.scm
index 11d5fd9e..477c5946 100755
--- a/tests/litmus.scm
+++ b/tests/litmus.scm
@@ -8,9 +8,9 @@ exec $GUILE -e main -s "$0" "$@"
 !#
 
 (use-modules (calp server webdav)
+             (calp server socket)
              (ice-9 threads)
              (ice-9 rdelim)
-             (web server)
              (srfi srfi-1)
              (srfi srfi-88))
 
@@ -23,48 +23,15 @@ exec $GUILE -e main -s "$0" "$@"
 ;;; Code:
 
 
-;;; NOTE this "page" is borrowed from (calp server server).
-;;; Possibly rewrite so that module actually works as a module,
-;;; And import it here
-
-
-;; NOTE The default make-default-socket is broken for IPv6.
-;; A patch has been submitted to the mailing list. 2020-03-31
-;;
-;; This sets up the socket manually, and sends that to @code{http-open}.
-(define* (make-default-socket/fixed family addr port)
-  (let ((sock (socket family SOCK_STREAM 0)))
-    (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
-    (bind sock family addr port)
-    sock))
-
-(define* (setup-socket key:
-                       (host #f)
-                       (family AF_INET)
-                       (addr (if host (inet-pton family host)
-                                 INADDR_LOOPBACK))
-                       (port 8080))
-  (make-default-socket/fixed family addr port))
-
-
 
 (define (start-server out)
   (begin-thread
-   (let loop ((port 8102))
-     (catch 'system-error
-       (lambda ()
-         (let ((socket (setup-socket port: port)))
-           (format out "http://localhost:8102~%")
-           (force-output out)
-           (with-error-to-file "webdav.log"
-             (lambda ()
-               (run-server webdav-handler 'http
-                           `(socket: ,socket))))
-           (format #t "Server closed~%")))
-       (lambda (err proc fmt args data)
-         (if (= EADDRINUSE (car data))
-             (loop (1+ port))
-             (apply throw err proc fmt args data)))))))
+   (with-error-to-file "webdav.log"
+     (lambda ()
+       (run-at-any-port
+        webdav-handler
+        min-port: 8102
+        msg-port: out)))))
 
 
 (define (main args)