From 39b9372ca7077afa938291f6cb3c88798e1cb704 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 29 Jun 2012 22:58:27 +0200
Subject: Add a libgcrypt-based implementation of `sha256'.

* guix/utils.scm (sha256): Add a libgcrypt-based implementation using
  the FFI.
---
 guix/utils.scm | 47 +++++++++++++++++++++++++++++++++++------------
 1 file changed, 35 insertions(+), 12 deletions(-)

diff --git a/guix/utils.scm b/guix/utils.scm
index 31046bf2f4..46983dc1bc 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -30,6 +30,7 @@
   #:autoload   (ice-9 rdelim) (read-line)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:autoload   (system foreign) (pointer->procedure)
   #:export (bytevector-quintet-length
             bytevector->base32-string
             bytevector->nix-base32-string
@@ -381,19 +382,41 @@ starting from the right of S."
 ;;; Hash.
 ;;;
 
-(define (sha256 bv)
-  "Return the SHA256 of BV as a bytevector."
-  (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.
+(define sha256
+  (cond
+   ((compile-time-value
+     (false-if-exception (dynamic-link "libgcrypt")))
+    ;; Using libgcrypt.
+    (let ((hash   (pointer->procedure void
+                                      (dynamic-func "gcry_md_hash_buffer"
+                                                    (dynamic-link "libgcrypt"))
+                                      `(,int * * ,size_t)))
+          (sha256 8))                           ; GCRY_MD_SHA256, as of 1.5.0
+      (lambda (bv)
+        "Return the SHA256 of BV as a bytevector."
+        (let ((digest (make-bytevector (/ 256 8))))
+          (hash sha256 (bytevector->pointer digest)
+                (bytevector->pointer bv) (bytevector-length bv))
+          digest))))
+
+   ((compile-time-value
+     (false-if-exception (resolve-interface '(chop hash))))
+    ;; Using libchop.
+    (let ((bytevector-hash    (@ (chop hash) bytevector-hash))
+          (hash-method/sha256 (@ (chop hash) hash-method/sha256)))
+      (lambda (bv)
+        "Return the SHA256 of BV as a bytevector."
+        (bytevector-hash hash-method/sha256 bv))))
+
+   (else
+    ;; Slow, poor programmer's implementation that uses Coreutils.
+    (lambda (bv)
+      "Return the SHA256 of BV as a bytevector."
       (let ((in  (pipe))
             (out (pipe))
             (pid (primitive-fork)))
         (if (= 0 pid)
-            (begin                                      ; child
+            (begin                                 ; child
               (close (cdr in))
               (close (car out))
               (close 0)
@@ -401,16 +424,16 @@ starting from the right of S."
               (dup2 (fileno (car in)) 0)
               (dup2 (fileno (cdr out)) 1)
               (execlp "sha256sum" "sha256sum"))
-            (begin                                      ; parent
+            (begin                                 ; parent
               (close (car in))
               (close (cdr out))
               (put-bytevector (cdr in) bv)
-              (close (cdr in))                        ; EOF
+              (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))))))))
+                     (base16-string->bytevector line))))))))))
 
 
 
-- 
cgit v1.2.3