diff options
| -rw-r--r-- | guix/upstream.scm | 49 |
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 |