tests: do not hard code HTTP ports

Previously, test cases could fail if some process was listening
at a hard-coded port.  This patch eliminates most of these potential
failures, by automatically assigning an unbound port.  This should
allow for building multiple guix trees in parallel outside a build
container, though this is currently untested.

The test "home-page: Connection refused" in tests/lint.scm still
hardcodes port 9999, however.

* guix/tests/http.scm
  (http-server-can-listen?): remove now unused procedure.
  (%http-server-port): default to port 0, meaning the OS
  will automatically choose a port.
  (open-http-server-socket): remove the false statement claiming
  this procedure is exported and also return the allocated port
  number.
  (%local-url): raise an error if the port is obviously unbound.
  (call-with-http-server): set %http-server-port to the allocated
  port while the thunk is called.
* tests/derivations.scm: adjust test cases to use automatically
  assign a port.  As there is no risk of a port conflict now,
  do not make any tests conditional upon 'http-server-can-listen?'
  anymore.
* tests/elpa.scm: likewise.
* tests/lint.scm: likewise, and add a TODO comment about a port
  that is still hard-coded.
* tests/texlive.scm: likewise.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

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 ()