mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
Add a libgcrypt-based implementation of `sha256'.
* guix/utils.scm (sha256): Add a libgcrypt-based implementation using the FFI.
This commit is contained in:
parent
f68b089361
commit
39b9372ca7
1 changed files with 35 additions and 12 deletions
|
@ -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))))))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue