diff options
Diffstat (limited to 'guix/tests/http.scm')
| -rw-r--r-- | guix/tests/http.scm | 38 |
1 files changed, 21 insertions, 17 deletions
diff --git a/guix/tests/http.scm b/guix/tests/http.scm index 4119e9ce01..8f50eaefca 100644 --- a/guix/tests/http.scm +++ b/guix/tests/http.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,12 +22,12 @@ #:use-module (web server) #:use-module (web server http) #:use-module (web response) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-39) #:use-module (ice-9 match) #:export (with-http-server call-with-http-server %http-server-port - http-server-can-listen? %local-url)) ;;; Commentary: @@ -37,12 +38,13 @@ (define %http-server-port ;; TCP port to use for the stub HTTP server. - (make-parameter 9999)) + ;; If 0, the OS will automatically choose + ;; a port. + (make-parameter 0)) (define (open-http-server-socket) - "Return a listening socket for the web server. It is useful to export it so -that tests can check whether we succeeded opening the socket and tests skip if -needed." + "Return a listening socket for the web server and the port +actually listened at (in case %http-server-port was 0)." (catch 'system-error (lambda () (let ((sock (socket PF_INET SOCK_STREAM 0))) @@ -50,22 +52,18 @@ needed." (bind sock (make-socket-address AF_INET INADDR_LOOPBACK (%http-server-port))) - sock)) + (values sock + (sockaddr:port (getsockname sock))))) (lambda args (let ((err (system-error-errno args))) (format (current-error-port) "warning: cannot run Web server for tests: ~a~%" (strerror err)) - #f)))) - -(define (http-server-can-listen?) - "Return #t if we managed to open a listening socket." - (and=> (open-http-server-socket) - (lambda (socket) - (close-port socket) - #t))) + (values #f #f))))) (define* (%local-url #:optional (port (%http-server-port))) + (when (= port 0) + (error "no web server is running!")) ;; URL to use for 'home-page' tests. (string-append "http://localhost:" (number->string port) "/foo/bar")) @@ -73,7 +71,10 @@ needed." (define* (call-with-http-server responses+data thunk) "Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP requests. Each element of RESPONSES+DATA must be a tuple containing a -response and a string, or an HTTP response code and a string." +response and a string, or an HTTP response code and a string. + +%http-server-port will be set to the port listened at +The port listened at will be set for the dynamic extent of THUNK." (define responses (map (match-lambda (((? response? response) data) @@ -100,6 +101,7 @@ response and a string, or an HTTP response code and a string." ;; Mutex and condition variable to synchronize with the HTTP server. (define %http-server-lock (make-mutex)) (define %http-server-ready (make-condition-variable)) + (define %http-real-server-port #f) (define (http-open . args) "Start listening for HTTP requests and signal %HTTP-SERVER-READY." @@ -122,7 +124,8 @@ response and a string, or an HTTP response code and a string." (set! responses rest) (values response data)))) - (let ((socket (open-http-server-socket))) + (let-values (((socket port) (open-http-server-socket))) + (set! %http-real-server-port port) (catch 'quit (lambda () (run-server handle stub-http-server @@ -134,7 +137,8 @@ response and a string, or an HTTP response code and a string." (let ((server (make-thread server-body))) (wait-condition-variable %http-server-ready %http-server-lock) ;; Normally SERVER exits automatically once it has received a request. - (thunk)))) + (parameterize ((%http-server-port %http-real-server-port)) + (thunk))))) (define-syntax with-http-server (syntax-rules () |