gnupg: 'gnupg-verify*' returns a status symbol.

This allows callers to distinguish between signature verification
failure and missing key.

* guix/gnupg.scm (gnupg-receive-keys): Return true on success.
(gnupg-verify*): Check return value of 'gnupg-receive-keys'.  Return two
values, the first one being a symbol.
* guix/upstream.scm (download-tarball): Get the two return values of
'gnupg-verify*', and match on the first one.
* gnu/packages/bash.scm (download-patches): Check the first return value
of 'gnupg-verify*'.

2 files changed, 60 insertions, 42 deletions

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