me
/
guix
Archived
1
0
Fork 0
Code

upstream: Properly verify signatures of uncompressed tarballs. 

* guix/upstream.scm (uncompressed-tarball): New procedure.
(download-tarball): Use it when the basename of SIGNATURE-URL doesn't
contain the basename of URL.
master
Ludovic Courtès 2016-11-30 17:30:12 +01:00
parent 4e6230ec00
commit 8d5d06282e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 47 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
guix/upstream.scm
View File

@ -26,6 +26,11 @@
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix base32)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module ((guix derivations)
#:select (built-derivations derivation->output-path))
#:use-module (guix monads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
@ -149,6 +154,32 @@ than that of PACKAGE."
(_
#f)))
(define (uncompressed-tarball name tarball)
"Return a derivation that decompresses TARBALL."
(define (ref package)
(module-ref (resolve-interface '(gnu packages compression))
package))
(define compressor
(cond ((or (string-suffix? ".gz" tarball)
(string-suffix? ".tgz" tarball))
(file-append (ref 'gzip) "/bin/gzip"))
((string-suffix? ".bz2" tarball)
(file-append (ref 'bzip2) "/bin/bzip2"))
((string-suffix? ".xz" tarball)
(file-append (ref 'xz) "/bin/xz"))
((string-suffix? ".lz" tarball)
(file-append (ref 'lzip) "/bin/lzip"))
(else
(error "unknown archive type" tarball))))
(gexp->derivation (file-sans-extension name)
#~(begin
(copy-file #+tarball #+name)
(and (zero? (system* #+compressor "-d" #+name))
(copy-file #+(file-sans-extension name)
#$output)))))
(define* (download-tarball store url signature-url
#:key (key-download 'interactive))
"Download the tarball at URL to the store; check its OpenPGP signature at
@ -159,8 +190,22 @@ values: 'interactive' (default), 'always', and 'never'."
(let ((tarball (download-to-store store url)))
(if (not signature-url)
tarball
(let* ((sig (download-to-store store signature-url))
(ret (gnupg-verify* sig tarball #:key-download key-download)))
(let* ((sig (download-to-store store signature-url))
;; Sometimes we get a signature over the uncompressed tarball.
;; In that case, decompress the tarball in the store so that we
;; can check the signature.
(data (if (string-prefix? (basename url)
(basename signature-url))
tarball
(run-with-store store
(mlet %store-monad ((drv (uncompressed-tarball
(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