OpenSSL checksums
parent
b7597fbd8a
commit
8a0db8eda9
extra/checksums/openssl
|
@ -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"
|
|
@ -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
|
|
@ -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 ;
|
Loading…
Reference in New Issue