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 /tests | |
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 '')
-rwxr-xr-x | tests/litmus.scm | 47 |
1 files changed, 7 insertions, 40 deletions
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) |