From 3140f2df423d1235c3766e3478a429ac89d882ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 21 Feb 2014 17:54:32 +0100 Subject: [PATCH] guix hash: Add '--recursive'. * guix/scripts/hash.scm (show-help): Add --recursive. (%options): Likewise. (guix-hash)[file-hash]: New procedure. Honor --recursive. Use it. * guix/nar.scm (write-file): Add missing field to the &nar-error condition raised upon unsupported file type; change its message to be more descriptive. * tests/guix-hash.sh: Add tests with -r. * doc/guix.texi (Invoking guix hash): Document --recursive. --- doc/guix.texi | 13 +++++++++++++ guix/nar.scm | 4 ++-- guix/scripts/hash.scm | 25 +++++++++++++++++++++---- tests/guix-hash.sh | 22 +++++++++++++++++++++- 4 files changed, 57 insertions(+), 7 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 34f6810f34..ce011959ad 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1958,6 +1958,19 @@ If the @option{--format} option is not specified, @command{guix hash} will output the hash in @code{nix-base32}. This representation is used in the definitions of packages. +@item --recursive +@itemx -r +Compute the hash on @var{file} recursively. + +In this case, the hash is computed on an archive containing @var{file}, +including its children if it is a directory. Some of @var{file}'s +meta-data 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. Meta-data 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. + @end table @node Invoking guix refresh diff --git a/guix/nar.scm b/guix/nar.scm index 89a71302e0..9ba6e4ce2c 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -195,8 +195,8 @@ sub-directories of FILE as needed." (write-string "target" p) (write-string (readlink f) p)) (else - (raise (condition (&message (message "ENOSYS")) - (&nar-error))))) + (raise (condition (&message (message "unsupported file type")) + (&nar-error (file f) (port port)))))) (write-string ")" p)))) (define (restore-file port file) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index 4e66aa0f3e..ea8c2ada6b 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -20,12 +20,14 @@ (define-module (guix scripts hash) #:use-module (guix base32) #:use-module (guix hash) + #:use-module (guix nar) #:use-module (guix ui) #:use-module (guix utils) #:use-module (rnrs io ports) #:use-module (rnrs files) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:export (guix-hash)) @@ -43,10 +45,12 @@ (display (_ "Usage: guix hash [OPTION] FILE Return the cryptographic hash of FILE. -Supported formats: 'nix-base32' (default), 'base32', and 'base16' -('hex' and 'hexadecimal' can be used as well).\n")) +Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex' +and 'hexadecimal' can be used as well).\n")) (format #t (_ " -f, --format=FMT write the hash in the given format")) + (format #t (_ " + -r, --recursive compute the hash on FILE recursively")) (newline) (display (_ " -h, --help display this help and exit")) @@ -73,6 +77,9 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16' (alist-cons 'format fmt-proc (alist-delete 'format result)))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive? #t result))) (option '(#\h "help") #f #f (lambda args @@ -107,12 +114,22 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16' (reverse opts))) (fmt (assq-ref opts 'format))) + (define (file-hash file) + ;; Compute the hash of FILE. + ;; Catch and gracefully report possible '&nar-error' conditions. + (with-error-handling + (if (assoc-ref opts 'recursive?) + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port) + (flush-output-port port) + (get-hash)) + (call-with-input-file file port-sha256)))) + (match args ((file) (catch 'system-error (lambda () - (format #t "~a~%" - (fmt (call-with-input-file file port-sha256)))) + (format #t "~a~%" (fmt (file-hash file)))) (lambda args (leave (_ "~a~%") (strerror (system-error-errno args)))))) diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh index 53325ce1f4..23df01d417 100644 --- a/tests/guix-hash.sh +++ b/tests/guix-hash.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013 Ludovic Courtès +# Copyright © 2013, 2014 Ludovic Courtès # # This file is part of GNU Guix. # @@ -22,7 +22,27 @@ guix hash --version +tmpdir="guix-hash-$$" +trap 'rm -rf "$tmpdir"' EXIT + test `guix hash /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 test `guix hash -f nix-base32 /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 test `guix hash -f hex /dev/null` = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfeswmrw6csxbkq + +mkdir "$tmpdir" +echo -n executable > "$tmpdir/exe" +chmod +x "$tmpdir/exe" +( cd "$tmpdir" ; ln -s exe symlink ) +mkdir "$tmpdir/subdir" + +test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p + +# Without '-r', this should fail. +if guix hash "$tmpdir" +then false; else true; fi + +# This should fail because /dev/null is a character device, which +# the archive format doesn't support. +if guix hash -r /dev/null +then false; else true; fi