diff options
| -rw-r--r-- | gnu/packages/bash.scm | 4 | ||||
| -rw-r--r-- | guix/gnupg.scm | 78 | ||||
| -rw-r--r-- | guix/upstream.scm | 24 |
3 files changed, 62 insertions, 44 deletions
diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index bb2397fafa..3af13a612a 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il> @@ -80,7 +80,7 @@ number/base32-hash tuples, directly usable in the 'patch-series' form." (sig (download-to-store store (string-append (patch-url number) ".sig")))) - (unless (gnupg-verify* sig patch) + (unless (eq? 'valid-signature (gnupg-verify* sig patch)) (error "failed to verify signature" patch)) (list number diff --git a/guix/gnupg.scm b/guix/gnupg.scm index 35ab779e9c..bf0283f8fe 100644 --- a/guix/gnupg.scm +++ b/guix/gnupg.scm @@ -175,13 +175,15 @@ missing key or its key id if the fingerprint is unavailable." (define* (gnupg-receive-keys fingerprint/key-id server #:optional (keyring (current-keyring))) + "Download FINGERPRINT/KEY-ID from SERVER, a key server, and add it to +KEYRING." (unless (file-exists? keyring) (mkdir-p (dirname keyring)) (call-with-output-file keyring (const #t))) ;create an empty keybox - (system* (%gpg-command) "--keyserver" server - "--no-default-keyring" "--keyring" keyring - "--recv-keys" fingerprint/key-id)) + (zero? (system* (%gpg-command) "--keyserver" server + "--no-default-keyring" "--keyring" keyring + "--recv-keys" fingerprint/key-id))) (define* (gnupg-verify* sig file #:key @@ -189,36 +191,48 @@ missing key or its key id if the fingerprint is unavailable." (server (%openpgp-key-server)) (keyring (current-keyring))) "Like `gnupg-verify', but try downloading the public key if it's missing. -Return #t if the signature was good, #f otherwise. KEY-DOWNLOAD specifies a -download policy for missing OpenPGP keys; allowed values: 'always', 'never', -and 'interactive' (default). Return a fingerprint/user name pair on success -and #f otherwise." +Return two values: 'valid-signature and a fingerprint/name pair upon success, +'missing-key and a fingerprint if the key could not be found, and +'invalid-signature with a fingerprint if the signature is invalid. + +KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed +values: 'always', 'never', and 'interactive' (default). Return a +fingerprint/user name pair on success and #f otherwise." (let ((status (gnupg-verify sig file))) - (or (gnupg-status-good-signature? status) - (let ((missing (gnupg-status-missing-key? status))) - (define (download-and-try-again) - ;; Download the missing key and try again. - (begin - (gnupg-receive-keys missing server keyring) - (gnupg-status-good-signature? (gnupg-verify sig file - keyring)))) - - (define (receive?) - (let ((answer - (begin - (format #t (G_ "Would you like to add this key \ + (match (gnupg-status-good-signature? status) + ((fingerprint . user) + (values 'valid-signature (cons fingerprint user))) + (#f + (let ((missing (gnupg-status-missing-key? status))) + (define (download-and-try-again) + ;; Download the missing key and try again. + (if (gnupg-receive-keys missing server keyring) + (match (gnupg-status-good-signature? + (gnupg-verify sig file keyring)) + (#f + (values 'invalid-signature missing)) + ((fingerprint . user) + (values 'valid-signature + (cons fingerprint user)))) + (values 'missing-key missing))) + + (define (receive?) + (let ((answer + (begin + (format #t (G_ "Would you like to add this key \ to keyring '~a'?~%") - keyring) - (read-line)))) - (string-match (locale-yes-regexp) answer))) - - (and missing - (case key-download - ((never) #f) - ((always) - (download-and-try-again)) - (else - (and (receive?) - (download-and-try-again))))))))) + keyring) + (read-line)))) + (string-match (locale-yes-regexp) answer))) + + (case key-download + ((never) + (values 'missing-key missing)) + ((always) + (download-and-try-again)) + (else + (if (receive?) + (download-and-try-again) + (values 'missing-key missing))))))))) ;;; gnupg.scm ends here diff --git a/guix/upstream.scm b/guix/upstream.scm index aa47dab4b4..c11de0b25b 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -318,16 +318,20 @@ values: 'interactive' (default), 'always', and 'never'." (basename url) tarball))) (mbegin %store-monad (built-derivations (list drv)) - (return (derivation->output-path drv))))))) - - (ret (gnupg-verify* sig data #:key-download key-download))) - (if ret - tarball - (begin - (warning (G_ "signature verification failed for `~a'~%") - url) - (warning (G_ "(could be because the public key is not in your keyring)~%")) - #f)))))) + (return (derivation->output-path drv)))))))) + (let-values (((status data) + (gnupg-verify* sig data #:key-download key-download))) + (match status + ('valid-signature + tarball) + ('invalid-signature + (warning (G_ "signature verification failed for '~a' (key: ~a)~%") + url data) + #f) + ('missing-key + (warning (G_ "missing public key ~a for '~a'~%") + data url) + #f))))))) (define (find2 pred lst1 lst2) "Like 'find', but operate on items from both LST1 and LST2. Return two |