futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

substitute: Test behavior with unroutable substitute server addresses.

Browse Source 
* tests/substitute.scm (%unroutable-substitute-url): New variable.
("query narinfo signed with authorized key, unroutable URL first")
("substitute, authorized key, first substitute URL is unroutable"): New
tests.
This commit is contained in:
Ludovic Courtès 2022-09-21 17:21:48 +02:00
parent 95e06bc3e1
commit 08023bcab3
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 46 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
tests/substitute.scm
View File

@ -137,6 +137,12 @@ version identifier.."
(string-append (dirname %main-substitute-directory) (string-append (dirname %main-substitute-directory)
"/substituter-alt-data")) "/substituter-alt-data"))
(define %unroutable-substitute-url
;; Substitute URL with an unroutable server address, as per
;; <https://www.rfc-editor.org/rfc/rfc5737>.
"http://203.0.113.1")
(define %narinfo (define %narinfo
;; Skeleton of the narinfo used below. ;; Skeleton of the narinfo used below.
(string-append "StorePath: " (%store-prefix) (string-append "StorePath: " (%store-prefix)
@ -305,6 +311,24 @@ Deriver: " (%store-prefix) "/foo.drv")
(lambda () (lambda ()
(guix-substitute "--query")))))))) (guix-substitute "--query"))))))))
(test-equal "query narinfo signed with authorized key, unroutable URL first"
(string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
(with-narinfo (string-append %narinfo "Signature: "
(signature-field %narinfo)
"\n")
(string-trim-both
(with-output-to-string
(lambda ()
(with-input-from-string (string-append "have " (%store-prefix)
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
(lambda ()
(parameterize ((substitute-urls
(list %unroutable-substitute-url
(string-append "file://"
%main-substitute-directory))))
(guix-substitute "--query")))))))))
(test-equal "query narinfo signed with unauthorized key" (test-equal "query narinfo signed with unauthorized key"
"" ; not substitutable "" ; not substitutable
@ -417,6 +441,28 @@ System: mips64el-linux\n")))
(lambda () (lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))) (false-if-exception (delete-file "substitute-retrieved"))))))
(test-equal "substitute, authorized key, first substitute URL is unroutable"
'("Substitutable data." 1 #o444)
(with-narinfo (string-append %narinfo "Signature: "
(signature-field %narinfo))
(dynamic-wind
(const #t)
(lambda ()
;; Pick an unroutable URL as the first one. This shouldn't be a
;; problem.
(parameterize ((substitute-urls
(list %unroutable-substitute-url
(string-append "file://"
%main-substitute-directory))))
(request-substitution (string-append (%store-prefix)
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"substitute-retrieved")
(list (call-with-input-file "substitute-retrieved" get-string-all)
(stat:mtime (lstat "substitute-retrieved"))
(stat:perms (lstat "substitute-retrieved")))))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved"))))))
(test-equal "substitute, unauthorized narinfo comes first" (test-equal "substitute, unauthorized narinfo comes first"
"Substitutable data." "Substitutable data."
(with-narinfo* (with-narinfo*