me/guix
Archived
1
0
Fork 0
Code Activity

download: Add ‘url-fetch/zipbomb’.

Browse source 
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.
This commit is contained in:
Tobias Geerinckx-Rice 2017-01-25 13:16:00 +01:00
parent 58f91e4d03
commit 814b099a20
No known key found for this signature in database
GPG key ID: 91CCDB9B48541B99
1 changed files with 30 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guix/download.scm
View file

@ -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))