[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
06/07: download: Add ‘url-fetch/zipbomb’.
From: |
Tobias Geerinckx-Rice |
Subject: |
06/07: download: Add ‘url-fetch/zipbomb’. |
Date: |
Wed, 1 Feb 2017 15:19:44 +0000 (UTC) |
nckx pushed a commit to branch master
in repository guix.
commit 814b099a209f335944737e701cbfcb09ac811d58
Author: Tobias Geerinckx-Rice <address@hidden>
Date: Wed Jan 25 13:16:00 2017 +0100
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.
---
guix/download.scm | 30 ++++++++++++++++++++++++++++++
1 file changed, 30 insertions(+)
diff --git a/guix/download.scm b/guix/download.scm
index e218c2e..80efb9d 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))
- branch master updated (3e32eeb -> 36df995), Tobias Geerinckx-Rice, 2017/02/01
- 02/07: gnu: youtube-dl: Update to 2017.01.29., Tobias Geerinckx-Rice, 2017/02/01
- 06/07: download: Add ‘url-fetch/zipbomb’.,
Tobias Geerinckx-Rice <=
- 07/07: gnu: Add zpaq., Tobias Geerinckx-Rice, 2017/02/01
- 01/07: gnu: python-stem: Update to 1.5.4., Tobias Geerinckx-Rice, 2017/02/01
- 03/07: gnu: tor: Use ‘license:’ prefix instead of #:select., Tobias Geerinckx-Rice, 2017/02/01
- 05/07: download: url-fetch/tarball: Make ‘name’ truly optional., Tobias Geerinckx-Rice, 2017/02/01
- 04/07: gnu: Add nyx., Tobias Geerinckx-Rice, 2017/02/01