[bug#41382] [PATCH 3/6] guix hash, guix download: Add '--hash'.

[Ludovic Courtès]

* guix/scripts/download.scm (%default-options): Add 'hash-algorithm'.
(show-help, %options): Add "--hash".
(guix-download): Honor it.
* guix/scripts/hash.scm (%default-options): Add 'hash-algorithm'.
(show-help, %options): Add "--hash".
(guix-hash): Honor it.
* tests/guix-hash.sh: Test '-H sha512'.
* doc/guix.texi (Invoking guix download): Document it.
(Invoking guix hash): Document it.
---
 doc/guix.texi             | 15 +++++++++++++++
 guix/scripts/download.scm | 14 ++++++++++++--
 guix/scripts/hash.scm     | 21 +++++++++++++++++----
 tests/guix-hash.sh        |  6 +++++-
 4 files changed, 49 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index eef5b703fe..0cf006770e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9018,6 +9018,11 @@ Certificates}), unless @option{--no-check-certificate} 
is used.
 The following options are available:
 
 @table @code
+@item --hash=@var{algorithm}
+@itemx -H @var{algorithm}
+Compute a hash using the specified @var{algorithm}.  @xref{Invoking guix
+hash}, for more information.
+
 @item --format=@var{fmt}
 @itemx -f @var{fmt}
 Write the hash in the format specified by @var{fmt}.  For more
@@ -9057,6 +9062,16 @@ following options:
 
 @table @code
 
+@item --hash=@var{algorithm}
+@itemx -H @var{algorithm}
+Compute a hash using the specified @var{algorithm}, @code{sha256} by
+default.
+
+@var{algorithm} must the name of a cryptographic hash algorithm
+supported by Libgcrypt @i{via} Guile-Gcrypt---e.g., @code{sha512} or
+@code{sha3-256} (@pxref{Hash Functions,,, guile-gcrypt, Guile-Gcrypt
+Reference Manual}).
+
 @item --format=@var{fmt}
 @itemx -f @var{fmt}
 Write the hash in the format specified by @var{fmt}.
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 22cd75ea0b..b4446c2e2f 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2020 Ludovic Courtès 
<address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -77,6 +77,7 @@
 (define %default-options
   ;; Alist of default option values.
   `((format . ,bytevector->nix-base32-string)
+    (hash-algorithm . ,(hash-algorithm sha256))
     (verify-certificate? . #t)
     (download-proc . ,download-to-store*)))
 
@@ -89,6 +90,8 @@ Supported formats: 'nix-base32' (default), 'base32', 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_ "
+  -H, --hash=ALGORITHM   use the given hash ALGORITHM"))
   (format #t (G_ "
       --no-check-certificate
                          do not validate the certificate of HTTPS servers "))
@@ -119,6 +122,13 @@ Supported formats: 'nix-base32' (default), 'base32', and 
'base16'
 
                   (alist-cons 'format fmt-proc
                               (alist-delete 'format result))))
+        (option '(#\H "hash") #t #f
+                (lambda (opt name arg result)
+                  (match (lookup-hash-algorithm (string->symbol arg))
+                    (#f
+                     (leave (G_ "~a: unknown hash algorithm~%") arg))
+                    (algo
+                     (alist-cons 'hash-algorithm algo result)))))
         (option '("no-check-certificate") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'verify-certificate? #f result)))
@@ -175,7 +185,7 @@ Supported formats: 'nix-base32' (default), 'base32', and 
'base16'
                       (or path
                           (leave (G_ "~a: download failed~%")
                                  arg))
-                    port-sha256))
+                    (cute port-hash (assoc-ref opts 'hash-algorithm) <>)))
            (fmt   (assq-ref opts 'format)))
       (format #t "~a~%~a~%" path (fmt hash))
       #t)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index b8b2158195..cfc4420260 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2020 Ludovic Courtès 
<address@hidden>
 ;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
 ;;; Copyright © 2018 Tim Gesthuizen <address@hidden>
@@ -42,7 +42,8 @@
 
 (define %default-options
   ;; Alist of default option values.
-  `((format . ,bytevector->nix-base32-string)))
+  `((format . ,bytevector->nix-base32-string)
+    (hash-algorithm . ,(hash-algorithm sha256))))
 
 (define (show-help)
   (display (G_ "Usage: guix hash [OPTION] FILE
@@ -53,6 +54,8 @@ and 'hexadecimal' can be used as well).\n"))
   (format #t (G_ "
   -x, --exclude-vcs      exclude version control directories"))
   (format #t (G_ "
+  -H, --hash=ALGORITHM   use the given hash ALGORITHM"))
+  (format #t (G_ "
   -f, --format=FMT       write the hash in the given format"))
   (format #t (G_ "
   -r, --recursive        compute the hash on FILE recursively"))
@@ -69,6 +72,13 @@ and 'hexadecimal' can be used as well).\n"))
   (list (option '(#\x "exclude-vcs") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'exclude-vcs? #t result)))
+        (option '(#\H "hash") #t #f
+                (lambda (opt name arg result)
+                  (match (lookup-hash-algorithm (string->symbol arg))
+                    (#f
+                     (leave (G_ "~a: unknown hash algorithm~%") arg))
+                    (algo
+                     (alist-cons 'hash-algorithm algo result)))))
         (option '(#\f "format") #t #f
                 (lambda (opt name arg result)
                   (define fmt-proc
@@ -139,8 +149,11 @@ and 'hexadecimal' can be used as well).\n"))
               (force-output port)
               (get-hash))
             (match file
-              ("-" (port-sha256 (current-input-port)))
-              (_   (call-with-input-file file port-sha256))))))
+              ("-" (port-hash (assoc-ref opts 'hash-algorithm)
+                              (current-input-port)))
+              (_   (call-with-input-file file
+                     (cute port-hash (assoc-ref opts 'hash-algorithm)
+                           <>)))))))
 
     (match args
       ((file)
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 190c9e7f8a..1c595b49ed 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2014, 2016 Ludovic Courtès <address@hidden>
+# Copyright © 2013, 2014, 2016, 2020 Ludovic Courtès <address@hidden>
 # Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
 #
 # This file is part of GNU Guix.
@@ -31,6 +31,10 @@ test `echo -n | guix hash -` = 
0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9
 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
+test `guix hash -H sha512 -f hex /dev/null` = 
cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e
+
+if guix hash -H abcd1234 /dev/null;
+then false; else true; fi
 
 mkdir "$tmpdir"
 echo -n executable > "$tmpdir/exe"
-- 
2.26.2