From 3140f2df423d1235c3766e3478a429ac89d882ed Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 21 Feb 2014 17:54:32 +0100
Subject: 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.
---
 guix/nar.scm          |  4 ++--
 guix/scripts/hash.scm | 25 +++++++++++++++++++++----
 2 files changed, 23 insertions(+), 6 deletions(-)

(limited to 'guix')

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))))))
-- 
cgit v1.2.3