From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:34230) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iduiN-0004c8-KL for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:04 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iduiM-0004qD-9F for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44612) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iduiM-0004oa-3i for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iduiL-0007t1-Vq for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:01 -0500 Subject: [bug#38518] [PATCH 2/7] guix archive: Add '--list'. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:32 +0100 Message-Id: <20191208112637.5534-2-ludo@gnu.org> In-Reply-To: <20191208112637.5534-1-ludo@gnu.org> References: <20191208112637.5534-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 38518@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= * guix/scripts/archive.scm (show-help, %options): Add '--list'. (list-contents): New procedure. (guix-archive): Honor the '--list' option. * tests/guix-archive.sh: Test it. * doc/guix.texi (Invoking guix archive): Document it. --- doc/guix.texi | 12 +++++++++++ guix/scripts/archive.scm | 45 +++++++++++++++++++++++++++++++++++++++- tests/guix-archive.sh | 7 ++++++- 3 files changed, 62 insertions(+), 2 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 446534c576..7b9aa7f7c3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4598,6 +4598,18 @@ unsafe. The primary purpose of this operation is to facilitate inspection of archive contents coming from possibly untrusted substitute servers. +@item --list +@itemx -t +Read a single-item archive as served by substitute servers +(@pxref{Substitutes}) and print the list of files it contains, as in +this example: + +@example +$ wget -O - \ + https://@value{SUBSTITUTE-SERVER}/nar/lzip/@dots{}-emacs-26.3 \ + | lzip -d | guix archive -t +@end example + @end table diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 3318ef0889..2b4d39c7b8 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -21,7 +21,8 @@ #:use-module (guix utils) #:use-module (guix combinators) #:use-module ((guix build utils) #:select (mkdir-p)) - #:use-module ((guix serialization) #:select (restore-file)) + #:use-module ((guix serialization) + #:select (fold-archive restore-file)) #:use-module (guix store) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix grafts) @@ -43,6 +44,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (ice-9 binary-ports) + #:use-module (rnrs bytevectors) #:export (guix-archive options->derivations+files)) @@ -76,6 +78,8 @@ Export/import one or more packages from/to the store.\n")) --missing print the files from stdin that are missing")) (display (G_ " -x, --extract=DIR extract the archive on stdin to DIR")) + (display (G_ " + -t, --list list the files in the archive on stdin")) (newline) (display (G_ " --generate-key[=PARAMETERS] @@ -137,6 +141,9 @@ Export/import one or more packages from/to the store.\n")) (option '("extract" #\x) #t #f (lambda (opt name arg result) (alist-cons 'extract arg result))) + (option '("list" #\t) #f #f + (lambda (opt name arg result) + (alist-cons 'list #t result))) (option '("generate-key") #f #t (lambda (opt name arg result) (catch 'gcry-error @@ -319,6 +326,40 @@ the input port." (with-atomic-file-output %acl-file (cut write-acl acl <>))))) +(define (list-contents port) + "Read a nar from PORT and print the list of files it contains to the current +output port." + (define (consume-input port size) + (let ((bv (make-bytevector 32768))) + (let loop ((total size)) + (unless (zero? total) + (let ((n (get-bytevector-n! port bv 0 + (min total (bytevector-length bv))))) + (loop (- total n))))))) + + (fold-archive (lambda (file type content result) + (match type + ('directory + (format #t "D ~a~%" file)) + ('symlink + (format #t "S ~a -> ~a~%" file content)) + ((or 'regular 'executable) + (match content + ((input . size) + (format #t "~a ~60a ~10h B~%" + (if (eq? type 'executable) + "x" "r") + file size) + (consume-input input size)))))) + #t + port + "")) + + +;;; +;;; Entry point. +;;; + (define (guix-archive . args) (define (lines port) ;; Return lines read from PORT. @@ -353,6 +394,8 @@ the input port." (missing (remove (cut valid-path? store <>) files))) (format #t "~{~a~%~}" missing))) + ((assoc-ref opts 'list) + (list-contents (current-input-port))) ((assoc-ref opts 'extract) => (lambda (target) diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh index fdaeb98ad2..4c5eea05cf 100644 --- a/tests/guix-archive.sh +++ b/tests/guix-archive.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013, 2014, 2015 Ludovic Courtès +# Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès # # This file is part of GNU Guix. # @@ -74,5 +74,10 @@ guix archive -x "$tmpdir" < "$archive" test -x "$tmpdir/bin/guile" test -d "$tmpdir/lib/guile" +# Check '--list'. +guix archive -t < "$archive" | grep "^D /share/guile" +guix archive -t < "$archive" | grep "^x /bin/guile" +guix archive -t < "$archive" | grep "^r /share/guile.*/boot-9\.scm" + if echo foo | guix archive --authorize then false; else true; fi -- 2.24.0