mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
3 changed files with 62 additions and 2 deletions
|
@ -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
|
||||
|
||||
|
||||
|
|
|
@ -21,7 +21,8 @@ (define-module (guix scripts archive)
|
|||
#: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 @@ (define-module (guix scripts archive)
|
|||
#: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 @@ (define (show-help)
|
|||
--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 @@ (define %options
|
|||
(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 @@ (define (read-key)
|
|||
(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 @@ (define (lines 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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue