checksums: making "checksum-state" a universal concept.
I'm not super happy with the design yet, partly because OpenSSL doesn't subclass ``checksum-state`` so all ``initialize-checksum-state`` will not return a ``checksum-state`` instance. That could maybe be changed by making ``checksum-state`` a mixin, or perhaps some other way.char-rename
John Benediktsson
parent
56880fbacf
commit
83a7592a86
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors byte-arrays byte-vectors checksums grouping io
|
||||
io.backend io.binary io.encodings.binary io.files kernel make
|
||||
math sequences locals ;
|
||||
USING: accessors byte-arrays byte-vectors checksums destructors
|
||||
grouping io io.backend io.binary io.encodings.binary io.files
|
||||
kernel make math sequences locals ;
|
||||
IN: checksums.common
|
||||
|
||||
: calculate-pad-length ( length -- length' )
|
||||
|
|
@ -19,55 +19,40 @@ MIXIN: block-checksum
|
|||
|
||||
INSTANCE: block-checksum checksum
|
||||
|
||||
TUPLE: checksum-state
|
||||
{ bytes-read integer }
|
||||
{ block-size integer }
|
||||
{ bytes byte-vector } ;
|
||||
TUPLE: block-checksum-state < checksum-state
|
||||
{ bytes-read integer }
|
||||
{ block-size integer } ;
|
||||
|
||||
: new-checksum-state ( class -- checksum-state )
|
||||
new
|
||||
BV{ } clone >>bytes ; inline
|
||||
|
||||
M: checksum-state clone
|
||||
call-next-method
|
||||
[ clone ] change-bytes ;
|
||||
|
||||
GENERIC: initialize-checksum-state ( checksum -- checksum-state )
|
||||
M: block-checksum-state dispose drop ;
|
||||
|
||||
GENERIC: checksum-block ( bytes checksum-state -- )
|
||||
|
||||
GENERIC: get-checksum ( checksum-state -- value )
|
||||
|
||||
! Update the bytes-read before calculating checksum in case
|
||||
! checksum uses this in the calculation.
|
||||
:: add-checksum-bytes ( checksum-state data -- checksum-state' )
|
||||
checksum-state block-size>> :> block-size
|
||||
checksum-state bytes>> length :> initial-len
|
||||
M:: block-checksum-state add-checksum-bytes ( state data -- state )
|
||||
state block-size>> :> block-size
|
||||
state bytes>> length :> initial-len
|
||||
initial-len data length + block-size /mod :> ( n extra )
|
||||
data checksum-state bytes>> [ push-all ] keep :> all-bytes
|
||||
data state bytes>> [ push-all ] keep :> all-bytes
|
||||
all-bytes block-size <groups>
|
||||
extra zero? [ f ] [ unclip-last-slice ] if :> ( blocks remain )
|
||||
|
||||
checksum-state [ initial-len - ] change-bytes-read drop
|
||||
state [ initial-len - ] change-bytes-read drop
|
||||
|
||||
blocks [
|
||||
checksum-state [ block-size + ] change-bytes-read
|
||||
state [ block-size + ] change-bytes-read
|
||||
checksum-block
|
||||
] each
|
||||
|
||||
checksum-state [ extra + ] change-bytes-read
|
||||
state [ extra + ] change-bytes-read
|
||||
remain [ >byte-vector ] [ BV{ } clone ] if* >>bytes ;
|
||||
|
||||
: add-checksum-stream ( checksum-state stream -- checksum-state )
|
||||
[ [ add-checksum-bytes ] each-block ] with-input-stream ;
|
||||
|
||||
: add-checksum-file ( checksum-state path -- checksum-state )
|
||||
binary <file-reader> add-checksum-stream ;
|
||||
|
||||
M: block-checksum checksum-bytes
|
||||
initialize-checksum-state
|
||||
swap add-checksum-bytes get-checksum ;
|
||||
initialize-checksum-state [
|
||||
swap add-checksum-bytes get-checksum
|
||||
] with-disposal ;
|
||||
|
||||
M: block-checksum checksum-stream
|
||||
initialize-checksum-state
|
||||
swap add-checksum-stream get-checksum ;
|
||||
initialize-checksum-state [
|
||||
swap add-checksum-stream get-checksum
|
||||
] with-disposal ;
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ SINGLETON: md5
|
|||
|
||||
INSTANCE: md5 block-checksum
|
||||
|
||||
TUPLE: md5-state < checksum-state
|
||||
TUPLE: md5-state < block-checksum-state
|
||||
{ state uint-array }
|
||||
{ old-state uint-array } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,14 +1,15 @@
|
|||
! Copyright (C) 2008, 2010, 2016 Slava Pestov, Alexander Ilin
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types alien.data checksums destructors
|
||||
io kernel openssl openssl.libcrypto sequences ;
|
||||
USING: accessors alien.c-types alien.data checksums
|
||||
checksums.common destructors kernel openssl openssl.libcrypto
|
||||
sequences ;
|
||||
IN: checksums.openssl
|
||||
|
||||
ERROR: unknown-digest name ;
|
||||
|
||||
TUPLE: openssl-checksum name ;
|
||||
|
||||
INSTANCE: openssl-checksum checksum
|
||||
INSTANCE: openssl-checksum block-checksum
|
||||
|
||||
CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
|
||||
|
||||
|
|
@ -33,29 +34,16 @@ M: evp-md-context dispose*
|
|||
: set-digest ( name ctx -- )
|
||||
handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
|
||||
|
||||
: with-evp-md-context ( ... checksum quot: ( ... ctx -- ... ) -- ... )
|
||||
[
|
||||
maybe-init-ssl name>> <evp-md-context>
|
||||
[ set-digest ] keep
|
||||
] dip with-disposal ; inline
|
||||
M: openssl-checksum initialize-checksum-state ( checksum -- evp-md-context )
|
||||
maybe-init-ssl name>> <evp-md-context> [ set-digest ] keep ;
|
||||
|
||||
: digest-value ( ctx -- value )
|
||||
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>>
|
||||
{ { int EVP_MAX_MD_SIZE } int }
|
||||
[ EVP_DigestFinal_ex ssl-error ] with-out-parameters
|
||||
memory>byte-array ;
|
||||
|
||||
: digest-update ( ctx bytes -- ctx )
|
||||
[ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: openssl-checksum checksum-bytes
|
||||
[ swap digest-update digest-value ] with-evp-md-context ;
|
||||
|
||||
M: openssl-checksum checksum-stream
|
||||
[
|
||||
swap
|
||||
[ [ digest-update ] each-block ] with-input-stream
|
||||
digest-value
|
||||
] with-evp-md-context ;
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ INSTANCE: sha-256 sha
|
|||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: sha1-state < checksum-state
|
||||
TUPLE: sha1-state < block-checksum-state
|
||||
{ K uint-array }
|
||||
{ H uint-array }
|
||||
{ W uint-array }
|
||||
|
|
@ -47,7 +47,7 @@ CONSTANT: K-sha1
|
|||
4 uint-array{ } nappend-as
|
||||
]
|
||||
|
||||
TUPLE: sha2-state < checksum-state
|
||||
TUPLE: sha2-state < block-checksum-state
|
||||
{ K uint-array }
|
||||
{ H uint-array }
|
||||
{ word-size fixnum } ;
|
||||
|
|
|
|||
|
|
@ -55,15 +55,22 @@ $nl
|
|||
checksum-bytes
|
||||
checksum-stream
|
||||
checksum-lines
|
||||
checksum-file
|
||||
}
|
||||
"Checksums should implement at least one of " { $link checksum-bytes } " and " { $link checksum-stream } ". Implementing " { $link checksum-lines } " is optional."
|
||||
$nl
|
||||
"Utilities:"
|
||||
"Checksums can also implement a stateful checksum protocol that allows users to push bytes when needed and then at a later point request the checksum value. The default implementation is not very efficient, storing all of the bytes and then calling " { $link checksum-bytes } " when " { $link get-checksum } " is requested."
|
||||
$nl
|
||||
{ $subsections
|
||||
checksum-file
|
||||
initialize-checksum-state
|
||||
add-checksum-bytes
|
||||
add-checksum-stream
|
||||
add-checksum-lines
|
||||
add-checksum-file
|
||||
get-checksum
|
||||
}
|
||||
"Checksum implementations:"
|
||||
{ $subsections "checksums.crc32" }
|
||||
{ $vocab-subsection "CRC32 checksum" "checksums.crc32" }
|
||||
{ $vocab-subsection "MD5 checksum" "checksums.md5" }
|
||||
{ $vocab-subsection "SHA checksums" "checksums.sha" }
|
||||
{ $vocab-subsection "Adler-32 checksum" "checksums.adler-32" }
|
||||
|
|
|
|||
|
|
@ -1,15 +1,13 @@
|
|||
! Copyright (c) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.backend io.encodings.binary io.files
|
||||
io.streams.byte-array kernel sequences ;
|
||||
USING: accessors byte-vectors io io.backend io.encodings.binary
|
||||
io.files io.streams.byte-array kernel sequences ;
|
||||
IN: checksums
|
||||
|
||||
MIXIN: checksum
|
||||
|
||||
GENERIC: checksum-bytes ( bytes checksum -- value )
|
||||
|
||||
GENERIC: checksum-stream ( stream checksum -- value )
|
||||
|
||||
GENERIC: checksum-lines ( lines checksum -- value )
|
||||
|
||||
M: checksum checksum-bytes
|
||||
|
|
@ -23,3 +21,35 @@ M: checksum checksum-lines
|
|||
|
||||
: checksum-file ( path checksum -- value )
|
||||
[ binary <file-reader> ] dip checksum-stream ;
|
||||
|
||||
TUPLE: checksum-state checksum { bytes byte-vector } ;
|
||||
|
||||
M: checksum-state clone
|
||||
call-next-method
|
||||
[ clone ] change-bytes ;
|
||||
|
||||
: new-checksum-state ( class -- checksum-state )
|
||||
new BV{ } clone >>bytes ;
|
||||
|
||||
GENERIC: initialize-checksum-state ( checksum -- checksum-state )
|
||||
GENERIC# add-checksum-bytes 1 ( checksum-state data -- checksum-state )
|
||||
GENERIC: get-checksum ( checksum-state -- value )
|
||||
|
||||
: add-checksum-stream ( checksum-state stream -- checksum-state )
|
||||
[ [ add-checksum-bytes ] each-block ] with-input-stream ;
|
||||
|
||||
: add-checksum-lines ( checksum-state lines -- checksum-state )
|
||||
[ B{ CHAR: \n } add-checksum-bytes ]
|
||||
[ add-checksum-bytes ] interleave ;
|
||||
|
||||
: add-checksum-file ( checksum-state path -- checksum-state )
|
||||
binary <file-reader> add-checksum-stream ;
|
||||
|
||||
M: checksum initialize-checksum-state
|
||||
checksum-state new-checksum-state swap >>checksum ;
|
||||
|
||||
M: checksum-state add-checksum-bytes
|
||||
over bytes>> push-all ;
|
||||
|
||||
M: checksum-state get-checksum
|
||||
[ bytes>> ] [ checksum>> ] bi checksum-bytes ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue