Add a sha256 fallback that uses Coreutils instead of libchop.

* guix/utils.scm (compile-time-value): Move to the top.
  (sha256): Add an implementation that uses Coreutils, for when libchop
  is unavailable.

1 files changed, 45 insertions, 15 deletions

diff --git a/guix/utils.scm b/guix/utils.scm
index bcea0193d0..31046bf2f4 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -23,15 +23,13 @@
   #:use-module (srfi srfi-39)
   #:use-module (srfi srfi-60)
   #:use-module (rnrs bytevectors)
+  #:use-module ((rnrs io ports) #:select (put-bytevector))
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
   #:autoload   (ice-9 popen)  (open-pipe*)
   #:autoload   (ice-9 rdelim) (read-line)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
-  #:use-module ((chop hash)
-                #:select (bytevector-hash
-                          hash-method/sha256))
   #:export (bytevector-quintet-length
             bytevector->base32-string
             bytevector->nix-base32-string
@@ -52,6 +50,22 @@
 
 
 ;;;
+;;; Compile-time computations.
+;;;
+
+(define-syntax compile-time-value
+  (syntax-rules ()
+    "Evaluate the given expression at compile time.  The expression must
+evaluate to a simple datum."
+    ((_ exp)
+     (let-syntax ((v (lambda (s)
+                       (let ((val exp))
+                         (syntax-case s ()
+                           (_ #`'#,(datum->syntax s val)))))))
+       v))))
+
+
+;;;
 ;;; Base 32.
 ;;;
 
@@ -369,7 +383,34 @@ starting from the right of S."
 
 (define (sha256 bv)
   "Return the SHA256 of BV as a bytevector."
-  (bytevector-hash hash-method/sha256 bv))
+  (if (compile-time-value
+       (false-if-exception (resolve-interface '(chop hash))))
+      (let ((bytevector-hash    (@ (chop hash) bytevector-hash))
+            (hash-method/sha256 (@ (chop hash) hash-method/sha256)))
+        (bytevector-hash hash-method/sha256 bv))
+      ;; XXX: Slow, poor programmer's implementation that uses Coreutils.
+      (let ((in  (pipe))
+            (out (pipe))
+            (pid (primitive-fork)))
+        (if (= 0 pid)
+            (begin                                      ; child
+              (close (cdr in))
+              (close (car out))
+              (close 0)
+              (close 1)
+              (dup2 (fileno (car in)) 0)
+              (dup2 (fileno (cdr out)) 1)
+              (execlp "sha256sum" "sha256sum"))
+            (begin                                      ; parent
+              (close (car in))
+              (close (cdr out))
+              (put-bytevector (cdr in) bv)
+              (close (cdr in))                        ; EOF
+              (let ((line (car (string-tokenize (read-line (car out))))))
+                (close (car out))
+                (and (and=> (status:exit-val (cdr (waitpid pid)))
+                            zero?)
+                     (base16-string->bytevector line))))))))
 
 
 
@@ -377,17 +418,6 @@ starting from the right of S."
 ;;; Nixpkgs.
 ;;;
 
-(define-syntax compile-time-value
-  (syntax-rules ()
-    "Evaluate the given expression at compile time.  The expression must
-evaluate to a simple datum."
-    ((_ exp)
-     (let-syntax ((v (lambda (s)
-                       (let ((val exp))
-                         (syntax-case s ()
-                           (_ #`'#,(datum->syntax s val)))))))
-       v))))
-
 (define %nixpkgs-directory
   (make-parameter
    ;; Capture the build-time value of $NIXPKGS.