Add a libgcrypt-based implementation of `sha256'.

* guix/utils.scm (sha256): Add a libgcrypt-based implementation using
  the FFI.
master
Ludovic Courtès 2012-06-29 22:58:27 +02:00
parent f68b089361
commit 39b9372ca7
1 changed files with 35 additions and 12 deletions

View File

@ -30,6 +30,7 @@
#:autoload (ice-9 rdelim) (read-line) #:autoload (ice-9 rdelim) (read-line)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:autoload (system foreign) (pointer->procedure)
#:export (bytevector-quintet-length #:export (bytevector-quintet-length
bytevector->base32-string bytevector->base32-string
bytevector->nix-base32-string bytevector->nix-base32-string
@ -381,19 +382,41 @@ starting from the right of S."
;;; Hash. ;;; Hash.
;;; ;;;
(define (sha256 bv) (define sha256
"Return the SHA256 of BV as a bytevector." (cond
(if (compile-time-value ((compile-time-value
(false-if-exception (resolve-interface '(chop hash)))) (false-if-exception (dynamic-link "libgcrypt")))
(let ((bytevector-hash (@ (chop hash) bytevector-hash)) ;; Using libgcrypt.
(hash-method/sha256 (@ (chop hash) hash-method/sha256))) (let ((hash (pointer->procedure void
(bytevector-hash hash-method/sha256 bv)) (dynamic-func "gcry_md_hash_buffer"
;; XXX: Slow, poor programmer's implementation that uses Coreutils. (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)) (let ((in (pipe))
(out (pipe)) (out (pipe))
(pid (primitive-fork))) (pid (primitive-fork)))
(if (= 0 pid) (if (= 0 pid)
(begin ; child (begin ; child
(close (cdr in)) (close (cdr in))
(close (car out)) (close (car out))
(close 0) (close 0)
@ -401,16 +424,16 @@ starting from the right of S."
(dup2 (fileno (car in)) 0) (dup2 (fileno (car in)) 0)
(dup2 (fileno (cdr out)) 1) (dup2 (fileno (cdr out)) 1)
(execlp "sha256sum" "sha256sum")) (execlp "sha256sum" "sha256sum"))
(begin ; parent (begin ; parent
(close (car in)) (close (car in))
(close (cdr out)) (close (cdr out))
(put-bytevector (cdr in) bv) (put-bytevector (cdr in) bv)
(close (cdr in)) ; EOF (close (cdr in)) ; EOF
(let ((line (car (string-tokenize (read-line (car out)))))) (let ((line (car (string-tokenize (read-line (car out))))))
(close (car out)) (close (car out))
(and (and=> (status:exit-val (cdr (waitpid pid))) (and (and=> (status:exit-val (cdr (waitpid pid)))
zero?) zero?)
(base16-string->bytevector line)))))))) (base16-string->bytevector line))))))))))