04/06: guix hash: Add 'serializer' option.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 05c962594c346da21f201be72caadfa19060cc9d
Author: zimoun <zimon.toutoune@gmail.com>
AuthorDate: Thu Nov 18 01:20:22 2021 +0100

    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         | 25 ++++++++++------
 guix/scripts/hash.scm | 82 +++++++++++++++++++++++++++++++++++----------------
 tests/guix-hash.sh    | 14 +++++----
 3 files changed, 81 insertions(+), 40 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f531985..7f579f8 100644
--- a/doc/guix.texi
+++ b/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.
-
-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}).
+This option is deprecated in favor of @option{--serializer}.  It is a
+legacy alias for @var{type} sets to @code{nar}.
+
+@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.
 
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index d3b293d..debe8b4 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -39,13 +39,37 @@
 
 
 ;;;
+;;; 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.
 ;;;
 
 (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 @@ and 'base16' ('hex' and 'hexadecimal' can be used as 
well).\n"))
   (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 @@ and 'base16' ('hex' and 'hexadecimal' can be used as 
well).\n"))
                               (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 @@ and 'base16' ('hex' and 'hexadecimal' can be used as 
well).\n"))
          (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
       (()
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 1e9a0ec..7d186c9 100644
--- a/tests/guix-hash.sh
+++ b/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 -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"