diff options
| -rw-r--r-- | gnu/packages/engineering.scm | 21 | ||||
| -rw-r--r-- | gnu/packages/scheme.scm | 8 | ||||
| -rw-r--r-- | guix/download.scm | 29 |
3 files changed, 30 insertions, 28 deletions
diff --git a/gnu/packages/engineering.scm b/gnu/packages/engineering.scm index 204ea9dc02..9a36ffbb31 100644 --- a/gnu/packages/engineering.scm +++ b/gnu/packages/engineering.scm @@ -203,31 +203,12 @@ and design rule checking. It also includes an autorouter and a trace optimizer; and it can produce photorealistic and design review images.") (license license:gpl2+))) -(define* (broken-tarball-fetch url hash-algo hash - #:optional name - #:key (system (%current-system)) - (guile (default-guile))) - (mlet %store-monad ((drv (url-fetch url hash-algo hash - (string-append "tarbomb-" name) - #:system system - #:guile guile))) - ;; Take the tar bomb, and simply unpack it as a directory. - (gexp->derivation name - #~(begin - (mkdir #$output) - (setenv "PATH" - (string-append #$gzip "/bin")) - (chdir #$output) - (zero? (system* (string-append #$tar "/bin/tar") - "xf" #$drv)))))) - - (define-public fastcap (package (name "fastcap") (version "2.0-18Sep92") (source (origin - (method broken-tarball-fetch) + (method url-fetch/tarbomb) (file-name (string-append name "-" version ".tar.gz")) (uri (string-append "http://www.rle.mit.edu/cpg/codes/" name "-" version ".tgz")) diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 352b66c59b..00b573fc0b 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -526,12 +526,6 @@ an isolated heap allowing multiple VMs to run simultaneously in different OS threads.") (license bsd-3))) -;; FIXME: This function is temporarily in the engineering module and not -;; exported. It will be moved to an utility module for general use. Once -;; this is done, we should remove this definition. -(define broken-tarball-fetch - (@@ (gnu packages engineering) broken-tarball-fetch)) - (define-public scmutils (let () (define (system-suffix) @@ -546,7 +540,7 @@ threads.") (version "20140302") (source (origin - (method broken-tarball-fetch) + (method url-fetch/tarbomb) (modules '((guix build utils))) (snippet ;; Remove binary code diff --git a/guix/download.scm b/guix/download.scm index 204cfc0826..88f285dc0a 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +32,7 @@ #:use-module (srfi srfi-26) #:export (%mirrors url-fetch + url-fetch/tarbomb download-to-store)) ;;; Commentary: @@ -294,6 +296,31 @@ in the store." ;; <https://bugs.gnu.org/18747>.) #:local-build? #t))))) +(define* (url-fetch/tarbomb url hash-algo hash + #:optional name + #:key (system (%current-system)) + (guile (default-guile))) + "Similar to 'url-fetch' but unpack the file from URL in a directory of its +own. This helper makes it easier to deal with \"tar bombs\"." + (define gzip + (module-ref (resolve-interface '(gnu packages compression)) 'gzip)) + (define tar + (module-ref (resolve-interface '(gnu packages base)) 'tar)) + + (mlet %store-monad ((drv (url-fetch url hash-algo hash + (string-append "tarbomb-" name) + #:system system + #:guile guile))) + ;; Take the tar bomb, and simply unpack it as a directory. + (gexp->derivation name + #~(begin + (mkdir #$output) + (setenv "PATH" (string-append #$gzip "/bin")) + (chdir #$output) + (zero? (system* (string-append #$tar "/bin/tar") + "xf" #$drv))) + #:local-build? #t))) + (define* (download-to-store store url #:optional (name (basename url)) #:key (log (current-error-port)) recursive?) "Download from URL to STORE, either under NAME or URL's basename if |