aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTobias Geerinckx-Rice <me@tobias.gr>2017-01-25 13:16:00 +0100
committerTobias Geerinckx-Rice <me@tobias.gr>2017-02-01 15:53:33 +0100
commit814b099a209f335944737e701cbfcb09ac811d58 (patch)
tree3ee3adebc6b35ab1fda1a892b78f8617aa453c0a
parent58f91e4d03e102058fc0f8a859cb144c40c6a1d0 (diff)
downloadguix-814b099a209f335944737e701cbfcb09ac811d58.tar
guix-814b099a209f335944737e701cbfcb09ac811d58.tar.gz
download: Add ‘url-fetch/zipbomb’.
From this suggestion by Ludovic Courtès: <http://lists.gnu.org/archive/html/guix-devel/2016-09/msg01983.html> * guix/download.scm (url-fetch/zipbomb): New procedure.
-rw-r--r--guix/download.scm30
1 files changed, 30 insertions, 0 deletions
diff --git a/guix/download.scm b/guix/download.scm
index e218c2e264..80efb9d9f1 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -36,6 +36,7 @@
#:export (%mirrors
url-fetch
url-fetch/tarbomb
+ url-fetch/zipbomb
download-to-store))
;;; Commentary:
@@ -512,6 +513,35 @@ own. This helper makes it easier to deal with \"tar bombs\"."
"xf" #$drv)))
#:local-build? #t)))
+(define* (url-fetch/zipbomb url hash-algo hash
+ #:optional name
+ #:key (system (%current-system))
+ (guile (default-guile)))
+ "Similar to 'url-fetch' but unpack the zip file at URL in a directory of its
+own. This helper makes it easier to deal with \"zip bombs\"."
+ (define file-name
+ (match url
+ ((head _ ...)
+ (basename head))
+ (_
+ (basename url))))
+ (define unzip
+ (module-ref (resolve-interface '(gnu packages zip)) 'unzip))
+
+ (mlet %store-monad ((drv (url-fetch url hash-algo hash
+ (string-append "zipbomb-"
+ (or name file-name))
+ #:system system
+ #:guile guile)))
+ ;; Take the zip bomb, and simply unpack it as a directory.
+ (gexp->derivation (or name file-name)
+ #~(begin
+ (mkdir #$output)
+ (chdir #$output)
+ (zero? (system* (string-append #$unzip "/bin/unzip")
+ #$drv)))
+ #:local-build? #t)))
+
(define* (download-to-store store url #:optional (name (basename url))
#:key (log (current-error-port)) recursive?
(verify-certificate? #t))