mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38: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:
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 Alex Griffin@*
|
||||||
Copyright @copyright{} 2019, 2020, 2021 Guillaume Le Vaillant@*
|
Copyright @copyright{} 2019, 2020, 2021 Guillaume Le Vaillant@*
|
||||||
Copyright @copyright{} 2020 Liliana Marie Prikler@*
|
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 Wiktor Żelazny@*
|
||||||
Copyright @copyright{} 2020 Damien Cassou@*
|
Copyright @copyright{} 2020 Damien Cassou@*
|
||||||
Copyright @copyright{} 2020 Jakub Kądziołka@*
|
Copyright @copyright{} 2020 Jakub Kądziołka@*
|
||||||
|
@ -11751,14 +11751,21 @@ in the definitions of packages.
|
||||||
|
|
||||||
@item --recursive
|
@item --recursive
|
||||||
@itemx -r
|
@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},
|
@item --serializer=@var{type}
|
||||||
including its children if it is a directory. Some of the metadata of
|
@itemx -S
|
||||||
@var{file} is part of the archive; for instance, when @var{file} is a
|
Compute the hash on @var{file} using @var{type} serialization.
|
||||||
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
|
Supported types: @code{none} and @code{nar}.
|
||||||
hash (@pxref{Invoking guix archive}).
|
|
||||||
|
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 FIXME: Replace xref above with xref to an ``Archive'' section when
|
||||||
@c it exists.
|
@c it exists.
|
||||||
|
|
||||||
|
|
|
@ -37,6 +37,29 @@ (define-module (guix scripts hash)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:export (guix-hash))
|
#: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.
|
;;; Command-line options.
|
||||||
|
@ -45,7 +68,8 @@ (define-module (guix scripts hash)
|
||||||
(define %default-options
|
(define %default-options
|
||||||
;; Alist of default option values.
|
;; Alist of default option values.
|
||||||
`((format . ,bytevector->nix-base32-string)
|
`((format . ,bytevector->nix-base32-string)
|
||||||
(hash-algorithm . ,(hash-algorithm sha256))))
|
(hash-algorithm . ,(hash-algorithm sha256))
|
||||||
|
(serializer . ,default-hash)))
|
||||||
|
|
||||||
(define (show-help)
|
(define (show-help)
|
||||||
(display (G_ "Usage: guix hash [OPTION] FILE
|
(display (G_ "Usage: guix hash [OPTION] FILE
|
||||||
|
@ -61,7 +85,7 @@ (define (show-help)
|
||||||
(format #t (G_ "
|
(format #t (G_ "
|
||||||
-f, --format=FMT write the hash in the given format"))
|
-f, --format=FMT write the hash in the given format"))
|
||||||
(format #t (G_ "
|
(format #t (G_ "
|
||||||
-r, --recursive compute the hash on FILE recursively"))
|
-S, --serializer=TYPE compute the hash on FILE according to TYPE serialization"))
|
||||||
(newline)
|
(newline)
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
|
@ -102,7 +126,24 @@ (define fmt-proc
|
||||||
(alist-delete 'format result))))
|
(alist-delete 'format result))))
|
||||||
(option '(#\r "recursive") #f #f
|
(option '(#\r "recursive") #f #f
|
||||||
(lambda (opt name arg result)
|
(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
|
(option '(#\h "help") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-help)
|
(show-help)
|
||||||
|
@ -145,35 +186,24 @@ (define (vcs-file? file stat)
|
||||||
(fmt (assq-ref opts 'format))
|
(fmt (assq-ref opts 'format))
|
||||||
(select? (if (assq-ref opts 'exclude-vcs?)
|
(select? (if (assq-ref opts 'exclude-vcs?)
|
||||||
(negate vcs-file?)
|
(negate vcs-file?)
|
||||||
(const #t))))
|
(const #t)))
|
||||||
|
(algorithm (assoc-ref opts 'hash-algorithm))
|
||||||
|
(serializer (assoc-ref opts 'serializer)))
|
||||||
|
|
||||||
(define (file-hash file)
|
(define (file-hash file)
|
||||||
;; Compute the hash of FILE.
|
;; Compute the hash of FILE.
|
||||||
;; Catch and gracefully report possible '&nar-error' conditions.
|
;; Catch and gracefully report possible error
|
||||||
(if (assoc-ref opts 'recursive?)
|
(catch 'system-error
|
||||||
|
(lambda _
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(let-values (((port get-hash)
|
(serializer file algorithm select?)))
|
||||||
(open-hash-port (assoc-ref opts 'hash-algorithm))))
|
(lambda args
|
||||||
(write-file file port #:select? select?)
|
(leave (G_ "~a ~a~%")
|
||||||
(force-output port)
|
file
|
||||||
(get-hash)))
|
(strerror (system-error-errno args))))))
|
||||||
(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)))))))
|
|
||||||
|
|
||||||
(define (formatted-hash thing)
|
(define (formatted-hash thing)
|
||||||
(match thing
|
(fmt (file-hash thing)))
|
||||||
("-" (with-error-handling
|
|
||||||
(fmt (port-hash (assoc-ref opts 'hash-algorithm)
|
|
||||||
(current-input-port)))))
|
|
||||||
(_
|
|
||||||
(fmt (file-hash thing)))))
|
|
||||||
|
|
||||||
(match args
|
(match args
|
||||||
(()
|
(()
|
||||||
|
|
|
@ -48,25 +48,29 @@ chmod +x "$tmpdir/exe"
|
||||||
( cd "$tmpdir" ; ln -s exe symlink )
|
( cd "$tmpdir" ; ln -s exe symlink )
|
||||||
mkdir "$tmpdir/subdir"
|
mkdir "$tmpdir/subdir"
|
||||||
|
|
||||||
test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
|
test `guix hash -S nar "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
|
||||||
test `guix hash -r "$tmpdir" -H sha512` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
|
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.
|
# Without '-r', this should fail.
|
||||||
! guix hash "$tmpdir"
|
! guix hash "$tmpdir"
|
||||||
|
|
||||||
# This should fail because /dev/null is a character device, which
|
# This should fail because /dev/null is a character device, which
|
||||||
# the archive format doesn't support.
|
# the archive format doesn't support.
|
||||||
! guix hash -r /dev/null
|
! guix hash -S nar /dev/null
|
||||||
|
|
||||||
# Adding a .git directory
|
# Adding a .git directory
|
||||||
mkdir "$tmpdir/.git"
|
mkdir "$tmpdir/.git"
|
||||||
touch "$tmpdir/.git/foo"
|
touch "$tmpdir/.git/foo"
|
||||||
|
|
||||||
# ...changes the hash
|
# ...changes the hash
|
||||||
test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59
|
test `guix hash -S nar $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59
|
||||||
|
|
||||||
# ...but remains the same when using `-x'
|
# ...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.
|
# Without '-r', this should fail.
|
||||||
! guix hash "$tmpdir"
|
! guix hash "$tmpdir"
|
||||||
|
|
Loading…
Reference in a new issue