From 3548be9cb7b862b04defad080a80c85311475c06 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 31 Jan 2021 22:53:04 +0100
Subject: [PATCH 3/3] tests: publish: automatically keep track of port numbers
This way, there's no risk of accidentally reusing a
port number used by another test. This changes the
workings of the "/*.narinfo for a compressed file" test
a little, by not reusing the port from the test
"/*.narinfo with compression".
* tests/publish.scm
(*latest-port*, call-with-guix-publish, with-guix-publish):
automatically assign port numbers, and change tests to
use the new calling rules.
---
tests/publish.scm | 84 +++++++++++++++++++++++++----------------------
1 file changed, 45 insertions(+), 39 deletions(-)
@@ -106,17 +106,23 @@ The resulting thread is returned."
(lambda ()
(apply guix-publish (format #f "--port=~a" port) extra-arguments)))))
-(define (call-with-guix-publish port extra-arguments thunk)
- "Call THUNK in an environment where a local publishing service
-is running in a separate thread, listening at PORT. EXTRA-ARGUMENTS
-are passed as-is as extra command-line arguments."
- (let ((thread (apply spawn-guix-publish port extra-arguments)))
+;; Keep track of port numbers, to avoid multiple
+;; servers listening at the same port.
+(define *latest-port* 6789)
+
+(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)
(wait-until-ready port)
- (thunk)))
+ (proc port)))
(define-syntax-rule (with-guix-publish port extra-arguments exp ...)
- (call-with-guix-publish port extra-arguments
- (lambda () exp ...)))
+ (call-with-guix-publish extra-arguments
+ (lambda (port) exp ...)))
(spawn-guix-publish 6789 "-C0")
@@ -279,9 +285,9 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))
("Compression" . "gzip"))
- (with-guix-publish 6799 '("-C5")
- (let* ((url (string-append "http://localhost:6799/"
- (store-path-hash-part %item) ".narinfo"))
+ (with-guix-publish port '("-C5")
+ (let* ((url (format #f "http://localhost:~a/~a.narinfo" port
+ (store-path-hash-part %item)))
(body (http-get-port url)))
(filter (lambda (item)
(match item
@@ -295,9 +301,9 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/lzip/" (basename %item)))
("Compression" . "lzip"))
- (with-guix-publish 6790 '("-Clzip")
- (let* ((url (string-append "http://localhost:6790/"
- (store-path-hash-part %item) ".narinfo"))
+ (with-guix-publish port '("-Clzip")
+ (let* ((url (format #f "http://localhost:~a/~a.narinfo" port
+ (store-path-hash-part %item)))
(body (http-get-port url)))
(filter (lambda (item)
(match item
@@ -309,15 +315,15 @@ References: ~%"
(test-equal "/*.narinfo for a compressed file"
'("none" "nar") ;compression-less nar
- ;; Assume 'guix publish -C' is already running on port 6799.
- (let* ((item (add-text-to-store %store "fake.tar.gz"
- "This is a fake compressed file."))
- (url (string-append "http://localhost:6799/"
- (store-path-hash-part item) ".narinfo"))
- (body (http-get-port url))
- (info (recutils->alist body)))
- (list (assoc-ref info "Compression")
- (dirname (assoc-ref info "URL")))))
+ (with-guix-publish port '("-C5")
+ (let* ((item (add-text-to-store %store "fake.tar.gz"
+ "This is a fake compressed file."))
+ (url (format #f "http://localhost:~a/~a.narinfo" port
+ (store-path-hash-part item)))
+ (body (http-get-port url))
+ (info (recutils->alist body)))
+ (list (assoc-ref info "Compression")
+ (dirname (assoc-ref info "URL"))))))
(test-equal "/*.narinfo with lzip + gzip"
`((("StorePath" . ,%item)
@@ -329,8 +335,8 @@ References: ~%"
200)
(call-with-temporary-directory
(lambda (cache)
- (with-guix-publish 6793 '("-Cgzip:2" "-Clzip:2")
- (let* ((base "http://localhost:6793/")
+ (with-guix-publish port '("-Cgzip:2" "-Clzip:2")
+ (let* ((base (format #f "http://localhost:~a/" port))
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
(body (http-get-port url)))
@@ -349,8 +355,8 @@ References: ~%"
("Compression" . "none"))
200
404)
- (with-guix-publish 6798 '("-C0" "--nar-path=///foo/bar//chbouib/")
- (let* ((base "http://localhost:6798/")
+ (with-guix-publish port '("-C0" "--nar-path=///foo/bar//chbouib/")
+ (let* ((base (format #f "http://localhost:~a/" port))
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
(nar-url (string-append base "foo/bar/chbouib/"
@@ -430,9 +436,9 @@ References: ~%"
404) ;nar/…
(call-with-temporary-directory
(lambda (cache)
- (with-guix-publish 6797 `("-C2" ,(string-append "--cache=" cache)
+ (with-guix-publish port `("-C2" ,(string-append "--cache=" cache)
"--cache-bypass-threshold=0")
- (let* ((base "http://localhost:6797/")
+ (let* ((base (format #f "http://localhost:~a/" port))
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
(nar-url (string-append base "nar/gzip/" (basename %item)))
@@ -480,10 +486,10 @@ References: ~%"
'(200 200 404)
(call-with-temporary-directory
(lambda (cache)
- (with-guix-publish 6794 `("-Cgzip:2" "-Clzip:2"
+ (with-guix-publish port `("-Cgzip:2" "-Clzip:2"
,(string-append "--cache=" cache)
"--cache-bypass-threshold=0")
- (let* ((base "http://localhost:6794/")
+ (let* ((base (format #f "http://localhost:~a/" port))
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
(nar-url (cute string-append "nar/" <> "/"
@@ -532,10 +538,10 @@ References: ~%"
404) ;nar/gzip/…
(call-with-temporary-directory
(lambda (cache)
- (with-guix-publish 6796 `("-C2" "--ttl=42h"
+ (with-guix-publish port `("-C2" "--ttl=42h"
,(string-append "--cache=" cache)
"--cache-bypass-threshold=0")
- (let* ((base "http://localhost:6796/")
+ (let* ((base (format #f "http://localhost:~a/" port))
(part (store-path-hash-part item))
(url (string-append base part ".narinfo"))
(cached (string-append cache "/none/"
@@ -580,11 +586,11 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (with-guix-publish 6795 (list (string-append "--cache=" cache))
+ (with-guix-publish port (list (string-append "--cache=" cache))
;; Make sure that, even if ITEM disappears, we're still able to fetch
;; it.
- (let* ((base "http://localhost:6795/")
+ (let* ((base (format #f "http://localhost:~a/" port))
(item (add-text-to-store %store "random" (random-text)))
(part (store-path-hash-part item))
(url (string-append base part ".narinfo"))
@@ -602,9 +608,9 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (with-guix-publish 6788 `("-C" "gzip" "-C" "gzip"
+ (with-guix-publish port `("-C" "gzip" "-C" "gzip"
,(string-append "--cache=" cache))
- (let* ((base "http://localhost:6788/")
+ (let* ((base (format #f "http://localhost:~a/" port))
(item (add-text-to-store %store "random" (random-text)))
(part (store-path-hash-part item))
(narinfo (string-append base part ".narinfo"))
@@ -633,9 +639,9 @@ References: ~%"
;; for a non-existing file name.
(call-with-temporary-directory
(lambda (cache)
- (with-guix-publish 6787 `("-C" "gzip" ,(string-append "--cache=" cache))
+ (with-guix-publish port `("-C" "gzip" ,(string-append "--cache=" cache))
- (let* ((base "http://localhost:6787/")
+ (let* ((base (format #f "http://localhost:~a/" port))
(item (add-text-to-store %store "random" (random-text)))
(part (store-path-hash-part item))
(narinfo (string-append base part ".narinfo"))
--
2.30.0