summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-11-30 17:30:12 +0100
committerLudovic Courtès <ludo@gnu.org>2016-11-30 17:35:21 +0100
commit8d5d06282e255557d3bdda1794bd3fea2c84ff59 (patch)
treee789db769f82f4c102677dee8f78bae74434d0a9 /guix
parent4e6230ec00de1090e2780130f7de3a799c626e9b (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/upstream.scm49
1 files changed, 47 insertions, 2 deletions
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 08992dc19e..8685afd860 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -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