summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-02-22 00:29:54 +0100
committerLudovic Courtès <ludo@gnu.org>2016-02-22 00:36:24 +0100
commit95001d4b4677b64f26a4bf202a77267830bb7039 (patch)
tree325e3d78611aee8e2ec0b8f39fca268e39215742 /guix
parent49e0ca90bcccf01eca34b1e781b70b1560915c57 (diff)
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'.
Diffstat (limited to 'guix')
-rw-r--r--guix/download.scm29
1 files changed, 28 insertions, 1 deletions
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