steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

checksums.openssl: implement common checksum interface

char-rename
Alexander Iljin 2016-06-23 10:10:57 +03:00 committed by John Benediktsson
parent 66b9770f77
commit 54b80a4223
1 changed files with 17 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
basis/checksums/openssl/openssl.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2008, 2010 Slava Pestov ! Copyright (C) 2008, 2010, 2016 Slava Pestov, Alexander Ilin
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays alien.c-types alien.data kernel USING: accessors alien.c-types alien.data checksums
continuations destructors sequences io openssl openssl.libcrypto checksums.stream destructors io kernel openssl openssl.libcrypto
checksums checksums.stream classes.struct ; sequences ;
IN: checksums.openssl IN: checksums.openssl
ERROR: unknown-digest name ; ERROR: unknown-digest name ;
@ -17,8 +17,6 @@ INSTANCE: openssl-checksum stream-checksum
C: <openssl-checksum> openssl-checksum C: <openssl-checksum> openssl-checksum
<PRIVATE
TUPLE: evp-md-context < disposable handle ; TUPLE: evp-md-context < disposable handle ;
: <evp-md-context> ( -- ctx ) : <evp-md-context> ( -- ctx )
@ -28,8 +26,7 @@ TUPLE: evp-md-context < disposable handle ;
M: evp-md-context dispose* M: evp-md-context dispose*
handle>> EVP_MD_CTX_destroy ; handle>> EVP_MD_CTX_destroy ;
: with-evp-md-context ( quot -- ) <PRIVATE
maybe-init-ssl [ <evp-md-context> ] dip with-disposal ; inline
: digest-named ( name -- md ) : digest-named ( name -- md )
dup EVP_get_digestbyname dup EVP_get_digestbyname
@ -38,27 +35,22 @@ M: evp-md-context dispose*
: set-digest ( name ctx -- ) : set-digest ( name ctx -- )
handle>> swap digest-named f EVP_DigestInit_ex ssl-error ; handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
: checksum-loop ( ctx -- ) PRIVATE>
dup handle>>
4096 read-partial dup [
dup length EVP_DigestUpdate ssl-error
checksum-loop
] [ 3drop ] if ;
: digest-value ( ctx -- value ) M: openssl-checksum initialize-checksum-state ( checksum -- evp-md-context )
maybe-init-ssl name>> <evp-md-context> [ set-digest ] keep ;
M: evp-md-context add-checksum-bytes ( ctx bytes -- ctx' )
[ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
M: evp-md-context get-checksum ( ctx -- value )
handle>> handle>>
{ { int EVP_MAX_MD_SIZE } int } { { int EVP_MAX_MD_SIZE } int }
[ EVP_DigestFinal_ex ssl-error ] with-out-parameters [ EVP_DigestFinal_ex ssl-error ] with-out-parameters
memory>byte-array ; memory>byte-array ;
PRIVATE> M: openssl-checksum checksum-bytes ( bytes checksum -- value )
initialize-checksum-state [ swap add-checksum-bytes get-checksum ] with-disposal ;
M: openssl-checksum checksum-stream M: openssl-checksum checksum-stream ( stream checksum -- value )
name>> swap [ initialize-checksum-state [ swap add-checksum-stream get-checksum ] with-disposal ;
[
[ set-digest ]
[ checksum-loop ]
[ digest-value ]
tri
] with-evp-md-context
] with-input-stream ;