ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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*'.
This commit is contained in:
Ludovic Courtès 2019-12-20 21:49:43 +01:00
parent 1101c73c7f
commit f94f9d67e6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 60 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
gnu/packages/bash.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
@ -80,7 +80,7 @@ (define (download-patches store count)
(sig (download-to-store store (sig (download-to-store store
(string-append (patch-url number) (string-append (patch-url number)
".sig")))) ".sig"))))
(unless (gnupg-verify* sig patch) (unless (eq? 'valid-signature (gnupg-verify* sig patch))
(error "failed to verify signature" patch)) (error "failed to verify signature" patch))
(list number (list number

44
guix/gnupg.scm
View file

@ -175,13 +175,15 @@ (define (gnupg-status-missing-key? status)
(define* (gnupg-receive-keys fingerprint/key-id server (define* (gnupg-receive-keys fingerprint/key-id server
#:optional (keyring (current-keyring))) #:optional (keyring (current-keyring)))
"Download FINGERPRINT/KEY-ID from SERVER, a key server, and add it to
KEYRING."
(unless (file-exists? keyring) (unless (file-exists? keyring)
(mkdir-p (dirname keyring)) (mkdir-p (dirname keyring))
(call-with-output-file keyring (const #t))) ;create an empty keybox (call-with-output-file keyring (const #t))) ;create an empty keybox
(system* (%gpg-command) "--keyserver" server (zero? (system* (%gpg-command) "--keyserver" server
"--no-default-keyring" "--keyring" keyring "--no-default-keyring" "--keyring" keyring
"--recv-keys" fingerprint/key-id)) "--recv-keys" fingerprint/key-id)))
(define* (gnupg-verify* sig file (define* (gnupg-verify* sig file
#:key #:key
@ -189,19 +191,30 @@ (define* (gnupg-verify* sig file
(server (%openpgp-key-server)) (server (%openpgp-key-server))
(keyring (current-keyring))) (keyring (current-keyring)))
"Like `gnupg-verify', but try downloading the public key if it's missing. "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 Return two values: 'valid-signature and a fingerprint/name pair upon success,
download policy for missing OpenPGP keys; allowed values: 'always', 'never', 'missing-key and a fingerprint if the key could not be found, and
and 'interactive' (default). Return a fingerprint/user name pair on success 'invalid-signature with a fingerprint if the signature is invalid.
and #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."
(let ((status (gnupg-verify sig file))) (let ((status (gnupg-verify sig file)))
(or (gnupg-status-good-signature? status) (match (gnupg-status-good-signature? status)
((fingerprint . user)
(values 'valid-signature (cons fingerprint user)))
(#f
(let ((missing (gnupg-status-missing-key? status))) (let ((missing (gnupg-status-missing-key? status)))
(define (download-and-try-again) (define (download-and-try-again)
;; Download the missing key and try again. ;; Download the missing key and try again.
(begin (if (gnupg-receive-keys missing server keyring)
(gnupg-receive-keys missing server keyring) (match (gnupg-status-good-signature?
(gnupg-status-good-signature? (gnupg-verify sig file (gnupg-verify sig file keyring))
keyring)))) (#f
(values 'invalid-signature missing))
((fingerprint . user)
(values 'valid-signature
(cons fingerprint user))))
(values 'missing-key missing)))
(define (receive?) (define (receive?)
(let ((answer (let ((answer
@ -212,13 +225,14 @@ (define (receive?)
(read-line)))) (read-line))))
(string-match (locale-yes-regexp) answer))) (string-match (locale-yes-regexp) answer)))
(and missing
(case key-download (case key-download
((never) #f) ((never)
(values 'missing-key missing))
((always) ((always)
(download-and-try-again)) (download-and-try-again))
(else (else
(and (receive?) (if (receive?)
(download-and-try-again))))))))) (download-and-try-again)
(values 'missing-key missing)))))))))
;;; gnupg.scm ends here ;;; gnupg.scm ends here

24
guix/upstream.scm
View file

@ -318,16 +318,20 @@ (define* (download-tarball store url signature-url
(basename url) tarball))) (basename url) tarball)))
(mbegin %store-monad (mbegin %store-monad
(built-derivations (list drv)) (built-derivations (list drv))
(return (derivation->output-path drv))))))) (return (derivation->output-path drv))))))))
(let-values (((status data)
(ret (gnupg-verify* sig data #:key-download key-download))) (gnupg-verify* sig data #:key-download key-download)))
(if ret (match status
tarball ('valid-signature
(begin tarball)
(warning (G_ "signature verification failed for `~a'~%") ('invalid-signature
url) (warning (G_ "signature verification failed for '~a' (key: ~a)~%")
(warning (G_ "(could be because the public key is not in your keyring)~%")) url data)
#f)))))) #f)
('missing-key
(warning (G_ "missing public key ~a for '~a'~%")
data url)
#f)))))))
(define (find2 pred lst1 lst2) (define (find2 pred lst1 lst2)
"Like 'find', but operate on items from both LST1 and LST2. Return two "Like 'find', but operate on items from both LST1 and LST2. Return two