Add a libgcrypt-based implementation of `sha256'.

* guix/utils.scm (sha256): Add a libgcrypt-based implementation using
  the FFI.
This commit is contained in:
Ludovic Courtès 2012-06-29 22:58:27 +02:00
parent f68b089361
commit 39b9372ca7

View file

@ -30,6 +30,7 @@ (define-module (guix utils)
#: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 @@ (define bv
;;; 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 @@ (define (sha256 bv)
(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))))))))))