diff options
| -rw-r--r-- | guix/utils.scm | 47 |
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)))))))))) |