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'.
master
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.")
(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"))

View File

@ -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

View File

@ -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