* [bug#46216] [PATCH] Remove duplication in tests/publish.scm
2021-01-31 18:46 [bug#46216] [PATCH] Remove duplication in tests/publish.scm Maxime Devos
@ 2021-01-31 18:52 ` Maxime Devos
2021-01-31 20:04 ` Maxime Devos
` (3 subsequent siblings)
4 siblings, 0 replies; 6+ messages in thread
From: Maxime Devos @ 2021-01-31 18:52 UTC (permalink / raw)
To: 46216, maximedevos
[-- Attachment #1.1: Type: text/plain, Size: 37 bytes --]
Oops, I forgot to attach the patch.
[-- Attachment #1.2: 0001-tests-publish-lessen-code-duplication.patch --]
[-- Type: text/x-patch, Size: 7537 bytes --]
From de2a51437482c4a6aa812872f15804803650c128 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 31 Jan 2021 19:48:14 +0100
Subject: [PATCH] tests: publish: lessen code duplication.
* tests/publish.scm (spawn-guix-publish): introduce
procedure, and adjust tests to use it instead of
using an inline definition.
---
tests/publish.scm | 82 +++++++++++++++++++----------------------------
1 file changed, 33 insertions(+), 49 deletions(-)
diff --git a/tests/publish.scm b/tests/publish.scm
index 52101876b5..7c90332bda 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -92,11 +93,20 @@
(lambda ()
exp ...)))))
-;; Run a local publishing server in a separate thread.
-(with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6789" "-C0")))) ;attempt to avoid port collision
+;; 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)
+ "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)))))
+
+(spawn-guix-publish 6789 "-C0")
(define (wait-until-ready port)
;; Wait until the server is accepting connections.
@@ -257,10 +267,7 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))
("Compression" . "gzip"))
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6799" "-C5"))))))
+ (let ((thread (spawn-guix-publish 6799 "-C5")))
(wait-until-ready 6799)
(let* ((url (string-append "http://localhost:6799/"
(store-path-hash-part %item) ".narinfo"))
@@ -277,10 +284,7 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/lzip/" (basename %item)))
("Compression" . "lzip"))
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6790" "-Clzip"))))))
+ (let ((thread (spawn-guix-publish 6790 "-Clzip")))
(wait-until-ready 6790)
(let* ((url (string-append "http://localhost:6790/"
(store-path-hash-part %item) ".narinfo"))
@@ -315,10 +319,7 @@ References: ~%"
200)
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2"))))))
+ (let ((thread (spawn-guix-publish 6793 "-Cgzip:2" "-Clzip:2")))
(wait-until-ready 6793)
(let* ((base "http://localhost:6793/")
(part (store-path-hash-part %item))
@@ -339,11 +340,8 @@ References: ~%"
("Compression" . "none"))
200
404)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6798" "-C0"
- "--nar-path=///foo/bar//chbouib/"))))))
+ (let ((thread (spawn-guix-publish 6798 "-C0"
+ "--nar-path=///foo/bar//chbouib/")))
(wait-until-ready 6798)
(let* ((base "http://localhost:6798/")
(part (store-path-hash-part %item))
@@ -425,12 +423,9 @@ References: ~%"
404) ;nar/…
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6797" "-C2"
- (string-append "--cache=" cache)
- "--cache-bypass-threshold=0"))))))
+ (let ((thread (spawn-guix-publish 6797 "-C2"
+ (string-append "--cache=" cache)
+ "--cache-bypass-threshold=0")))
(wait-until-ready 6797)
(let* ((base "http://localhost:6797/")
(part (store-path-hash-part %item))
@@ -480,12 +475,9 @@ References: ~%"
'(200 200 404)
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
- (string-append "--cache=" cache)
- "--cache-bypass-threshold=0"))))))
+ (let ((thread (spawn-guix-publish 6794 "-Cgzip:2" "-Clzip:2"
+ (string-append "--cache=" cache)
+ "--cache-bypass-threshold=0")))
(wait-until-ready 6794)
(let* ((base "http://localhost:6794/")
(part (store-path-hash-part %item))
@@ -588,11 +580,8 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6795"
- (string-append "--cache=" cache)))))))
+ (let ((thread (spawn-guix-publish 6795
+ (string-append "--cache=" cache))))
(wait-until-ready 6795)
;; Make sure that, even if ITEM disappears, we're still able to fetch
@@ -615,11 +604,9 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6788" "-C" "gzip"
- (string-append "--cache=" cache)))))))
+ (let ((thread (spawn-guix-publish 6788 "-C" "gzip"
+ "--port=6788" "-C" "gzip"
+ (string-append "--cache=" cache))))
(wait-until-ready 6788)
(let* ((base "http://localhost:6788/")
@@ -651,11 +638,8 @@ References: ~%"
;; for a non-existing file name.
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6787" "-C" "gzip"
- (string-append "--cache=" cache)))))))
+ (let ((thread (spawn-guix-publish 6787 "-C" "gzip"
+ (string-append "--cache=" cache))))
(wait-until-ready 6787)
(let* ((base "http://localhost:6787/")
--
2.30.0
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 6+ messages in thread* [bug#46216] [PATCH] Remove duplication in tests/publish.scm
2021-01-31 18:46 [bug#46216] [PATCH] Remove duplication in tests/publish.scm Maxime Devos
2021-01-31 18:52 ` Maxime Devos
@ 2021-01-31 20:04 ` Maxime Devos
2021-01-31 22:01 ` Maxime Devos
` (2 subsequent siblings)
4 siblings, 0 replies; 6+ messages in thread
From: Maxime Devos @ 2021-01-31 20:04 UTC (permalink / raw)
To: 46216
[-- Attachment #1.1: Type: text/plain, Size: 264 bytes --]
This is the second patch in the series. Description
from commit message:
* tests/publish.scm
(call-with-guix-publish, with-guix-publish): introduce
combination of spawn-guix-publish and wait-until-ready,
and adjust tests to use the macro.
Maxime
[-- Attachment #1.2: 0002-tests-publish-remove-duplicated-use-of-wait-until-re.patch --]
[-- Type: text/x-patch, Size: 7299 bytes --]
From dc166f96da951ed045ddc87441428a44693035cd Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 31 Jan 2021 20:58:46 +0100
Subject: [PATCH] tests: publish: remove duplicated use of wait-until-ready
* tests/publish.scm
(call-with-guix-publish, with-guix-publish): introduce
combination of spawn-guix-publish and wait-until-ready,
and adjust tests to use the macro.
---
tests/publish.scm | 68 +++++++++++++++++++++++------------------------
1 file changed, 33 insertions(+), 35 deletions(-)
diff --git a/tests/publish.scm b/tests/publish.scm
index 7c90332bda..e24b0feb00 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -106,6 +106,18 @@ 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)))
+ (wait-until-ready port)
+ (thunk)))
+
+(define-syntax-rule (with-guix-publish port extra-arguments exp ...)
+ (call-with-guix-publish port extra-arguments
+ (lambda () exp ...)))
+
(spawn-guix-publish 6789 "-C0")
(define (wait-until-ready port)
@@ -267,8 +279,7 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))
("Compression" . "gzip"))
- (let ((thread (spawn-guix-publish 6799 "-C5")))
- (wait-until-ready 6799)
+ (with-guix-publish 6799 '("-C5")
(let* ((url (string-append "http://localhost:6799/"
(store-path-hash-part %item) ".narinfo"))
(body (http-get-port url)))
@@ -284,8 +295,7 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/lzip/" (basename %item)))
("Compression" . "lzip"))
- (let ((thread (spawn-guix-publish 6790 "-Clzip")))
- (wait-until-ready 6790)
+ (with-guix-publish 6790 '("-Clzip")
(let* ((url (string-append "http://localhost:6790/"
(store-path-hash-part %item) ".narinfo"))
(body (http-get-port url)))
@@ -319,8 +329,7 @@ References: ~%"
200)
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (spawn-guix-publish 6793 "-Cgzip:2" "-Clzip:2")))
- (wait-until-ready 6793)
+ (with-guix-publish 6793 '("-Cgzip:2" "-Clzip:2")
(let* ((base "http://localhost:6793/")
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
@@ -340,9 +349,7 @@ References: ~%"
("Compression" . "none"))
200
404)
- (let ((thread (spawn-guix-publish 6798 "-C0"
- "--nar-path=///foo/bar//chbouib/")))
- (wait-until-ready 6798)
+ (with-guix-publish 6798 '("-C0" "--nar-path=///foo/bar//chbouib/")
(let* ((base "http://localhost:6798/")
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
@@ -423,10 +430,8 @@ References: ~%"
404) ;nar/…
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (spawn-guix-publish 6797 "-C2"
- (string-append "--cache=" cache)
- "--cache-bypass-threshold=0")))
- (wait-until-ready 6797)
+ (with-guix-publish 6797 `("-C2" ,(string-append "--cache=" cache)
+ "--cache-bypass-threshold=0")
(let* ((base "http://localhost:6797/")
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
@@ -475,10 +480,9 @@ References: ~%"
'(200 200 404)
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (spawn-guix-publish 6794 "-Cgzip:2" "-Clzip:2"
- (string-append "--cache=" cache)
- "--cache-bypass-threshold=0")))
- (wait-until-ready 6794)
+ (with-guix-publish 6794 `("-Cgzip:2" "-Clzip:2"
+ ,(string-append "--cache=" cache)
+ "--cache-bypass-threshold=0")
(let* ((base "http://localhost:6794/")
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
@@ -528,13 +532,9 @@ References: ~%"
404) ;nar/gzip/…
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6796" "-C2" "--ttl=42h"
- (string-append "--cache=" cache)
- "--cache-bypass-threshold=0"))))))
- (wait-until-ready 6796)
+ (with-guix-publish 6796 `("-C2" "--ttl=42h"
+ ,(string-append "--cache=" cache)
+ "--cache-bypass-threshold=0")
(let* ((base "http://localhost:6796/")
(part (store-path-hash-part item))
(url (string-append base part ".narinfo"))
@@ -580,9 +580,7 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (spawn-guix-publish 6795
- (string-append "--cache=" cache))))
- (wait-until-ready 6795)
+ (with-guix-publish 6795 (list (string-append "--cache=" cache))
;; Make sure that, even if ITEM disappears, we're still able to fetch
;; it.
@@ -604,11 +602,8 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (spawn-guix-publish 6788 "-C" "gzip"
- "--port=6788" "-C" "gzip"
- (string-append "--cache=" cache))))
- (wait-until-ready 6788)
-
+ (with-guix-publish 6788 `("-C" "gzip" "-C" "gzip"
+ ,(string-append "--cache=" cache))
(let* ((base "http://localhost:6788/")
(item (add-text-to-store %store "random" (random-text)))
(part (store-path-hash-part item))
@@ -638,9 +633,7 @@ References: ~%"
;; for a non-existing file name.
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (spawn-guix-publish 6787 "-C" "gzip"
- (string-append "--cache=" cache))))
- (wait-until-ready 6787)
+ (with-guix-publish 6787 `("-C" "gzip" ,(string-append "--cache=" cache))
(let* ((base "http://localhost:6787/")
(item (add-text-to-store %store "random" (random-text)))
@@ -702,3 +695,8 @@ References: ~%"
(http-post (publish-uri path))))))
(test-end "publish")
+
+;; Local Variables:
+;; eval: (put 'with-guix-publish 'scheme-indent-function 2)
+;; eval: (put 'call-with-guix-publish 'scheme-indent-function 2)
+;; End:
--
2.30.0
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 6+ messages in thread* [bug#46216] [PATCH] Remove duplication in tests/publish.scm
2021-01-31 18:46 [bug#46216] [PATCH] Remove duplication in tests/publish.scm Maxime Devos
2021-01-31 18:52 ` Maxime Devos
2021-01-31 20:04 ` Maxime Devos
@ 2021-01-31 22:01 ` Maxime Devos
2021-01-31 22:10 ` [bug#46216] Fwd: " Maxime Devos
2021-02-01 14:04 ` [bug#46216] " Maxime Devos
4 siblings, 0 replies; 6+ messages in thread
From: Maxime Devos @ 2021-01-31 22:01 UTC (permalink / raw)
To: 46216
[-- Attachment #1.1: Type: text/plain, Size: 508 bytes --]
This is the third patch in the series. Description
from patch:
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.
[-- Attachment #1.2: 0003-tests-publish-automatically-keep-track-of-port-numbe.patch --]
[-- Type: text/x-patch, Size: 9370 bytes --]
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(-)
diff --git a/tests/publish.scm b/tests/publish.scm
index e24b0feb00..0a132dfe04 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -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
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 6+ messages in thread* [bug#46216] Fwd: Re: [PATCH] Remove duplication in tests/publish.scm
2021-01-31 18:46 [bug#46216] [PATCH] Remove duplication in tests/publish.scm Maxime Devos
` (2 preceding siblings ...)
2021-01-31 22:01 ` Maxime Devos
@ 2021-01-31 22:10 ` Maxime Devos
2021-02-01 14:04 ` [bug#46216] " Maxime Devos
4 siblings, 0 replies; 6+ messages in thread
From: Maxime Devos @ 2021-01-31 22:10 UTC (permalink / raw)
To: 46216
[-- Attachment #1.1: Type: text/plain, Size: 831 bytes --]
I accidentally sent this to guix-patches instead of
46216@debbugs.gnu.org.
-------- Forwarded Message --------
From: Maxime Devos <maximedevos@telenet.be>
Reply-To: 46216@debbugs.gnu.org
To: guix-patches@gnu.org
Subject: Re: [PATCH] Remove duplication in tests/publish.scm
Date: Sun, 31 Jan 2021 23:01:48 +0100
This is the third patch in the series. Description
from patch:
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.
[-- Attachment #1.2: 0003-tests-publish-automatically-keep-track-of-port-numbe.patch --]
[-- Type: text/x-patch, Size: 9370 bytes --]
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(-)
diff --git a/tests/publish.scm b/tests/publish.scm
index e24b0feb00..0a132dfe04 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -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
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 6+ messages in thread* [bug#46216] [PATCH] Remove duplication in tests/publish.scm
2021-01-31 18:46 [bug#46216] [PATCH] Remove duplication in tests/publish.scm Maxime Devos
` (3 preceding siblings ...)
2021-01-31 22:10 ` [bug#46216] Fwd: " Maxime Devos
@ 2021-02-01 14:04 ` Maxime Devos
4 siblings, 0 replies; 6+ messages in thread
From: Maxime Devos @ 2021-02-01 14:04 UTC (permalink / raw)
To: 46216
[-- Attachment #1.1: Type: text/plain, Size: 702 bytes --]
This is the fourth patch in the series.
It removes any explicit port numbers in the test.
This may be useful for preventing some potential
future problems with parallel "make check".
Description from the commit message:
> 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.
[-- Attachment #1.2: 0004-tests-publish-don-t-bind-the-test-server-to-a-port.patch --]
[-- Type: text/x-patch, Size: 9348 bytes --]
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(-)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index fa85088ed0..43233a4fd0 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -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~%")
diff --git a/tests/publish.scm b/tests/publish.scm
index 0a132dfe04..00509c7e82 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -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
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 6+ messages in thread