guix hash, guix download: Add '--hash'.

* 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.

2 files changed, 29 insertions, 6 deletions

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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; 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*)))
 
@@ -90,6 +91,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
   (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 "))
   (format #t (G_ "
@@ -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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
@@ -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)