Fix IPv6-binding without hot-patching guile.

The previous hotpatching worked fine in Guile-2.2, but not in Guile-3.0.
Probably due to the higher level of optimizations now applied.

1 files changed, 23 insertions, 15 deletions

diff --git a/module/calp/server/server.scm b/module/calp/server/server.scm
index 814aaed7..f2d58337 100644
--- a/module/calp/server/server.scm
+++ b/module/calp/server/server.scm
@@ -3,28 +3,36 @@
   :use-module (web server)
   :use-module ((calp server routes) :select (make-make-routes))
   :use-module (ice-9 threads)
+  :use-module (srfi srfi-88)
 
   :export (start-server))
 
-;; NOTE The default make-default-socket is broken for IPv6.
-;; A patch has been submitted to the mailing list. 2020-03-31
-(module-set!
- (resolve-module '(web server http))
- 'make-default-socket
- (lambda (family addr port)
-   (let ((sock (socket family SOCK_STREAM 0)))
-     (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
-     (bind sock family addr port)
-     sock)))
-
 (define handler (make-make-routes))
 
-;; (define impl (lookup-server-impl 'http))
-;; (define server (open-server impl open-params))
-
+;; 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 'http open-params 1)
+  (run-server handler
+              'http
+              (append open-params
+                      `(socket: ,(apply setup-socket open-params)))
+              1)
   ;; NOTE at first this seems to work, but it quickly deteriorates.
   ;; (for i in (iota 16)
   ;;      (begin-thread