OpenSSL checksums

db4
Slava Pestov 2008-05-11 17:43:45 -05:00
parent b7597fbd8a
commit 8a0db8eda9
3 changed files with 126 additions and 0 deletions

View File

@ -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"

View File

@ -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

View File

@ -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 ;