From mboxrd@z Thu Jan 1 00:00:00 1970 From: ng0 Subject: Re: [PATCH 2/3] download: Add =?utf-8?Q?=E2=80=98url-fetch=2Fzipb?= =?utf-8?Q?omb=E2=80=99=2E?= Date: Sat, 28 Jan 2017 17:55:13 +0000 Message-ID: <87lgtvvzlq.fsf@wasp.i-did-not-set--mail-host-address--so-tickle-me> References: <20170127195924.22959-1-me@tobias.gr> <20170127195924.22959-2-me@tobias.gr> Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:53871) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cXXDz-0004QK-GQ for guix-devel@gnu.org; Sat, 28 Jan 2017 12:55:44 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cXXDv-0002JN-Gq for guix-devel@gnu.org; Sat, 28 Jan 2017 12:55:43 -0500 Received: from perdizione.investici.org ([2001:41d0:2:33d0::19]:48992) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cXXDv-0002J2-A9 for guix-devel@gnu.org; Sat, 28 Jan 2017 12:55:39 -0500 In-Reply-To: <20170127195924.22959-2-me@tobias.gr> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: Tobias Geerinckx-Rice , guix-devel@gnu.org Tobias Geerinckx-Rice writes: > From this suggestion by Ludovic Court=C3=A8s: > > > * 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)) > =20 > ;;; Commentary: > @@ -512,6 +513,35 @@ own. This helper makes it easier to deal with \"t= ar bombs\"." > "xf" #$drv))) > #:local-build? #t))) > =20 > +(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 director= y 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-nam= e)) > + #: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)) > --=20 > 2.9.3 > > Looks good to me at first, on functionality side I can atest that the zpaq build succeeds with this. --=20 =E2=99=A5=E2=92=B6 ng0 -- https://www.inventati.org/patternsinthechaos/