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.")
|
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"))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue