From 8a0db8eda980d5085c46e84464a2f0d60796c2bc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 11 May 2008 17:43:45 -0500
Subject: [PATCH] OpenSSL checksums

---
 extra/checksums/openssl/openssl-docs.factor  | 35 +++++++++++
 extra/checksums/openssl/openssl-tests.factor | 28 +++++++++
 extra/checksums/openssl/openssl.factor       | 63 ++++++++++++++++++++
 3 files changed, 126 insertions(+)
 create mode 100644 extra/checksums/openssl/openssl-docs.factor
 create mode 100644 extra/checksums/openssl/openssl-tests.factor
 create mode 100644 extra/checksums/openssl/openssl.factor

diff --git a/extra/checksums/openssl/openssl-docs.factor b/extra/checksums/openssl/openssl-docs.factor
new file mode 100644
index 0000000000..fd067997a7
--- /dev/null
+++ b/extra/checksums/openssl/openssl-docs.factor
@@ -0,0 +1,35 @@
+IN: checksums.openssl
+USING: help.syntax help.markup ;
+
+HELP: openssl-checksum
+{ $class-description "The class of checksum algorithms implemented by OpenSSL. The exact set of algorithms supported depends on how the OpenSSL library was compiled; " { $snippet "md5" } " and " { $snippet "sha1" } " should be universally available." } ;
+
+HELP: <openssl-checksum> ( name -- checksum )
+{ $values { "name" "an EVP message digest name" } { "checksum" openssl-checksum } }
+{ $description "Creates a new OpenSSL checksum object." } ;
+
+HELP: openssl-md5
+{ $description "The OpenSSL MD5 message digest implementation." } ;
+
+HELP: openssl-sha1
+{ $description "The OpenSSL SHA1 message digest implementation." } ;
+
+HELP: unknown-digest
+{ $error-description "Thrown by checksum words if they are passed an " { $link openssl-checksum } " naming a message digest not supported by OpenSSL." } ;
+
+ARTICLE: "checksums.openssl" "OpenSSL checksums"
+"The OpenSSL library provides a large number of efficient checksum (message digest) algorithms which may be used independently of its SSL functionality."
+{ $subsection openssl-checksum }
+"Constructing a checksum from a known name:"
+{ $subsection <openssl-checksum> }
+"Two utility words:"
+{ $subsection openssl-md5 }
+{ $subsection openssl-sha1 }
+"An error thrown if the digest name is unrecognized:"
+{ $subsection unknown-digest }
+"An example where we compute the SHA1 checksum of a string using the OpenSSL implementation of SHA1:"
+{ $example "USING: byte-arrays checksums checksums.openssl prettyprint ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
+"If we use the Factor implementation, we get the same result, just slightly slower:"
+{ $example "USING: byte-arrays checksums checksums.sha1 prettyprint ;" "\"hello world\" >byte-array sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } ;
+
+ABOUT: "checksums.openssl"
diff --git a/extra/checksums/openssl/openssl-tests.factor b/extra/checksums/openssl/openssl-tests.factor
new file mode 100644
index 0000000000..253069c952
--- /dev/null
+++ b/extra/checksums/openssl/openssl-tests.factor
@@ -0,0 +1,28 @@
+IN: checksums.openssl.tests
+USING: byte-arrays checksums.openssl checksums tools.test
+accessors kernel system ;
+
+[
+    B{ 201 238 222 100 92 200 182 188 138 255 129 163 115 88 240 136 }
+]
+[
+    "Hello world from the openssl binding" >byte-array
+    "md5" <openssl-checksum> checksum-bytes
+] unit-test
+
+[
+  B{ 63 113 237 255 181 5 152 241 136 181 43 95 160 105 44 87 49 82 115 0 }
+]
+[
+    "Hello world from the openssl binding" >byte-array
+    "sha1" <openssl-checksum> checksum-bytes
+] unit-test
+
+[
+    "Bad checksum test" >byte-array
+    "no such checksum" <openssl-checksum>
+    checksum-bytes
+] [ [ unknown-digest? ] [ name>> "no such checksum" = ] bi and ]
+must-fail-with
+
+[ ] [ image openssl-sha1 checksum-file drop ] unit-test
diff --git a/extra/checksums/openssl/openssl.factor b/extra/checksums/openssl/openssl.factor
new file mode 100644
index 0000000000..fe96a52277
--- /dev/null
+++ b/extra/checksums/openssl/openssl.factor
@@ -0,0 +1,63 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays alien.c-types kernel continuations
+sequences io openssl openssl.libcrypto checksums ;
+IN: checksums.openssl
+
+ERROR: unknown-digest name ;
+
+TUPLE: openssl-checksum name ;
+
+: openssl-md5 T{ openssl-checksum f "md5" } ;
+
+: openssl-sha1 T{ openssl-checksum f "sha1" } ;
+
+INSTANCE: openssl-checksum checksum
+
+C: <openssl-checksum> openssl-checksum
+
+<PRIVATE
+
+TUPLE: evp-md-context handle ;
+
+: <evp-md-context> ( -- ctx )
+    "EVP_MD_CTX" <c-object>
+    dup EVP_MD_CTX_init evp-md-context boa ;
+
+M: evp-md-context dispose
+    handle>> EVP_MD_CTX_cleanup drop ;
+
+: with-evp-md-context ( quot -- )
+    maybe-init-ssl >r <evp-md-context> r> with-disposal ; inline
+
+: digest-named ( name -- md )
+    dup EVP_get_digestbyname
+    [ ] [ unknown-digest ] ?if ;
+
+: set-digest ( name ctx -- )
+    handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
+
+: checksum-loop ( ctx -- )
+    dup handle>>
+    4096 read-partial dup [
+        dup length EVP_DigestUpdate ssl-error
+        checksum-loop
+    ] [ 3drop ] if ;
+
+: digest-value ( ctx -- value )
+    handle>>
+    EVP_MAX_MD_SIZE <byte-array> 0 <int>
+    [ EVP_DigestFinal_ex ssl-error ] 2keep
+    *int memory>byte-array ;
+
+PRIVATE>
+
+M: openssl-checksum checksum-stream
+    name>> swap [
+        [
+            [ set-digest ]
+            [ checksum-loop ]
+            [ digest-value ]
+            tri
+        ] with-evp-md-context
+    ] with-input-stream ;