checksums: some cleanup.
- define checksum-bytes and checksum-stream in terms of each other - delete stream-checksum now that it's no longer needed - move checksum-state stuff into checksums.common - add a block-checksum that uses the checksum-state stuff - change checksums.openssl to not use the checksum-statechar-rename
parent
e146309a0c
commit
2255d6d876
|
@ -1,6 +1,8 @@
|
||||||
! Copyright (C) 2006, 2008 Doug Coleman.
|
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: byte-arrays grouping io.binary kernel make math ;
|
USING: accessors byte-arrays byte-vectors checksums grouping io
|
||||||
|
io.backend io.binary io.encodings.binary io.files kernel make
|
||||||
|
math sequences ;
|
||||||
IN: checksums.common
|
IN: checksums.common
|
||||||
|
|
||||||
: calculate-pad-length ( length -- length' )
|
: calculate-pad-length ( length -- length' )
|
||||||
|
@ -12,3 +14,52 @@ IN: checksums.common
|
||||||
[ 0x3f bitand calculate-pad-length <byte-array> % ]
|
[ 0x3f bitand calculate-pad-length <byte-array> % ]
|
||||||
[ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
|
[ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
|
||||||
] B{ } make 64 group ;
|
] B{ } make 64 group ;
|
||||||
|
|
||||||
|
MIXIN: block-checksum
|
||||||
|
|
||||||
|
INSTANCE: block-checksum checksum
|
||||||
|
|
||||||
|
TUPLE: checksum-state
|
||||||
|
{ bytes-read integer }
|
||||||
|
{ block-size integer }
|
||||||
|
{ bytes byte-vector } ;
|
||||||
|
|
||||||
|
: 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 )
|
||||||
|
|
||||||
|
GENERIC: checksum-block ( bytes checksum-state -- )
|
||||||
|
|
||||||
|
GENERIC: get-checksum ( checksum-state -- value )
|
||||||
|
|
||||||
|
: add-checksum-bytes ( checksum-state data -- checksum-state' )
|
||||||
|
over bytes>> [ push-all ] keep
|
||||||
|
[ dup length pick block-size>> >= ]
|
||||||
|
[
|
||||||
|
over block-size>> cut-slice [
|
||||||
|
over checksum-block
|
||||||
|
[ block-size>> ] keep [ + ] change-bytes-read
|
||||||
|
] dip
|
||||||
|
] while
|
||||||
|
>byte-vector
|
||||||
|
[ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
|
||||||
|
|
||||||
|
: 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 ;
|
||||||
|
|
||||||
|
M: block-checksum checksum-stream
|
||||||
|
initialize-checksum-state
|
||||||
|
swap add-checksum-stream get-checksum ;
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays checksums combinators fry io io.binary
|
USING: accessors arrays checksums checksums.common
|
||||||
io.encodings.binary io.files io.streams.byte-array kernel
|
io.encodings.binary io.files io.streams.byte-array kernel locals
|
||||||
locals math math.vectors memoize sequences ;
|
math math.vectors sequences ;
|
||||||
IN: checksums.hmac
|
IN: checksums.hmac
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -1,15 +1,15 @@
|
||||||
! Copyright (C) 2006, 2008 Doug Coleman.
|
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types alien.data byte-arrays checksums
|
USING: accessors alien.c-types alien.data byte-arrays checksums
|
||||||
checksums.common checksums.stream combinators fry grouping hints
|
checksums.common combinators fry grouping hints kernel
|
||||||
kernel kernel.private literals locals macros math math.bitwise
|
kernel.private literals locals macros math math.bitwise
|
||||||
math.functions sequences sequences.private specialized-arrays ;
|
math.functions sequences sequences.private specialized-arrays ;
|
||||||
SPECIALIZED-ARRAY: uint
|
SPECIALIZED-ARRAY: uint
|
||||||
IN: checksums.md5
|
IN: checksums.md5
|
||||||
|
|
||||||
SINGLETON: md5
|
SINGLETON: md5
|
||||||
|
|
||||||
INSTANCE: md5 stream-checksum
|
INSTANCE: md5 block-checksum
|
||||||
|
|
||||||
TUPLE: md5-state < checksum-state
|
TUPLE: md5-state < checksum-state
|
||||||
{ state uint-array }
|
{ state uint-array }
|
||||||
|
@ -201,8 +201,4 @@ M: md5-state get-checksum
|
||||||
[ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
|
[ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
|
||||||
[ [ checksum-block ] curry each ] [ md5>checksum ] bi ;
|
[ [ checksum-block ] curry each ] [ md5>checksum ] bi ;
|
||||||
|
|
||||||
M: md5 checksum-stream
|
|
||||||
drop
|
|
||||||
[ <md5-state> ] dip add-checksum-stream get-checksum ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
|
@ -1,20 +1,19 @@
|
||||||
! Copyright (C) 2008, 2010, 2016 Slava Pestov, Alexander Ilin
|
! 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 alien.c-types alien.data checksums
|
USING: accessors alien.c-types alien.data checksums destructors
|
||||||
checksums.stream destructors fry io kernel openssl openssl.libcrypto
|
io kernel openssl openssl.libcrypto sequences ;
|
||||||
sequences ;
|
|
||||||
IN: checksums.openssl
|
IN: checksums.openssl
|
||||||
|
|
||||||
ERROR: unknown-digest name ;
|
ERROR: unknown-digest name ;
|
||||||
|
|
||||||
TUPLE: openssl-checksum name ;
|
TUPLE: openssl-checksum name ;
|
||||||
|
|
||||||
|
INSTANCE: openssl-checksum checksum
|
||||||
|
|
||||||
CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
|
CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
|
||||||
|
|
||||||
CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" }
|
CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" }
|
||||||
|
|
||||||
INSTANCE: openssl-checksum stream-checksum
|
|
||||||
|
|
||||||
C: <openssl-checksum> openssl-checksum
|
C: <openssl-checksum> openssl-checksum
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -29,31 +28,34 @@ M: evp-md-context dispose*
|
||||||
handle>> EVP_MD_CTX_destroy ;
|
handle>> EVP_MD_CTX_destroy ;
|
||||||
|
|
||||||
: digest-named ( name -- md )
|
: digest-named ( name -- md )
|
||||||
dup EVP_get_digestbyname
|
dup EVP_get_digestbyname [ ] [ unknown-digest ] ?if ;
|
||||||
[ ] [ unknown-digest ] ?if ;
|
|
||||||
|
|
||||||
: 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-method ( data checksum method: ( ctx data -- ctx' ) -- value )
|
: with-evp-md-context ( ... checksum quot: ( ... ctx -- ... ) -- ... )
|
||||||
[ initialize-checksum-state ] dip '[ swap @ get-checksum ] with-disposal ; inline
|
[
|
||||||
|
maybe-init-ssl name>> <evp-md-context>
|
||||||
|
[ set-digest ] keep
|
||||||
|
] dip with-disposal ; inline
|
||||||
|
|
||||||
PRIVATE>
|
: 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 ;
|
||||||
|
|
||||||
M: openssl-checksum checksum-bytes ( bytes checksum -- value )
|
: digest-update ( ctx bytes -- ctx )
|
||||||
[ add-checksum-bytes ] checksum-method ;
|
[ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
|
||||||
|
|
||||||
M: openssl-checksum checksum-stream ( stream checksum -- value )
|
PRIVATE>
|
||||||
[ add-checksum-stream ] checksum-method ;
|
|
||||||
|
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 ;
|
||||||
|
|
|
@ -7,7 +7,7 @@ sequences.generalizations sequences.private ;
|
||||||
IN: checksums.sha
|
IN: checksums.sha
|
||||||
|
|
||||||
MIXIN: sha
|
MIXIN: sha
|
||||||
INSTANCE: sha checksum
|
INSTANCE: sha block-checksum
|
||||||
|
|
||||||
SINGLETON: sha1
|
SINGLETON: sha1
|
||||||
INSTANCE: sha1 sha
|
INSTANCE: sha1 sha
|
||||||
|
@ -405,12 +405,4 @@ M: sha1-state get-checksum
|
||||||
clone
|
clone
|
||||||
[ pad-last-short-block ] [ sha-256>checksum ] bi ;
|
[ pad-last-short-block ] [ sha-256>checksum ] bi ;
|
||||||
|
|
||||||
M: sha checksum-stream
|
|
||||||
initialize-checksum-state swap add-checksum-stream
|
|
||||||
get-checksum ;
|
|
||||||
|
|
||||||
M: sha checksum-bytes
|
|
||||||
initialize-checksum-state swap add-checksum-bytes
|
|
||||||
get-checksum ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
|
@ -1,7 +0,0 @@
|
||||||
USING: checksums help.markup help.syntax ;
|
|
||||||
IN: checksums.stream
|
|
||||||
|
|
||||||
ARTICLE: "checksums.stream" "Stream Checksum"
|
|
||||||
"The instances of the " { $link stream-checksum } " mixin must implement " { $link checksum-stream } "." ;
|
|
||||||
|
|
||||||
ABOUT: "checksums.stream"
|
|
|
@ -1,12 +0,0 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: io.encodings.binary io.streams.byte-array kernel
|
|
||||||
checksums ;
|
|
||||||
IN: checksums.stream
|
|
||||||
|
|
||||||
MIXIN: stream-checksum
|
|
||||||
|
|
||||||
M: stream-checksum checksum-bytes
|
|
||||||
[ binary <byte-reader> ] dip checksum-stream ;
|
|
||||||
|
|
||||||
INSTANCE: stream-checksum checksum
|
|
|
@ -1 +0,0 @@
|
||||||
Computing checksums of streaming data
|
|
|
@ -1,56 +1,20 @@
|
||||||
! Copyright (c) 2008 Slava Pestov
|
! Copyright (c) 2008 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors byte-arrays byte-vectors io io.backend io.files
|
USING: io io.backend io.encodings.binary io.files
|
||||||
kernel math math.parser sequences ;
|
io.streams.byte-array kernel sequences ;
|
||||||
IN: checksums
|
IN: checksums
|
||||||
|
|
||||||
MIXIN: checksum
|
MIXIN: checksum
|
||||||
|
|
||||||
TUPLE: checksum-state
|
|
||||||
{ bytes-read integer }
|
|
||||||
{ block-size integer }
|
|
||||||
{ bytes byte-vector } ;
|
|
||||||
|
|
||||||
: 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 )
|
|
||||||
|
|
||||||
GENERIC: checksum-block ( bytes checksum-state -- )
|
|
||||||
|
|
||||||
GENERIC# add-checksum-bytes 1 ( checksum-state bytes -- checksum-state' )
|
|
||||||
|
|
||||||
GENERIC: get-checksum ( checksum-state -- value )
|
|
||||||
|
|
||||||
M: checksum-state add-checksum-bytes ( checksum-state data -- checksum-state' )
|
|
||||||
over bytes>> [ push-all ] keep
|
|
||||||
[ dup length pick block-size>> >= ]
|
|
||||||
[
|
|
||||||
over block-size>> cut-slice [
|
|
||||||
over checksum-block
|
|
||||||
[ block-size>> ] keep [ + ] change-bytes-read
|
|
||||||
] dip
|
|
||||||
] while
|
|
||||||
>byte-vector
|
|
||||||
[ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
|
|
||||||
|
|
||||||
: add-checksum-stream ( checksum-state stream -- checksum-state )
|
|
||||||
[ [ add-checksum-bytes ] each-block ] with-input-stream ;
|
|
||||||
|
|
||||||
: add-checksum-file ( checksum-state path -- checksum-state )
|
|
||||||
normalize-path (file-reader) add-checksum-stream ;
|
|
||||||
|
|
||||||
GENERIC: checksum-bytes ( bytes checksum -- value )
|
GENERIC: checksum-bytes ( bytes checksum -- value )
|
||||||
|
|
||||||
GENERIC: checksum-stream ( stream checksum -- value )
|
GENERIC: checksum-stream ( stream checksum -- value )
|
||||||
|
|
||||||
GENERIC: checksum-lines ( lines checksum -- value )
|
GENERIC: checksum-lines ( lines checksum -- value )
|
||||||
|
|
||||||
|
M: checksum checksum-bytes
|
||||||
|
[ binary <byte-reader> ] dip checksum-stream ;
|
||||||
|
|
||||||
M: checksum checksum-stream
|
M: checksum checksum-stream
|
||||||
[ stream-contents ] dip checksum-bytes ;
|
[ stream-contents ] dip checksum-bytes ;
|
||||||
|
|
||||||
|
@ -58,7 +22,4 @@ M: checksum checksum-lines
|
||||||
[ B{ CHAR: \n } join ] dip checksum-bytes ;
|
[ B{ CHAR: \n } join ] dip checksum-bytes ;
|
||||||
|
|
||||||
: checksum-file ( path checksum -- value )
|
: checksum-file ( path checksum -- value )
|
||||||
! normalize-path (file-reader) is equivalent to
|
[ binary <file-reader> ] dip checksum-stream ;
|
||||||
! binary <file-reader>. We use the lower-level form
|
|
||||||
! so that we can move io.encodings.binary to basis/.
|
|
||||||
[ normalize-path (file-reader) ] dip checksum-stream ;
|
|
||||||
|
|
Loading…
Reference in New Issue