Add OpenSSL:s SHA256

1 files changed, 34 insertions, 0 deletions

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))))
+