From e88c86ac6ccfffcc6fa5f3cbd2d5ec5178421763 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Mon, 1 Feb 2021 14:28:03 +0100
Subject: [PATCH 4/4] tests: publish: don't bind the test server to a port.
This way, multiple instances of 'make check TESTS=tests/publish.scm'
can be run in parallel. Also, there's no risk of the ports used
in this test conflicting with ports assigned to system services
anymore. This also prevents any potential future conflicts
with ports used by other tests that would lead to nondeterministic
test failures when parallel tests are enabled.
* guix/scripts/publish.scm
(when-bound): new parameter for communicating with
tests/publish.scm.
(guix-publish): inform tests/publish.scm about the port
the server socket was bound to via 'when-bound'. Also
correctly log to which port the server was bound.
* tests/publish.scm
(spawn-guix-publish): remove 'port' argument, ask "guix publish"
not to explicitely bind the server socket to a port and add the
port it was implicitely bound to, to the return values.
(call-with-guix-publish): adjust call to 'spawn-guix-publish'.
Also adjust the code to spawn the first server and 'publish-uri'
to the new semantics of 'spawn-guix-publish'.
---
guix/scripts/publish.scm | 34 +++++++++++++++++++----
tests/publish.scm | 58 +++++++++++++++++++++++-----------------
2 files changed, 63 insertions(+), 29 deletions(-)
@@ -3,6 +3,7 @@
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -75,7 +76,9 @@
open-server-socket
publish-service-type
run-publish-server
- guix-publish))
+ guix-publish
+
+ when-bound))
(define (show-help)
(format #t (G_ "Usage: guix publish [OPTION]...
@@ -116,6 +119,19 @@ Publish ~a over HTTP.\n") %store-directory)
(newline)
(show-bug-report-information))
+;; When testing, ideally the server isn't explicitly bound to
+;; any particular port, to avoid conflicts with other software,
+;; and to be able "make check" multiple Guix checkouts in parallel.
+;;
+;; While these conflicts won't appear in the build container,
+;; they can still be annoying when a developer is testing
+;; something *outside* a network container.
+;;
+;; When this parameter's value is not false, it is a procedure
+;; accepting the port number the server was (implicitly) bound
+;; to (by the kernel).
+(define when-bound (make-parameter #f))
+
(define (getaddrinfo* host)
"Like 'getaddrinfo', but properly report errors."
(catch 'getaddrinfo-error
@@ -1125,7 +1141,7 @@ methods, return the applicable compression."
%default-options))
(advertise? (assoc-ref opts 'advertise?))
(user (assoc-ref opts 'user))
- (port (assoc-ref opts 'port))
+ (requested-port (assoc-ref opts 'port))
(ttl (assoc-ref opts 'narinfo-ttl))
(compressions (match (filter-map (match-lambda
(('compression . compression)
@@ -1139,8 +1155,13 @@ methods, return the applicable compression."
(address (let ((addr (assoc-ref opts 'address)))
(make-socket-address (sockaddr:fam addr)
(sockaddr:addr addr)
- port)))
+ requested-port)))
(socket (open-server-socket address))
+ ;; If requested-port = 0, then the kernel
+ ;; will automatically assign a free port number.
+ (port (if (= 0 requested-port)
+ (sockaddr:port (getsockname socket))
+ requested-port))
(nar-path (assoc-ref opts 'nar-path))
(repl-port (assoc-ref opts 'repl))
(cache (assoc-ref opts 'cache))
@@ -1151,6 +1172,10 @@ methods, return the applicable compression."
(public-key (read-file-sexp (assoc-ref opts 'public-key-file)))
(private-key (read-file-sexp (assoc-ref opts 'private-key-file))))
+ ;; Inform tests/publish.scm about the port number used.
+ (let ((proc (when-bound)))
+ (when proc (proc port)))
+
(when user
;; Now that we've read the key material and opened the socket, we can
;; drop privileges.
@@ -1167,8 +1192,7 @@ consider using the '--user' option!~%")))
(cache-bypass-threshold))))
(info (G_ "publishing ~a on ~a, port ~d~%")
%store-directory
- (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
- (sockaddr:port address))
+ (inet-ntop (sockaddr:fam address) (sockaddr:addr address)) port)
(for-each (lambda (compression)
(info (G_ "using '~a' compression method, level ~a~%")
@@ -46,6 +46,7 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-8)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (ice-9 threads)
@@ -80,9 +81,6 @@
;; (PORT might be a custom binary input port).
port))))
-(define (publish-uri route)
- (string-append "http://localhost:6789" route))
-
(define-syntax-rule (with-separate-output-ports exp ...)
;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and
;; error ports to make sure the two threads don't end up stepping on each
@@ -94,29 +92,41 @@
exp ...)))))
;; Run local publishing servers in a separate thread.
-;; Attempt to avoid port collision by choosing ports
-;; unlikely to be used in the wild (6789 and higher)
-(define (spawn-guix-publish port . extra-arguments)
+(define (spawn-guix-publish . extra-arguments)
"Run a local publishing server in a separate thread.
-The server will listen at PORT. EXTRA-ARGUMENTS are
-passed as-is as extra command-line arguments.
-The resulting thread is returned."
- (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (apply guix-publish (format #f "--port=~a" port) extra-arguments)))))
-
-;; Keep track of port numbers, to avoid multiple
-;; servers listening at the same port.
-(define *latest-port* 6789)
+The port number will automatically be assigned.
+EXTRA-ARGUMENTS are passed as-is as extra command-line
+arguments. The resulting port number and thread is returned."
+ (let ((*port* #f) ; protected by port-mutex
+ (port-mutex (make-mutex))
+ ;; Condition variable for signalling / checking whether
+ ;; *port* is set / can be read.
+ (port-bound (make-condition-variable)))
+ (define (when-bound-proc port)
+ (with-mutex port-mutex (set! *port* port))
+ (signal-condition-variable port-bound))
+ (let ((thread
+ (parameterize ((when-bound when-bound-proc))
+ (with-separate-output-ports
+ (call-with-new-thread
+ (lambda ()
+ ;; --port=0: automatically assign a port
+ (apply guix-publish "--port=0" extra-arguments)))))))
+ ;; A loop is required in case of spurious wakeups.
+ (with-mutex port-mutex
+ (let loop ()
+ (if *port*
+ (values *port* thread)
+ (begin
+ (wait-condition-variable port-bound port-mutex)
+ (loop))))))))
(define (call-with-guix-publish extra-arguments proc)
"Call PROC in an environment where a local publishing service
is running in a separate thread, passing the port listened at.
EXTRA-ARGUMENTS are passed as-is as extra command-line arguments."
- (let* ((port (1+ *latest-port*))
- (thread (apply spawn-guix-publish port extra-arguments)))
- (set! *latest-port* port)
+ (receive (port thread)
+ (apply spawn-guix-publish extra-arguments)
(wait-until-ready port)
(proc port)))
@@ -124,7 +134,10 @@ EXTRA-ARGUMENTS are passed as-is as extra command-line arguments."
(call-with-guix-publish extra-arguments
(lambda (port) exp ...)))
-(spawn-guix-publish 6789 "-C0")
+(define first-server (spawn-guix-publish "-C0"))
+
+(define (publish-uri route)
+ (format #f "http://localhost:~a~a" first-server route))
(define (wait-until-ready port)
;; Wait until the server is accepting connections.
@@ -150,9 +163,6 @@ EXTRA-ARGUMENTS are passed as-is as extra command-line arguments."
;; Magic bytes of gzip file.
#vu8(#x1f #x8b))
-;; Wait until the two servers are ready.
-(wait-until-ready 6789)
-
;; Initialize the public/private key SRFI-39 parameters.
(%public-key (read-file-sexp %public-key-file))
(%private-key (read-file-sexp %private-key-file))
--
2.30.0