hash: Add 'sha1'.

* guix/hash.scm (GCRY_MD_SHA1): New macro.
(bytevector-hash): New procedure.
(sha256): Express in terms of 'bytevector-hash'.
(sha1): New procedure.
* tests/hash.scm ("sha1, empty", "sha1, hello"): New tests.
This commit is contained in:
Ludovic Courtès 2018-03-08 11:47:28 +01:00
parent 3aab885144
commit 33286075b9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 25 additions and 6 deletions

View File

@ -23,7 +23,9 @@
#:use-module (system foreign) #:use-module (system foreign)
#:use-module ((guix build utils) #:select (dump-port)) #:use-module ((guix build utils) #:select (dump-port))
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:export (sha256 #:use-module (srfi srfi-26)
#:export (sha1
sha256
open-sha256-port open-sha256-port
port-sha256 port-sha256
file-sha256 file-sha256
@ -44,17 +46,26 @@
;; Value as of Libgcrypt 1.5.2. ;; Value as of Libgcrypt 1.5.2.
(identifier-syntax 8)) (identifier-syntax 8))
(define sha256 (define-syntax GCRY_MD_SHA1
(identifier-syntax 2))
(define bytevector-hash
(let ((hash (pointer->procedure void (let ((hash (pointer->procedure void
(libgcrypt-func "gcry_md_hash_buffer") (libgcrypt-func "gcry_md_hash_buffer")
`(,int * * ,size_t)))) `(,int * * ,size_t))))
(lambda (bv) (lambda (bv type size)
"Return the SHA256 of BV as a bytevector." "Return the hash TYPE, of SIZE bytes, of BV as a bytevector."
(let ((digest (make-bytevector (/ 256 8)))) (let ((digest (make-bytevector size)))
(hash GCRY_MD_SHA256 (bytevector->pointer digest) (hash type (bytevector->pointer digest)
(bytevector->pointer bv) (bytevector-length bv)) (bytevector->pointer bv) (bytevector-length bv))
digest)))) digest))))
(define sha1
(cut bytevector-hash <> GCRY_MD_SHA1 20))
(define sha256
(cut bytevector-hash <> GCRY_MD_SHA256 (/ 256 8)))
(define open-sha256-md (define open-sha256-md
(let ((open (pointer->procedure int (let ((open (pointer->procedure int
(libgcrypt-func "gcry_md_open") (libgcrypt-func "gcry_md_open")

View File

@ -40,6 +40,14 @@
(test-begin "hash") (test-begin "hash")
(test-equal "sha1, empty"
(base16-string->bytevector "da39a3ee5e6b4b0d3255bfef95601890afd80709")
(sha1 #vu8()))
(test-equal "sha1, hello"
(base16-string->bytevector "2aae6c35c94fcfb415dbe95f408b9ce91ee846ed")
(sha1 (string->utf8 "hello world")))
(test-equal "sha256, empty" (test-equal "sha256, empty"
%empty-sha256 %empty-sha256
(sha256 #vu8())) (sha256 #vu8()))