From: Tobias Geerinckx-Rice <me@tobias.gr>
To: guix-devel@gnu.org
Subject: [PATCH 2/3] download: Add ‘url-fetch/zipbomb’.
Date: Fri, 27 Jan 2017 20:59:23 +0100 [thread overview]
Message-ID: <20170127195924.22959-2-me@tobias.gr> (raw)
In-Reply-To: <20170127195924.22959-1-me@tobias.gr>
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))
--
2.9.3
next prev parent reply other threads:[~2017-01-27 19:59 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-01-27 19:59 [PATCH 1/3] download: url-fetch/tarball: Make ‘name’ truly optional Tobias Geerinckx-Rice
2017-01-27 19:59 ` Tobias Geerinckx-Rice [this message]
2017-01-28 17:55 ` [PATCH 2/3] download: Add ‘url-fetch/zipbomb’ ng0
2017-01-30 22:52 ` Ludovic Courtès
2017-01-27 19:59 ` [PATCH 3/3] gnu: Add zpaq Tobias Geerinckx-Rice
2017-01-28 17:51 ` ng0
2017-01-28 18:02 ` Tobias Geerinckx-Rice
2017-01-30 22:54 ` Ludovic Courtès
2017-01-30 23:12 ` Tobias Geerinckx-Rice
2017-01-28 18:22 ` [PATCH 1/3] download: url-fetch/tarball: Make ‘name’ truly optional ng0
2017-01-30 22:51 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170127195924.22959-2-me@tobias.gr \
--to=me@tobias.gr \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.