me
/
guix
Archived
1
0
Fork 0

guix archive: Add '--list'.

* 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.
master
Ludovic Courtès 2019-12-04 22:54:05 +01:00
parent 12c1afcdbd
commit 044277f610
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 62 additions and 2 deletions

View File

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

View File

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

View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
#
# 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