! 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' )
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 ;
INSTANCE: md5 block-checksum
-TUPLE: md5-state < checksum-state
+TUPLE: md5-state < block-checksum-state
{ state uint-array }
{ old-state uint-array } ;
! 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" }
: 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 ;
<PRIVATE
-TUPLE: sha1-state < checksum-state
+TUPLE: sha1-state < block-checksum-state
{ K uint-array }
{ H uint-array }
{ W uint-array }
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 } ;
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" }
! 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
: 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 ;