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.
This commit is contained in:
parent
12c1afcdbd
commit
044277f610
|
@ -4598,6 +4598,18 @@ unsafe.
|
||||||
The primary purpose of this operation is to facilitate inspection of
|
The primary purpose of this operation is to facilitate inspection of
|
||||||
archive contents coming from possibly untrusted substitute servers.
|
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
|
@end table
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -21,7 +21,8 @@
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix combinators)
|
#:use-module (guix combinators)
|
||||||
#:use-module ((guix build utils) #:select (mkdir-p))
|
#: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 store)
|
||||||
#:use-module ((guix status) #:select (with-status-verbosity))
|
#:use-module ((guix status) #:select (with-status-verbosity))
|
||||||
#:use-module (guix grafts)
|
#:use-module (guix grafts)
|
||||||
|
@ -43,6 +44,7 @@
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
|
#:use-module (rnrs bytevectors)
|
||||||
#:export (guix-archive
|
#:export (guix-archive
|
||||||
options->derivations+files))
|
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"))
|
--missing print the files from stdin that are missing"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-x, --extract=DIR extract the archive on stdin to DIR"))
|
-x, --extract=DIR extract the archive on stdin to DIR"))
|
||||||
|
(display (G_ "
|
||||||
|
-t, --list list the files in the archive on stdin"))
|
||||||
(newline)
|
(newline)
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
--generate-key[=PARAMETERS]
|
--generate-key[=PARAMETERS]
|
||||||
|
@ -137,6 +141,9 @@ Export/import one or more packages from/to the store.\n"))
|
||||||
(option '("extract" #\x) #t #f
|
(option '("extract" #\x) #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'extract 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
|
(option '("generate-key") #f #t
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(catch 'gcry-error
|
(catch 'gcry-error
|
||||||
|
@ -319,6 +326,40 @@ the input port."
|
||||||
(with-atomic-file-output %acl-file
|
(with-atomic-file-output %acl-file
|
||||||
(cut write-acl acl <>)))))
|
(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 (guix-archive . args)
|
||||||
(define (lines port)
|
(define (lines port)
|
||||||
;; Return lines read from PORT.
|
;; Return lines read from PORT.
|
||||||
|
@ -353,6 +394,8 @@ the input port."
|
||||||
(missing (remove (cut valid-path? store <>)
|
(missing (remove (cut valid-path? store <>)
|
||||||
files)))
|
files)))
|
||||||
(format #t "~{~a~%~}" missing)))
|
(format #t "~{~a~%~}" missing)))
|
||||||
|
((assoc-ref opts 'list)
|
||||||
|
(list-contents (current-input-port)))
|
||||||
((assoc-ref opts 'extract)
|
((assoc-ref opts 'extract)
|
||||||
=>
|
=>
|
||||||
(lambda (target)
|
(lambda (target)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
# GNU Guix --- Functional package management for GNU
|
# 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.
|
# This file is part of GNU Guix.
|
||||||
#
|
#
|
||||||
|
@ -74,5 +74,10 @@ guix archive -x "$tmpdir" < "$archive"
|
||||||
test -x "$tmpdir/bin/guile"
|
test -x "$tmpdir/bin/guile"
|
||||||
test -d "$tmpdir/lib/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
|
if echo foo | guix archive --authorize
|
||||||
then false; else true; fi
|
then false; else true; fi
|
||||||
|
|
Loading…
Reference in New Issue