summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/utils.scm47
1 files 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))))))))))