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>

doc/guix.texi

@@ -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},
+@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 it exists.
 

guix/scripts/hash.scm

@@ -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.
+     ;; Catch and gracefully report possible error
-      (if (assoc-ref opts 'recursive?)
-          (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
+          (with-error-handling
-                (cute port-hash (assoc-ref opts 'hash-algorithm)
+            (serializer file algorithm select?)))
-                      <>)))
         (lambda args
           (leave (G_ "~a ~a~%")
                  file
-                     (strerror (system-error-errno args)))))))
+                 (strerror (system-error-errno args))))))
 
     (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
       (()

tests/guix-hash.sh

@@ -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 -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.
 ! 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"