aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/packages/bash.scm4
-rw-r--r--guix/gnupg.scm78
-rw-r--r--guix/upstream.scm24
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