diff options
| -rwxr-xr-x | guix/scripts/substitute.scm | 22 | ||||
| -rw-r--r-- | tests/substitute.scm | 6 |
2 files changed, 17 insertions, 11 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 992b21d505..ba2fb291d8 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -86,6 +86,8 @@ read-narinfo write-narinfo + %allow-unauthenticated-substitutes? + substitute-urls guix-substitute)) @@ -118,15 +120,21 @@ (string-append %state-directory "/substitute/cache")) (string-append (cache-directory #:ensure? #f) "/substitute"))) +(define (warn-about-missing-authentication) + (warning (G_ "authentication and authorization of substitutes \ +disabled!~%")) + #t) + (define %allow-unauthenticated-substitutes? ;; Whether to allow unchecked substitutes. This is useful for testing ;; purposes, and should be avoided otherwise. - (and (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES") - (cut string-ci=? <> "yes")) - (begin - (warning (G_ "authentication and authorization of substitutes \ -disabled!~%")) - #t))) + (make-parameter + (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES") + (cut string-ci=? <> "yes")) + (lambda (value) + (when value + (warn-about-missing-authentication)) + value))) (define %narinfo-ttl ;; Number of seconds during which cached narinfo lookups are considered @@ -370,7 +378,7 @@ No authentication and authorization checks are performed here!" (define* (valid-narinfo? narinfo #:optional (acl (current-acl)) #:key verbose?) "Return #t if NARINFO's signature is not valid." - (or %allow-unauthenticated-substitutes? + (or (%allow-unauthenticated-substitutes?) (let ((hash (narinfo-sha256 narinfo)) (signature (narinfo-signature narinfo)) (uri (uri->string (first (narinfo-uris narinfo))))) diff --git a/tests/substitute.scm b/tests/substitute.scm index ff2be662be..a4246aff82 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> -;;; Copyright © 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -169,9 +169,7 @@ a file for NARINFO." (cute write-file (string-append narinfo-directory "/example.out") <>)) - (set! (@@ (guix scripts substitute) - %allow-unauthenticated-substitutes?) - #f)) + (%allow-unauthenticated-substitutes? #f)) thunk (lambda () (when (file-exists? cache-directory) |