download: Add 'url-fetch/tarbomb'.

Suggested by Federico Beffa.
Fixes <http://bugs.gnu.org/22676>.
Reported by Danny Milosavljevic <dannym@scratchpost.org>.

* gnu/packages/engineering.scm (broken-tarball-fetch): Remove.
(fastcap)[source](method): Use URL-FETCH/TARBOMB instead.
* gnu/packages/scheme.scm (broken-tarball-fetch): Remove.
(scmutils)[source](method): Use URL-FETCH/TARBOMB instead.
* guix/download.scm (url-fetch/tarbomb): New procedure, renamed from
'broken-tarball-fetch'.
This commit is contained in:
Ludovic Courtès 2016-02-22 00:29:54 +01:00
parent 49e0ca90bc
commit 95001d4b46
3 changed files with 30 additions and 28 deletions

View File

@ -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.") optimizer; and it can produce photorealistic and design review images.")
(license license:gpl2+))) (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 (define-public fastcap
(package (package
(name "fastcap") (name "fastcap")
(version "2.0-18Sep92") (version "2.0-18Sep92")
(source (origin (source (origin
(method broken-tarball-fetch) (method url-fetch/tarbomb)
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(uri (string-append "http://www.rle.mit.edu/cpg/codes/" (uri (string-append "http://www.rle.mit.edu/cpg/codes/"
name "-" version ".tgz")) name "-" version ".tgz"))

View File

@ -526,12 +526,6 @@ an isolated heap allowing multiple VMs to run simultaneously in different OS
threads.") threads.")
(license bsd-3))) (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 (define-public scmutils
(let () (let ()
(define (system-suffix) (define (system-suffix)
@ -546,7 +540,7 @@ threads.")
(version "20140302") (version "20140302")
(source (source
(origin (origin
(method broken-tarball-fetch) (method url-fetch/tarbomb)
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; Remove binary code ;; Remove binary code

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -31,6 +32,7 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (%mirrors #:export (%mirrors
url-fetch url-fetch
url-fetch/tarbomb
download-to-store)) download-to-store))
;;; Commentary: ;;; Commentary:
@ -294,6 +296,31 @@ in the store."
;; <https://bugs.gnu.org/18747>.) ;; <https://bugs.gnu.org/18747>.)
#:local-build? #t))))) #: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)) (define* (download-to-store store url #:optional (name (basename url))
#:key (log (current-error-port)) recursive?) #:key (log (current-error-port)) recursive?)
"Download from URL to STORE, either under NAME or URL's basename if "Download from URL to STORE, either under NAME or URL's basename if