--- /dev/null
+Doug Coleman
--- /dev/null
+USING: kernel io strings byte-arrays sequences namespaces math
+parser checksums.hmac tools.test checksums.md5 checksums.sha1
+checksums.sha2 ;
+IN: checksums.hmac.tests
+
+[
+ "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d"
+] [
+ 16 11 <string> "Hi There" md5 hmac-bytes >string ] unit-test
+
+[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ]
+[ "Jefe" "what do ya want for nothing?" md5 hmac-bytes >string ] unit-test
+
+[
+ "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6"
+]
+[
+ 16 HEX: aa <string>
+ 50 HEX: dd <repetition> md5 hmac-bytes >string
+] unit-test
+
+[
+ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
+] [
+ 16 11 <string> "Hi There" sha1 hmac-bytes >string
+] unit-test
+
+[
+ "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y"
+] [
+ "Jefe" "what do ya want for nothing?" sha1 hmac-bytes >string
+] unit-test
+
+[
+ "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb"
+] [
+ 16 HEX: aa <string>
+ 50 HEX: dd <repetition> sha1 hmac-bytes >string
+] unit-test
+
+[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ]
+[ HEX: b 20 <string> sha-256 hmac-bytes >string ] unit-test
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays checksums checksums.md5 checksums.md5.private
+checksums.sha1 combinators fry io io.binary io.encodings.binary
+io.files io.streams.byte-array kernel math math.vectors memoize
+sequences ;
+IN: checksums.hmac
+
+<PRIVATE
+
+/*
+: sha1-hmac ( Ko Ki stream -- hmac )
+ initialize-sha1 process-sha1-block
+ stream>sha1 get-sha1
+ initialize-sha1
+ [ process-sha1-block ]
+ [ process-sha1-block ] bi* get-sha1 ;
+
+ : md5-hmac ( Ko Ki stream -- hmac )
+ initialize-md5 process-md5-block
+ stream>md5 get-md5
+ initialize-md5
+ [ process-md5-block ]
+ [ process-md5-block ] bi* get-md5 ;
+*/
+
+: seq-bitxor ( seq seq -- seq ) [ bitxor ] 2map ;
+
+MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
+
+MEMO: ipad ( -- seq ) 64 HEX: 36 <array> ;
+
+: init-K ( K -- o i )
+ 64 0 pad-tail
+ [ opad seq-bitxor ]
+ [ ipad seq-bitxor ] bi ;
+
+PRIVATE>
+
+:: hmac-stream ( K stream checksum -- value )
+ K init-K :> Ki :> Ko
+ checksum initialize-checksum
+ Ki add-bytes
+ stream add-stream finish-checksum
+ checksum initialize-checksum
+ Ko add-bytes swap add-bytes
+ finish-checksum ;
+
+: hmac-file ( K path checksum -- value )
+ [ binary <file-reader> ] dip hmac-stream ;
+
+: hmac-bytes ( K seq checksum -- value )
+ [ binary <byte-reader> ] dip hmac-stream ;
USING: kernel io io.binary io.files io.streams.byte-array math
math.functions math.parser namespaces splitting grouping strings
sequences byte-arrays locals sequences.private macros fry
-io.encodings.binary math.bitwise checksums
-checksums.common checksums.stream combinators ;
+io.encodings.binary math.bitwise checksums accessors
+checksums.common checksums.stream combinators combinators.smart ;
IN: checksums.md5
-! See http://www.faqs.org/rfcs/rfc1321.html
+SINGLETON: md5
+INSTANCE: md5 stream-checksum
+
+TUPLE: md5-state < checksum-state state old-state ;
+
+: <md5-state> ( -- md5-state )
+ 64 md5-state new-checksum-state
+ { HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 }
+ [ clone >>state ] [ >>old-state ] bi ;
<PRIVATE
-SYMBOLS: a b c d old-a old-b old-c old-d ;
+: v-w+ ( v1 v2 -- v3 ) [ w+ ] 2map ;
+
+: update-md5-state ( md5-state -- )
+ [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
+ [ (>>old-state) ] [ (>>state) ] bi ; inline
: T ( N -- Y )
- sin abs 32 2^ * >integer ; foldable
-
-: initialize-md5 ( -- )
- 0 bytes-read set
- HEX: 67452301 dup a set old-a set
- HEX: efcdab89 dup b set old-b set
- HEX: 98badcfe dup c set old-c set
- HEX: 10325476 dup d set old-d set ;
-
-: update-md ( -- )
- old-a a update-old-new
- old-b b update-old-new
- old-c c update-old-new
- old-d d update-old-new ;
-
-:: (ABCD) ( x a b c d k s i func -- )
- #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
- a [
- b get c get d get func call w+
- k x nth-unsafe w+
- i T w+
- s bitroll-32
- b get w+
- ] change ; inline
+ sin abs 32 2^ * >integer ; inline
-: F ( X Y Z -- FXYZ )
+:: F ( X Y Z -- FXYZ )
#! F(X,Y,Z) = XY v not(X) Z
- pick bitnot bitand [ bitand ] [ bitor ] bi* ;
+ X Y bitand X bitnot Z bitand bitor ; inline
-: G ( X Y Z -- GXYZ )
+:: G ( X Y Z -- GXYZ )
#! G(X,Y,Z) = XZ v Y not(Z)
- dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
+ X Z bitand Y Z bitnot bitand bitor ; inline
: H ( X Y Z -- HXYZ )
#! H(X,Y,Z) = X xor Y xor Z
- bitxor bitxor ;
+ bitxor bitxor ; inline
-: I ( X Y Z -- IXYZ )
+:: I ( X Y Z -- IXYZ )
#! I(X,Y,Z) = Y xor (X v not(Z))
- rot swap bitnot bitor bitxor ;
+ Z bitnot X bitor Y bitxor ; inline
CONSTANT: S11 7
CONSTANT: S12 12
CONSTANT: S43 15
CONSTANT: S44 21
-MACRO: with-md5-round ( ops func -- )
- '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ;
+CONSTANT: a 0
+CONSTANT: b 1
+CONSTANT: c 2
+CONSTANT: d 3
+
+:: (ABCD) ( x V a b c d k s i quot -- )
+ #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
+ a V [
+ b V nth-unsafe
+ c V nth-unsafe
+ d V nth-unsafe quot call w+
+ k x nth-unsafe w+
+ i T w+
+ s bitroll-32
+ b V nth-unsafe w+
+ ] change-nth ; inline
+
+MACRO: with-md5-round ( ops quot -- )
+ '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ;
-: (process-md5-block-F) ( block -- )
+: (process-md5-block-F) ( block v -- )
{
[ a b c d 0 S11 1 ]
[ d a b c 1 S12 2 ]
[ d a b c 13 S12 14 ]
[ c d a b 14 S13 15 ]
[ b c d a 15 S14 16 ]
- } [ F ] with-md5-round ;
+ } [ F ] with-md5-round ; inline
-: (process-md5-block-G) ( block -- )
+: (process-md5-block-G) ( block v -- )
{
[ a b c d 1 S21 17 ]
[ d a b c 6 S22 18 ]
[ d a b c 2 S22 30 ]
[ c d a b 7 S23 31 ]
[ b c d a 12 S24 32 ]
- } [ G ] with-md5-round ;
+ } [ G ] with-md5-round ; inline
-: (process-md5-block-H) ( block -- )
+: (process-md5-block-H) ( block v -- )
{
[ a b c d 5 S31 33 ]
[ d a b c 8 S32 34 ]
[ d a b c 12 S32 46 ]
[ c d a b 15 S33 47 ]
[ b c d a 2 S34 48 ]
- } [ H ] with-md5-round ;
+ } [ H ] with-md5-round ; inline
-: (process-md5-block-I) ( block -- )
+: (process-md5-block-I) ( block v -- )
{
[ a b c d 0 S41 49 ]
[ d a b c 7 S42 50 ]
[ d a b c 11 S42 62 ]
[ c d a b 2 S43 63 ]
[ b c d a 9 S44 64 ]
- } [ I ] with-md5-round ;
-
-: (process-md5-block) ( block -- )
- 4 <groups> [ le> ] map {
- [ (process-md5-block-F) ]
- [ (process-md5-block-G) ]
- [ (process-md5-block-H) ]
- [ (process-md5-block-I) ]
- } cleave
-
- update-md ;
-
-: process-md5-block ( str -- )
- dup length [ bytes-read [ + ] change ] keep 64 = [
- (process-md5-block)
+ } [ I ] with-md5-round ; inline
+
+M: md5-state checksum-block ( block state -- )
+ [
+ [ 4 <groups> [ le> ] map ] [ state>> ] bi* {
+ [ (process-md5-block-F) ]
+ [ (process-md5-block-G) ]
+ [ (process-md5-block-H) ]
+ [ (process-md5-block-I) ]
+ } 2cleave
] [
- f bytes-read get pad-last-block
- [ (process-md5-block) ] each
- ] if ;
-
-: stream>md5 ( -- )
- 64 read [ process-md5-block ] keep
- length 64 = [ stream>md5 ] when ;
+ nip update-md5-state
+ ] 2bi ;
-: get-md5 ( -- str )
- [ a b c d ] [ get 4 >le ] map concat >byte-array ;
+: md5-state>checksum ( md5-state -- bytes )
+ state>> [ 4 >le ] map B{ } concat-as ;
-PRIVATE>
-
-SINGLETON: md5
+M: md5-state get-checksum ( md5-state -- bytes )
+ clone [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
+ [ [ checksum-block ] curry each ] [ md5-state>checksum ] bi ;
-INSTANCE: md5 stream-checksum
-
-M: md5 checksum-stream ( stream -- byte-array )
- drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;
+PRIVATE>
! Copyright (c) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: sequences math.parser io io.backend io.files
-kernel ;
+USING: accessors io io.backend io.files kernel math math.parser
+sequences vectors io.encodings.binary ;
IN: checksums
MIXIN: checksum
+TUPLE: checksum-state bytes-read block-size bytes ;
+
+: new-checksum-state ( block-size class -- checksum-state )
+ new
+ swap >>block-size
+ 0 >>bytes-read
+ V{ } clone >>bytes ; inline
+
+GENERIC: checksum-block ( bytes checksum -- )
+
+GENERIC: get-checksum ( checksum -- value )
+
+: add-checksum-bytes ( checksum-state data -- checksum-state )
+ over bytes>> [ push-all ] keep
+ [ dup length pick block-size>> >= ]
+ [
+ 64 cut-slice [
+ over [ checksum-block ]
+ [ [ 64 + ] change-bytes-read drop ] bi
+ ] dip
+ ] while >vector >>bytes ;
+
+: add-checksum-stream ( checksum-state stream -- checksum-state )
+ [
+ [ '[ [ _ ] dip add-checksum-bytes drop ] each-block ] keep
+ ] with-input-stream ;
+
+: add-checksum-file ( checksum-state path -- checksum-state )
+ binary <file-reader> add-checksum-stream ;
+
GENERIC: checksum-bytes ( bytes checksum -- value )
GENERIC: checksum-stream ( stream checksum -- value )
+++ /dev/null
-Doug Coleman
+++ /dev/null
-USING: kernel io strings byte-arrays sequences namespaces math
-parser crypto.hmac tools.test ;
-IN: crypto.hmac.tests
-
-[
- "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d"
-] [
- 16 11 <string> "Hi There" sequence>md5-hmac >string ] unit-test
-
-[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ]
-[ "Jefe" "what do ya want for nothing?" sequence>md5-hmac >string ] unit-test
-
-[
- "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6"
-]
-[
- 16 HEX: aa <string>
- 50 HEX: dd <repetition> sequence>md5-hmac >string
-] unit-test
-
-[
- "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
-] [
- 16 11 <string> "Hi There" sequence>sha1-hmac >string
-] unit-test
-
-[
- "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y"
-] [
- "Jefe" "what do ya want for nothing?" sequence>sha1-hmac >string
-] unit-test
-
-[
- "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb"
-] [
- 16 HEX: aa <string>
- 50 HEX: dd <repetition> sequence>sha1-hmac >string
-] unit-test
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators checksums checksums.md5
-checksums.sha1 checksums.md5.private io io.binary io.files
-io.streams.byte-array kernel math math.vectors memoize sequences
-io.encodings.binary ;
-IN: crypto.hmac
-
-<PRIVATE
-
-: sha1-hmac ( Ko Ki -- hmac )
- initialize-sha1 process-sha1-block
- stream>sha1 get-sha1
- initialize-sha1
- [ process-sha1-block ]
- [ process-sha1-block ] bi* get-sha1 ;
-
-: md5-hmac ( Ko Ki -- hmac )
- initialize-md5 process-md5-block
- stream>md5 get-md5
- initialize-md5
- [ process-md5-block ]
- [ process-md5-block ] bi* get-md5 ;
-
-: seq-bitxor ( seq seq -- seq )
- [ bitxor ] 2map ;
-
-MEMO: ipad ( -- seq ) 64 HEX: 36 <array> ;
-
-MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
-
-: init-hmac ( K -- o i )
- 64 0 pad-tail
- [ opad seq-bitxor ]
- [ ipad seq-bitxor ] bi ;
-
-PRIVATE>
-
-: stream>sha1-hmac ( K stream -- hmac )
- [ init-hmac sha1-hmac ] with-input-stream ;
-
-: file>sha1-hmac ( K path -- hmac )
- binary <file-reader> stream>sha1-hmac ;
-
-: sequence>sha1-hmac ( K sequence -- hmac )
- binary <byte-reader> stream>sha1-hmac ;
-
-: stream>md5-hmac ( K stream -- hmac )
- [ init-hmac md5-hmac ] with-input-stream ;
-
-: file>md5-hmac ( K path -- hmac )
- binary <file-reader> stream>md5-hmac ;
-
-: sequence>md5-hmac ( K sequence -- hmac )
- binary <byte-reader> stream>md5-hmac ;
projects / factor.git / commitdiff