From 3382be7a49d37e00e07ab8a242236f755fb795cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 26 Jul 2021 00:39:41 +0200 Subject: Add OpenSSL:s SHA256 --- module/crypto.scm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 module/crypto.scm (limited to 'module/crypto.scm') diff --git a/module/crypto.scm b/module/crypto.scm new file mode 100644 index 00000000..0b18f240 --- /dev/null +++ b/module/crypto.scm @@ -0,0 +1,34 @@ +(define-module (crypto) + :use-module (rnrs bytevectors) + :use-module (system foreign) + :export (sha256 checksum->string)) + +(define-once libcrypto (dynamic-link "libcrypto")) + +(define SHA_DIGEST_LENGTH 20) +(define SHA224_DIGEST_LENGTH 28) +(define SHA256_DIGEST_LENGTH 32) +(define SHA384_DIGEST_LENGTH 48) +(define SHA512_DIGEST_LENGTH 64) + +(define SHA256 + ((@ (system foreign) pointer->procedure) + '* (dynamic-func "SHA256" libcrypto) + `(* ,(@ (system foreign) size_t) *))) + +(define (sha256 msg) + (define md (make-bytevector SHA256_DIGEST_LENGTH)) + (define bv (string->utf8 msg)) + (SHA256 ((@ (system foreign) bytevector->pointer) bv) + (bytevector-length bv) + ((@ (system foreign) bytevector->pointer) md)) + md) + +(define (checksum->string md) + (string-concatenate + (map (lambda (byte) + (format #f "~x~x" + (logand #xF (ash byte -4)) + (logand #xF byte))) + (bytevector->u8-list md)))) + -- cgit v1.2.3