mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
guix hash: Add 'serializer' option.
* guix/scripts/hash.scm (%options): Deprecate 'recursive', add 'serializer'. (%default-options): Add 'serializer'. (nar-hash): New procedure. (default-hash): New procedure. (guix-hash)[file-hash]: Use them. (show-help): Adjust. * tests/guix-hash.scm: Adjust. * doc/guix.texi: Update. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
zimoun
Ludovic Courtès
parent
6e08f07f20
commit
05c962594c
3 changed files with 80 additions and 39 deletions
|
|
@ -71,7 +71,7 @@ Copyright @copyright{} 2019 Kyle Andrews@*
|
|||
Copyright @copyright{} 2019 Alex Griffin@*
|
||||
Copyright @copyright{} 2019, 2020, 2021 Guillaume Le Vaillant@*
|
||||
Copyright @copyright{} 2020 Liliana Marie Prikler@*
|
||||
Copyright @copyright{} 2019, 2020 Simon Tournier@*
|
||||
Copyright @copyright{} 2019, 2020, 2021 Simon Tournier@*
|
||||
Copyright @copyright{} 2020 Wiktor Żelazny@*
|
||||
Copyright @copyright{} 2020 Damien Cassou@*
|
||||
Copyright @copyright{} 2020 Jakub Kądziołka@*
|
||||
|
|
@ -11751,14 +11751,21 @@ in the definitions of packages.
|
|||
|
||||
@item --recursive
|
||||
@itemx -r
|
||||
Compute the hash on @var{file} recursively.
|
||||
This option is deprecated in favor of @option{--serializer}. It is a
|
||||
legacy alias for @var{type} sets to @code{nar}.
|
||||
|
||||
In this case, the hash is computed on an archive containing @var{file},
|
||||
including its children if it is a directory. Some of the metadata of
|
||||
@var{file} is part of the archive; for instance, when @var{file} is a
|
||||
regular file, the hash is different depending on whether @var{file} is
|
||||
executable or not. Metadata such as time stamps has no impact on the
|
||||
hash (@pxref{Invoking guix archive}).
|
||||
@item --serializer=@var{type}
|
||||
@itemx -S
|
||||
Compute the hash on @var{file} using @var{type} serialization.
|
||||
|
||||
Supported types: @code{none} and @code{nar}.
|
||||
|
||||
When using @code{nar}, the hash is computed on an archive containing
|
||||
@var{file}, including its children if it is a directory. Some of the
|
||||
metadata of @var{file} is part of the archive; for instance, when
|
||||
@var{file} is a regular file, the hash is different depending on whether
|
||||
@var{file} is executable or not. Metadata such as time stamps has no
|
||||
impact on the hash (@pxref{Invoking guix archive}).
|
||||
@c FIXME: Replace xref above with xref to an ``Archive'' section when
|
||||
@c it exists.
|
||||
|
||||
|
|
|
|||
|
|
@ -37,6 +37,29 @@ (define-module (guix scripts hash)
|
|||
#:use-module (srfi srfi-37)
|
||||
#:export (guix-hash))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Serializers
|
||||
;;;
|
||||
|
||||
(define* (nar-hash file #:optional
|
||||
(algorithm (assoc-ref %default-options 'hash-algorithm))
|
||||
select?)
|
||||
(let-values (((port get-hash)
|
||||
(open-hash-port algorithm)))
|
||||
(write-file file port #:select? select?)
|
||||
(force-output port)
|
||||
(get-hash)))
|
||||
|
||||
(define* (default-hash file #:optional
|
||||
(algorithm (assoc-ref %default-options 'hash-algorithm))
|
||||
select?)
|
||||
(match file
|
||||
("-" (port-hash algorithm (current-input-port)))
|
||||
(_
|
||||
(call-with-input-file file
|
||||
(cute port-hash algorithm <>)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Command-line options.
|
||||
|
|
@ -45,7 +68,8 @@ (define-module (guix scripts hash)
|
|||
(define %default-options
|
||||
;; Alist of default option values.
|
||||
`((format . ,bytevector->nix-base32-string)
|
||||
(hash-algorithm . ,(hash-algorithm sha256))))
|
||||
(hash-algorithm . ,(hash-algorithm sha256))
|
||||
(serializer . ,default-hash)))
|
||||
|
||||
(define (show-help)
|
||||
(display (G_ "Usage: guix hash [OPTION] FILE
|
||||
|
|
@ -61,7 +85,7 @@ (define (show-help)
|
|||
(format #t (G_ "
|
||||
-f, --format=FMT write the hash in the given format"))
|
||||
(format #t (G_ "
|
||||
-r, --recursive compute the hash on FILE recursively"))
|
||||
-S, --serializer=TYPE compute the hash on FILE according to TYPE serialization"))
|
||||
(newline)
|
||||
(display (G_ "
|
||||
-h, --help display this help and exit"))
|
||||
|
|
@ -102,7 +126,24 @@ (define fmt-proc
|
|||
(alist-delete 'format result))))
|
||||
(option '(#\r "recursive") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'recursive? #t result)))
|
||||
(warning (G_ "'--recursive' is deprecated, \
|
||||
use '--serializer' instead~%"))
|
||||
(alist-cons 'serializer nar-hash
|
||||
(alist-delete 'serializer result))))
|
||||
(option '(#\S "serializer") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(define serializer-proc
|
||||
(match arg
|
||||
("none"
|
||||
default-hash)
|
||||
("nar"
|
||||
nar-hash)
|
||||
(x
|
||||
(leave (G_ "unsupported serializer type: ~a~%")
|
||||
arg))))
|
||||
|
||||
(alist-cons 'serializer serializer-proc
|
||||
(alist-delete 'serializer result))))
|
||||
(option '(#\h "help") #f #f
|
||||
(lambda args
|
||||
(show-help)
|
||||
|
|
@ -145,35 +186,24 @@ (define (vcs-file? file stat)
|
|||
(fmt (assq-ref opts 'format))
|
||||
(select? (if (assq-ref opts 'exclude-vcs?)
|
||||
(negate vcs-file?)
|
||||
(const #t))))
|
||||
(const #t)))
|
||||
(algorithm (assoc-ref opts 'hash-algorithm))
|
||||
(serializer (assoc-ref opts 'serializer)))
|
||||
|
||||
(define (file-hash file)
|
||||
;; Compute the hash of FILE.
|
||||
;; Catch and gracefully report possible '&nar-error' conditions.
|
||||
(if (assoc-ref opts 'recursive?)
|
||||
;; Catch and gracefully report possible error
|
||||
(catch 'system-error
|
||||
(lambda _
|
||||
(with-error-handling
|
||||
(let-values (((port get-hash)
|
||||
(open-hash-port (assoc-ref opts 'hash-algorithm))))
|
||||
(write-file file port #:select? select?)
|
||||
(force-output port)
|
||||
(get-hash)))
|
||||
(catch 'system-error
|
||||
(lambda _
|
||||
(call-with-input-file file
|
||||
(cute port-hash (assoc-ref opts 'hash-algorithm)
|
||||
<>)))
|
||||
(lambda args
|
||||
(leave (G_ "~a ~a~%")
|
||||
file
|
||||
(strerror (system-error-errno args)))))))
|
||||
(serializer file algorithm select?)))
|
||||
(lambda args
|
||||
(leave (G_ "~a ~a~%")
|
||||
file
|
||||
(strerror (system-error-errno args))))))
|
||||
|
||||
(define (formatted-hash thing)
|
||||
(match thing
|
||||
("-" (with-error-handling
|
||||
(fmt (port-hash (assoc-ref opts 'hash-algorithm)
|
||||
(current-input-port)))))
|
||||
(_
|
||||
(fmt (file-hash thing)))))
|
||||
(fmt (file-hash thing)))
|
||||
|
||||
(match args
|
||||
(()
|
||||
|
|
|
|||
|
|
@ -48,25 +48,29 @@ chmod +x "$tmpdir/exe"
|
|||
( cd "$tmpdir" ; ln -s exe symlink )
|
||||
mkdir "$tmpdir/subdir"
|
||||
|
||||
test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
|
||||
test `guix hash -r "$tmpdir" -H sha512` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
|
||||
test `guix hash -S nar "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
|
||||
test `guix hash -S nar "$tmpdir" -H sha512` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
|
||||
|
||||
# Deprecated --recursive option
|
||||
test `guix hash -r "$tmpdir" 2>/dev/null` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
|
||||
test `guix hash -r "$tmpdir" -H sha512 2>/dev/null` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
|
||||
|
||||
# Without '-r', this should fail.
|
||||
! guix hash "$tmpdir"
|
||||
|
||||
# This should fail because /dev/null is a character device, which
|
||||
# the archive format doesn't support.
|
||||
! guix hash -r /dev/null
|
||||
! guix hash -S nar /dev/null
|
||||
|
||||
# Adding a .git directory
|
||||
mkdir "$tmpdir/.git"
|
||||
touch "$tmpdir/.git/foo"
|
||||
|
||||
# ...changes the hash
|
||||
test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59
|
||||
test `guix hash -S nar $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59
|
||||
|
||||
# ...but remains the same when using `-x'
|
||||
test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
|
||||
test `guix hash -S nar $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
|
||||
|
||||
# Without '-r', this should fail.
|
||||
! guix hash "$tmpdir"
|
||||
|
|
|
|||
Loading…
Reference in a new issue