diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-04-18 18:39:17 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-04-18 18:39:17 +0200 |
commit | 44bc2fce13048396c1aa002f4eb6fa7b76db796b (patch) | |
tree | 072bbda518fd93247f50e00b3f037502f4861c3c /module | |
parent | Move test runner to library. (diff) | |
download | calp-44bc2fce13048396c1aa002f4eb6fa7b76db796b.tar.gz calp-44bc2fce13048396c1aa002f4eb6fa7b76db796b.tar.xz |
Move code for finding an available socket.
Diffstat (limited to 'module')
-rw-r--r-- | module/calp/server/server.scm | 18 | ||||
-rw-r--r-- | module/calp/server/socket.scm | 48 |
2 files changed, 49 insertions, 17 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)))))) |