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:
parent
49e0ca90bc
commit
95001d4b46
|
@ -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"))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue