mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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*'.
This commit is contained in:
Ludovic Courtès
parent
1101c73c7f
commit
f94f9d67e6
3 changed files with 60 additions and 42 deletions
|
|
@ -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 @@ (define (download-patches store count)
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -175,13 +175,15 @@ (define (gnupg-status-missing-key? status)
|
|||
|
||||
(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
|
||||
(zero? (system* (%gpg-command) "--keyserver" server
|
||||
"--no-default-keyring" "--keyring" keyring
|
||||
"--recv-keys" fingerprint/key-id))
|
||||
"--recv-keys" fingerprint/key-id)))
|
||||
|
||||
(define* (gnupg-verify* sig file
|
||||
#:key
|
||||
|
|
@ -189,19 +191,30 @@ (define* (gnupg-verify* sig file
|
|||
(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)
|
||||
(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.
|
||||
(begin
|
||||
(gnupg-receive-keys missing server keyring)
|
||||
(gnupg-status-good-signature? (gnupg-verify sig file
|
||||
keyring))))
|
||||
(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
|
||||
|
|
@ -212,13 +225,14 @@ (define (receive?)
|
|||
(read-line))))
|
||||
(string-match (locale-yes-regexp) answer)))
|
||||
|
||||
(and missing
|
||||
(case key-download
|
||||
((never) #f)
|
||||
((never)
|
||||
(values 'missing-key missing))
|
||||
((always)
|
||||
(download-and-try-again))
|
||||
(else
|
||||
(and (receive?)
|
||||
(download-and-try-again)))))))))
|
||||
(if (receive?)
|
||||
(download-and-try-again)
|
||||
(values 'missing-key missing)))))))))
|
||||
|
||||
;;; gnupg.scm ends here
|
||||
|
|
|
|||
|
|
@ -318,16 +318,20 @@ (define* (download-tarball store url signature-url
|
|||
(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
|
||||
|
|
|
|||
Loading…
Reference in a new issue