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
John Benediktsson
parent
e146309a0c
commit
2255d6d876
|
|
@ -1,6 +1,8 @@
|
|||
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||
! 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
|
||||
|
||||
: calculate-pad-length ( length -- length' )
|
||||
|
|
@ -12,3 +14,52 @@ IN: checksums.common
|
|||
[ 0x3f bitand calculate-pad-length <byte-array> % ]
|
||||
[ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
|
||||
] 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.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays checksums combinators fry io io.binary
|
||||
io.encodings.binary io.files io.streams.byte-array kernel
|
||||
locals math math.vectors memoize sequences ;
|
||||
USING: accessors arrays checksums checksums.common
|
||||
io.encodings.binary io.files io.streams.byte-array kernel locals
|
||||
math math.vectors sequences ;
|
||||
IN: checksums.hmac
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,15 +1,15 @@
|
|||
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types alien.data byte-arrays checksums
|
||||
checksums.common checksums.stream combinators fry grouping hints
|
||||
kernel kernel.private literals locals macros math math.bitwise
|
||||
checksums.common combinators fry grouping hints kernel
|
||||
kernel.private literals locals macros math math.bitwise
|
||||
math.functions sequences sequences.private specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
IN: checksums.md5
|
||||
|
||||
SINGLETON: md5
|
||||
|
||||
INSTANCE: md5 stream-checksum
|
||||
INSTANCE: md5 block-checksum
|
||||
|
||||
TUPLE: md5-state < checksum-state
|
||||
{ state uint-array }
|
||||
|
|
@ -201,8 +201,4 @@ M: md5-state get-checksum
|
|||
[ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
|
||||
[ [ checksum-block ] curry each ] [ md5>checksum ] bi ;
|
||||
|
||||
M: md5 checksum-stream
|
||||
drop
|
||||
[ <md5-state> ] dip add-checksum-stream get-checksum ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
|||
|
|
@ -1,20 +1,19 @@
|
|||
! 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
|
||||
checksums.stream destructors fry io kernel openssl openssl.libcrypto
|
||||
sequences ;
|
||||
USING: accessors alien.c-types alien.data checksums destructors
|
||||
io kernel openssl openssl.libcrypto sequences ;
|
||||
IN: checksums.openssl
|
||||
|
||||
ERROR: unknown-digest name ;
|
||||
|
||||
TUPLE: openssl-checksum name ;
|
||||
|
||||
INSTANCE: openssl-checksum checksum
|
||||
|
||||
CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
|
||||
|
||||
CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" }
|
||||
|
||||
INSTANCE: openssl-checksum stream-checksum
|
||||
|
||||
C: <openssl-checksum> openssl-checksum
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -29,31 +28,34 @@ M: evp-md-context dispose*
|
|||
handle>> EVP_MD_CTX_destroy ;
|
||||
|
||||
: digest-named ( name -- md )
|
||||
dup EVP_get_digestbyname
|
||||
[ ] [ unknown-digest ] ?if ;
|
||||
dup EVP_get_digestbyname [ ] [ unknown-digest ] ?if ;
|
||||
|
||||
: set-digest ( name ctx -- )
|
||||
handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
|
||||
|
||||
: checksum-method ( data checksum method: ( ctx data -- ctx' ) -- value )
|
||||
[ initialize-checksum-state ] dip '[ swap @ get-checksum ] with-disposal ; inline
|
||||
: with-evp-md-context ( ... checksum quot: ( ... ctx -- ... ) -- ... )
|
||||
[
|
||||
maybe-init-ssl name>> <evp-md-context>
|
||||
[ set-digest ] keep
|
||||
] dip with-disposal ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
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 )
|
||||
: digest-value ( ctx -- value )
|
||||
handle>>
|
||||
{ { int EVP_MAX_MD_SIZE } int }
|
||||
[ EVP_DigestFinal_ex ssl-error ] with-out-parameters
|
||||
memory>byte-array ;
|
||||
|
||||
M: openssl-checksum checksum-bytes ( bytes checksum -- value )
|
||||
[ add-checksum-bytes ] checksum-method ;
|
||||
: digest-update ( ctx bytes -- ctx )
|
||||
[ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
|
||||
|
||||
M: openssl-checksum checksum-stream ( stream checksum -- value )
|
||||
[ add-checksum-stream ] checksum-method ;
|
||||
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 ;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ sequences.generalizations sequences.private ;
|
|||
IN: checksums.sha
|
||||
|
||||
MIXIN: sha
|
||||
INSTANCE: sha checksum
|
||||
INSTANCE: sha block-checksum
|
||||
|
||||
SINGLETON: sha1
|
||||
INSTANCE: sha1 sha
|
||||
|
|
@ -405,12 +405,4 @@ M: sha1-state get-checksum
|
|||
clone
|
||||
[ 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>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors byte-arrays byte-vectors io io.backend io.files
|
||||
kernel math math.parser sequences ;
|
||||
USING: io io.backend io.encodings.binary io.files
|
||||
io.streams.byte-array kernel sequences ;
|
||||
IN: checksums
|
||||
|
||||
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-stream ( stream checksum -- value )
|
||||
|
||||
GENERIC: checksum-lines ( lines checksum -- value )
|
||||
|
||||
M: checksum checksum-bytes
|
||||
[ binary <byte-reader> ] dip checksum-stream ;
|
||||
|
||||
M: checksum checksum-stream
|
||||
[ stream-contents ] dip checksum-bytes ;
|
||||
|
||||
|
|
@ -58,7 +22,4 @@ M: checksum checksum-lines
|
|||
[ B{ CHAR: \n } join ] dip checksum-bytes ;
|
||||
|
||||
: checksum-file ( path checksum -- value )
|
||||
! normalize-path (file-reader) is equivalent to
|
||||
! 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 ;
|
||||
[ binary <file-reader> ] dip checksum-stream ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue