New checksum protocol

db4
Slava Pestov 2008-04-30 16:11:55 -05:00
parent 72fcd2b133
commit 7584e02805
46 changed files with 268 additions and 177 deletions

View File

@ -305,12 +305,12 @@ M: wrapper '
[ emit ] emit-object ; [ emit ] emit-object ;
! Strings ! Strings
: emit-chars ( seq -- ) : emit-bytes ( seq -- )
bootstrap-cell <groups> bootstrap-cell <groups>
big-endian get [ [ be> ] map ] [ [ le> ] map ] if big-endian get [ [ be> ] map ] [ [ le> ] map ] if
emit-seq ; emit-seq ;
: pack-string ( string -- newstr ) : pad-bytes ( seq -- newseq )
dup length bootstrap-cell align 0 pad-right ; dup length bootstrap-cell align 0 pad-right ;
: emit-string ( string -- ptr ) : emit-string ( string -- ptr )
@ -318,7 +318,7 @@ M: wrapper '
dup length emit-fixnum dup length emit-fixnum
f ' emit f ' emit
f ' emit f ' emit
pack-string emit-chars pad-bytes emit-bytes
] emit-object ; ] emit-object ;
M: string ' M: string '
@ -335,7 +335,11 @@ M: string '
[ 0 emit-fixnum ] emit-object [ 0 emit-fixnum ] emit-object
] bi* ; ] bi* ;
M: byte-array ' byte-array emit-dummy-array ; M: byte-array '
byte-array type-number object tag-number [
dup length emit-fixnum
pad-bytes emit-bytes
] emit-object ;
M: bit-array ' bit-array emit-dummy-array ; M: bit-array ' bit-array emit-dummy-array ;

View File

@ -59,6 +59,7 @@ num-types get f <array> builtins set
"arrays" "arrays"
"bit-arrays" "bit-arrays"
"byte-arrays" "byte-arrays"
"byte-vectors"
"classes.private" "classes.private"
"classes.tuple" "classes.tuple"
"classes.tuple.private" "classes.tuple.private"
@ -452,6 +453,22 @@ tuple
} }
} define-tuple-class } define-tuple-class
"byte-vector" "byte-vectors" create
tuple
{
{
{ "byte-array" "byte-arrays" }
"underlying"
{ "underlying" "growable" }
{ "set-underlying" "growable" }
} {
{ "array-capacity" "sequences.private" }
"fill"
{ "length" "sequences" }
{ "set-fill" "growable" }
}
} define-tuple-class
"curry" "kernel" create "curry" "kernel" create
tuple tuple
{ {

View File

@ -16,6 +16,7 @@ IN: bootstrap.syntax
"?{" "?{"
"BIN:" "BIN:"
"B{" "B{"
"BV{"
"C:" "C:"
"CHAR:" "CHAR:"
"DEFER:" "DEFER:"

View File

@ -1,20 +1,9 @@
! 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: arrays kernel kernel.private math sequences USING: arrays kernel kernel.private math sequences
sequences.private growable byte-arrays prettyprint.backend sequences.private growable byte-arrays ;
parser accessors ;
IN: byte-vectors IN: byte-vectors
TUPLE: byte-vector underlying fill ;
M: byte-vector underlying underlying>> { byte-array } declare ;
M: byte-vector set-underlying (>>underlying) ;
M: byte-vector length fill>> { array-capacity } declare ;
M: byte-vector set-fill (>>fill) ;
<PRIVATE <PRIVATE
: byte-array>vector ( byte-array length -- byte-vector ) : byte-array>vector ( byte-array length -- byte-vector )
@ -43,9 +32,3 @@ M: byte-vector equal?
M: byte-array new-resizable drop <byte-vector> ; M: byte-array new-resizable drop <byte-vector> ;
INSTANCE: byte-vector growable INSTANCE: byte-vector growable
: BV{ \ } [ >byte-vector ] parse-literal ; parsing
M: byte-vector >pprint-sequence ;
M: byte-vector pprint-delims drop \ BV{ \ } ;

View File

@ -0,0 +1,51 @@
USING: help.markup help.syntax kernel math sequences quotations
math.private byte-arrays strings ;
IN: checksums
HELP: checksum
{ $class-description "The class of checksum algorithms." } ;
HELP: hex-string
{ $values { "seq" "a sequence" } { "str" "a string" } }
{ $description "Converts a sequence of values from 0-255 to a string of hex numbers from 0-ff." }
{ $examples
{ $example "USING: checksums io ;" "B{ 1 2 3 4 } hex-string print" "01020304" }
}
{ $notes "Numbers are zero-padded on the left." } ;
HELP: checksum-stream
{ $values { "stream" "an input stream" } { "checksum" "a checksum specifier" } { "value" byte-array } }
{ $contract "Computes the checksum of all data read from the stream." }
{ $side-effects "stream" } ;
HELP: checksum-bytes
{ $values { "bytes" "a sequence of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
{ $contract "Computes the checksum of all data in a sequence." } ;
HELP: checksum-lines
{ $values { "lines" "a sequence of sequences of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
{ $contract "Computes the checksum of all data in a sequence." } ;
HELP: checksum-file
{ $values { "path" "a pathname specifier" } { "checksum" "a checksum specifier" } { "value" byte-array } }
{ $contract "Computes the checksum of all data in a file." } ;
ARTICLE: "checksums" "Checksums"
"A " { $emphasis "checksum" } " is a function mapping sequences of bytes to fixed-length strings. While checksums are not one-to-one, a good checksum should have a low probability of collision. Additionally, some checksum algorithms are designed to be hard to reverse, in the sense that finding an input string which hashes to a given checksum string requires a brute-force search."
$nl
"Checksums are instances of a class:"
{ $subsection checksum }
"Operations on checksums:"
{ $subsection checksum-bytes }
{ $subsection checksum-stream }
{ $subsection checksum-lines }
"Checksums should implement at least one of " { $link checksum-bytes } " and " { $link checksum-stream } ". Implementing " { $link checksum-lines } " is optional."
$nl
"Utilities:"
{ $subsection checksum-file }
{ $subsection hex-string }
"Checksum implementations:"
{ $subsection "checksums.crc32" }
{ $vocab-subsection "MD5 checksum" "checksums.md5" }
{ $vocab-subsection "SHA1 checksum" "checksums.sha1" }
{ $vocab-subsection "SHA2 checksum" "checksums.sha2" } ;

View File

@ -0,0 +1,25 @@
! Copyright (c) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: sequences math.parser io io.streams.byte-array
io.encodings.binary io.files kernel ;
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 >r binary <byte-reader> r> checksum-stream ;
M: checksum checksum-stream >r contents r> checksum-bytes ;
M: checksum checksum-lines >r B{ CHAR: \n } join r> checksum-bytes ;
: checksum-file ( path checksum -- n )
>r binary <file-reader> r> checksum-stream ;
: hex-string ( seq -- str )
[ >hex 2 CHAR: 0 pad-left ] { } map-as concat ;

View File

@ -0,0 +1,11 @@
USING: help.markup help.syntax math ;
IN: checksums.crc32
HELP: crc32
{ $class-description "The CRC32 checksum algorithm." } ;
ARTICLE: "checksums.crc32" "CRC32 checksum"
"The CRC32 checksum algorithm provides a quick but unreliable way to detect changes in data."
{ $subsection crc32 } ;
ABOUT: "checksums.crc32"

View File

@ -0,0 +1,6 @@
USING: checksums checksums.crc32 kernel math tools.test namespaces ;
[ B{ 0 0 0 0 } ] [ "" crc32 checksum-bytes ] unit-test
[ B{ HEX: cb HEX: f4 HEX: 39 HEX: 26 } ] [ "123456789" crc32 checksum-bytes ] unit-test

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences sequences.private namespaces USING: kernel math sequences sequences.private namespaces
words io io.binary io.files io.streams.string quotations words io io.binary io.files io.streams.string quotations
definitions ; definitions checksums ;
IN: io.crc32 IN: checksums.crc32
: crc32-polynomial HEX: edb88320 ; inline : crc32-polynomial HEX: edb88320 ; inline
@ -20,10 +20,20 @@ IN: io.crc32
mask-byte crc32-table nth-unsafe >bignum mask-byte crc32-table nth-unsafe >bignum
swap -8 shift bitxor ; inline swap -8 shift bitxor ; inline
: crc32 ( seq -- n ) SINGLETON: crc32
>r HEX: ffffffff dup r> [ (crc32) ] each bitxor ;
: lines-crc32 ( seq -- n ) INSTANCE: crc32 checksum
HEX: ffffffff tuck [
[ (crc32) ] each CHAR: \n (crc32) : init-crc32 drop >r HEX: ffffffff dup r> ; inline
] reduce bitxor ;
: finish-crc32 bitxor 4 >be ; inline
M: crc32 checksum-bytes
init-crc32
[ (crc32) ] each
finish-crc32 ;
M: crc32 checksum-lines
init-crc32
[ [ (crc32) ] each CHAR: \n (crc32) ] each
finish-crc32 ;

View File

@ -1,17 +0,0 @@
USING: help.markup help.syntax math ;
IN: io.crc32
HELP: crc32
{ $values { "seq" "a sequence of bytes" } { "n" integer } }
{ $description "Computes the CRC32 checksum of a sequence of bytes." } ;
HELP: lines-crc32
{ $values { "seq" "a sequence of strings" } { "n" integer } }
{ $description "Computes the CRC32 checksum of a sequence of lines of bytes." } ;
ARTICLE: "io.crc32" "CRC32 checksum calculation"
"The CRC32 checksum algorithm provides a quick but unreliable way to detect changes in data."
{ $subsection crc32 }
{ $subsection lines-crc32 } ;
ABOUT: "io.crc32"

View File

@ -1,5 +0,0 @@
USING: io.crc32 kernel math tools.test namespaces ;
[ 0 ] [ "" crc32 ] unit-test
[ HEX: cbf43926 ] [ "123456789" crc32 ] unit-test

View File

@ -4,7 +4,7 @@ IN: optimizer.known-words
USING: alien arrays generic hashtables inference.dataflow USING: alien arrays generic hashtables inference.dataflow
inference.class kernel assocs math math.private kernel.private inference.class kernel assocs math math.private kernel.private
sequences words parser vectors strings sbufs io namespaces sequences words parser vectors strings sbufs io namespaces
assocs quotations sequences.private io.binary io.crc32 assocs quotations sequences.private io.binary
io.streams.string layouts splitting math.intervals io.streams.string layouts splitting math.intervals
math.floats.private classes.tuple classes.tuple.private classes math.floats.private classes.tuple classes.tuple.private classes
classes.algebra optimizer.def-use optimizer.backend classes.algebra optimizer.def-use optimizer.backend
@ -126,8 +126,6 @@ sequences.private combinators ;
\ >sbuf { string } "specializer" set-word-prop \ >sbuf { string } "specializer" set-word-prop
\ crc32 { string } "specializer" set-word-prop
\ split, { string string } "specializer" set-word-prop \ split, { string string } "specializer" set-word-prop
\ memq? { array } "specializer" set-word-prop \ memq? { array } "specializer" set-word-prop

View File

@ -1,10 +1,11 @@
! Copyright (C) 2003, 2008 Slava Pestov. ! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays byte-arrays bit-arrays generic hashtables io USING: arrays byte-arrays byte-vectors bit-arrays generic
assocs kernel math namespaces sequences strings sbufs io.styles hashtables io assocs kernel math namespaces sequences strings
vectors words prettyprint.config prettyprint.sections quotations sbufs io.styles vectors words prettyprint.config
io io.files math.parser effects classes.tuple math.order prettyprint.sections quotations io io.files math.parser effects
classes.tuple.private classes float-arrays ; classes.tuple math.order classes.tuple.private classes
float-arrays ;
IN: prettyprint.backend IN: prettyprint.backend
GENERIC: pprint* ( obj -- ) GENERIC: pprint* ( obj -- )
@ -140,6 +141,7 @@ M: compose pprint-delims drop \ [ \ ] ;
M: array pprint-delims drop \ { \ } ; M: array pprint-delims drop \ { \ } ;
M: byte-array pprint-delims drop \ B{ \ } ; M: byte-array pprint-delims drop \ B{ \ } ;
M: bit-array pprint-delims drop \ ?{ \ } ; M: bit-array pprint-delims drop \ ?{ \ } ;
M: byte-vector pprint-delims drop \ BV{ \ } ;
M: float-array pprint-delims drop \ F{ \ } ; M: float-array pprint-delims drop \ F{ \ } ;
M: vector pprint-delims drop \ V{ \ } ; M: vector pprint-delims drop \ V{ \ } ;
M: hashtable pprint-delims drop \ H{ \ } ; M: hashtable pprint-delims drop \ H{ \ } ;
@ -152,6 +154,7 @@ GENERIC: >pprint-sequence ( obj -- seq )
M: object >pprint-sequence ; M: object >pprint-sequence ;
M: vector >pprint-sequence ; M: vector >pprint-sequence ;
M: byte-vector >pprint-sequence ;
M: curry >pprint-sequence ; M: curry >pprint-sequence ;
M: compose >pprint-sequence ; M: compose >pprint-sequence ;
M: hashtable >pprint-sequence >alist ; M: hashtable >pprint-sequence >alist ;

View File

@ -3,8 +3,8 @@
USING: arrays definitions generic assocs kernel math namespaces USING: arrays definitions generic assocs kernel math namespaces
prettyprint sequences strings vectors words quotations inspector prettyprint sequences strings vectors words quotations inspector
io.styles io combinators sorting splitting math.parser effects io.styles io combinators sorting splitting math.parser effects
continuations debugger io.files io.crc32 vocabs hashtables continuations debugger io.files checksums checksums.crc32 vocabs
graphs compiler.units io.encodings.utf8 accessors ; hashtables graphs compiler.units io.encodings.utf8 accessors ;
IN: source-files IN: source-files
SYMBOL: source-files SYMBOL: source-files
@ -15,7 +15,7 @@ checksum
uses definitions ; uses definitions ;
: record-checksum ( lines source-file -- ) : record-checksum ( lines source-file -- )
>r lines-crc32 r> set-source-file-checksum ; >r crc32 checksum-lines r> set-source-file-checksum ;
: (xref-source) ( source-file -- pathname uses ) : (xref-source) ( source-file -- pathname uses )
dup source-file-path <pathname> dup source-file-path <pathname>

View File

@ -1,6 +1,6 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays bit-arrays byte-arrays USING: alien arrays bit-arrays byte-arrays byte-vectors
definitions generic hashtables kernel math definitions generic hashtables kernel math
namespaces parser sequences strings sbufs vectors words namespaces parser sequences strings sbufs vectors words
quotations io assocs splitting classes.tuple generic.standard quotations io assocs splitting classes.tuple generic.standard
@ -79,6 +79,7 @@ IN: bootstrap.syntax
"{" [ \ } [ >array ] parse-literal ] define-syntax "{" [ \ } [ >array ] parse-literal ] define-syntax
"V{" [ \ } [ >vector ] parse-literal ] define-syntax "V{" [ \ } [ >vector ] parse-literal ] define-syntax
"B{" [ \ } [ >byte-array ] parse-literal ] define-syntax "B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
"BV{" [ \ } [ >byte-vector ] parse-literal ] define-syntax
"?{" [ \ } [ >bit-array ] parse-literal ] define-syntax "?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
"F{" [ \ } [ >float-array ] parse-literal ] define-syntax "F{" [ \ } [ >float-array ] parse-literal ] define-syntax
"H{" [ \ } [ >hashtable ] parse-literal ] define-syntax "H{" [ \ } [ >hashtable ] parse-literal ] define-syntax

View File

@ -1,10 +1,10 @@
USING: io.crc32 io.encodings.ascii io.files kernel math ; USING: checksums checksums.crc32 io.encodings.ascii io.files kernel math ;
IN: benchmark.crc32 IN: benchmark.crc32
: crc32-primes-list ( -- ) : crc32-primes-list ( -- )
10 [ 10 [
"extra/math/primes/list/list.factor" resource-path "resource:extra/math/primes/list/list.factor"
ascii file-contents crc32 drop crc32 checksum-file drop
] times ; ] times ;
MAIN: crc32-primes-list MAIN: crc32-primes-list

View File

@ -1,7 +1,7 @@
USING: crypto.md5 io.files kernel ; USING: checksums checksums.md5 io.files kernel ;
IN: benchmark.md5 IN: benchmark.md5
: md5-primes-list ( -- ) : md5-primes-list ( -- )
"extra/math/primes/list/list.factor" resource-path file>md5 drop ; "resource:extra/math/primes/list/list.factor" md5 checksum-file drop ;
MAIN: md5-primes-list MAIN: md5-primes-list

View File

@ -1,13 +1,13 @@
IN: benchmark.reverse-complement.tests IN: benchmark.reverse-complement.tests
USING: tools.test benchmark.reverse-complement crypto.md5 USING: tools.test benchmark.reverse-complement
checksums checksums.md5
io.files kernel ; io.files kernel ;
[ "c071aa7e007a9770b2fb4304f55a17e5" ] [ [ "c071aa7e007a9770b2fb4304f55a17e5" ] [
"extra/benchmark/reverse-complement/reverse-complement-test-in.txt" "resource:extra/benchmark/reverse-complement/reverse-complement-test-in.txt"
"extra/benchmark/reverse-complement/reverse-complement-test-out.txt" "resource:extra/benchmark/reverse-complement/reverse-complement-test-out.txt"
[ resource-path ] bi@
reverse-complement reverse-complement
"extra/benchmark/reverse-complement/reverse-complement-test-out.txt" "resource:extra/benchmark/reverse-complement/reverse-complement-test-out.txt"
resource-path file>md5str md5 checksum-file hex-string
] unit-test ] unit-test

View File

@ -1,7 +1,7 @@
USING: crypto.sha1 io.files kernel ; USING: checksum checksums.sha1 io.files kernel ;
IN: benchmark.sha1 IN: benchmark.sha1
: sha1-primes-list ( -- ) : sha1-primes-list ( -- )
"extra/math/primes/list/list.factor" resource-path file>sha1 drop ; "resource:extra/math/primes/list/list.factor" sha1 checksum-file drop ;
MAIN: sha1-primes-list MAIN: sha1-primes-list

View File

@ -1,8 +1,8 @@
! 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.
IN: bootstrap.image.download IN: bootstrap.image.download
USING: http.client crypto.md5 splitting assocs kernel io.files USING: http.client checksums checksums.md5 splitting assocs
bootstrap.image sequences io ; kernel io.files bootstrap.image sequences io ;
: url "http://factorcode.org/images/latest/" ; : url "http://factorcode.org/images/latest/" ;
@ -12,7 +12,7 @@ bootstrap.image sequences io ;
: need-new-image? ( image -- ? ) : need-new-image? ( image -- ? )
dup exists? dup exists?
[ dup file>md5str swap download-checksums at = not ] [ [ md5 checksum-file hex-string ] [ download-checksums at ] bi = not ]
[ drop t ] if ; [ drop t ] if ;
: download-image ( arch -- ) : download-image ( arch -- )

View File

@ -1,8 +1,9 @@
! 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: http.client checksums checksums.md5 splitting assocs
kernel io.files bootstrap.image sequences io namespaces
io.launcher math io.encodings.ascii ;
IN: bootstrap.image.upload IN: bootstrap.image.upload
USING: http.client crypto.md5 splitting assocs kernel io.files
bootstrap.image sequences io namespaces io.launcher math io.encodings.ascii ;
SYMBOL: upload-images-destination SYMBOL: upload-images-destination
@ -17,7 +18,9 @@ SYMBOL: upload-images-destination
: compute-checksums ( -- ) : compute-checksums ( -- )
checksums ascii [ checksums ascii [
boot-image-names [ dup write bl file>md5str print ] each boot-image-names [
[ write bl ] [ md5 checksum-file hex-string print ] bi
] each
] with-file-writer ; ] with-file-writer ;
: upload-images ( -- ) : upload-images ( -- )

View File

@ -0,0 +1,11 @@
USING: help.markup help.syntax ;
IN: checksums.md5
HELP: md5
{ $description "MD5 checksum algorithm." } ;
ARTICLE: "checksums.md5" "MD5 checksum"
"The MD5 checksum algorithm implements a one-way hash function. While it is widely used, many weaknesses are known and it should not be used in new applications (" { $url "http://www.schneier.com/blog/archives/2005/03/more_hash_funct.html" } ")."
{ $subsection md5 } ;
ABOUT: "checksums.md5"

View File

@ -0,0 +1,10 @@
USING: kernel math namespaces checksums checksums.md5 tools.test byte-arrays ;
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "900150983cd24fb0d6963f7d28e17f72" ] [ "abc" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "f96b697d7cb7938d525a2f31aaf161d0" ] [ "message digest" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "c3fcd3d76192e4007dfb496cca67e13b" ] [ "abcdefghijklmnopqrstuvwxyz" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array md5 checksum-bytes hex-string ] unit-test

View File

@ -3,8 +3,8 @@
USING: kernel io io.binary io.files io.streams.byte-array math USING: kernel io io.binary io.files io.streams.byte-array math
math.functions math.parser namespaces splitting strings math.functions math.parser namespaces splitting strings
sequences crypto.common byte-arrays locals sequences.private sequences crypto.common byte-arrays locals sequences.private
io.encodings.binary symbols math.bitfields.lib ; io.encodings.binary symbols math.bitfields.lib checksums ;
IN: crypto.md5 IN: checksums.md5
<PRIVATE <PRIVATE
@ -166,26 +166,18 @@ SYMBOLS: a b c d old-a old-b old-c old-d ;
[ (process-md5-block) ] each [ (process-md5-block) ] each
] if ; ] if ;
: (stream>md5) ( -- ) : stream>md5 ( -- )
64 read [ process-md5-block ] keep 64 read [ process-md5-block ] keep
length 64 = [ (stream>md5) ] when ; length 64 = [ stream>md5 ] when ;
: get-md5 ( -- str ) : get-md5 ( -- str )
[ a b c d ] [ get 4 >le ] map concat >byte-array ; [ a b c d ] [ get 4 >le ] map concat >byte-array ;
PRIVATE> PRIVATE>
: stream>md5 ( stream -- byte-array ) SINGLETON: md5
[ initialize-md5 (stream>md5) get-md5 ] with-stream ;
: byte-array>md5 ( byte-array -- checksum ) INSTANCE: md5 checksum
binary <byte-reader> stream>md5 ;
: byte-array>md5str ( byte-array -- md5-string ) M: md5 checksum-stream ( stream -- byte-array )
byte-array>md5 hex-string ; drop [ initialize-md5 stream>md5 get-md5 ] with-stream ;
: file>md5 ( path -- byte-array )
binary <file-reader> stream>md5 ;
: file>md5str ( path -- md5-string )
file>md5 hex-string ;

View File

@ -0,0 +1,11 @@
USING: help.markup help.syntax ;
IN: checksums.sha1
HELP: sha1
{ $description "SHA1 checksum algorithm." } ;
ARTICLE: "checksums.sha1" "SHA1 checksum"
"The SHA1 checksum algorithm implements a one-way hash function. It is generally considered to be stronger than MD5, however there is a known algorithm for finding collisions more effectively than a brute-force search (" { $url "http://www.schneier.com/blog/archives/2005/02/sha1_broken.html" } ")."
{ $subsection sha1 } ;
ABOUT: "checksums.sha1"

View File

@ -1,14 +1,14 @@
USING: arrays kernel math namespaces sequences tools.test crypto.sha1 ; USING: arrays kernel math namespaces sequences tools.test checksums checksums.sha1 ;
[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" byte-array>sha1str ] unit-test [ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" sha1 checksum-bytes hex-string ] unit-test
[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" byte-array>sha1str ] unit-test [ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test
! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time... ! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567" [ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567"
10 swap <array> concat byte-array>sha1str ] unit-test 10 swap <array> concat sha1 checksum-bytes hex-string ] unit-test
[ [
";\u00009b\u0000fd\u0000cdK\u0000a3^s\u0000d0*\u0000e3\\\u0000b5\u000013<\u0000e8wA\u0000b2\u000083\u0000d20\u0000f1\u0000e6\u0000cc\u0000d8\u00001e\u00009c\u000004\u0000d7PT]\u0000ce,\u000001\u000012\u000080\u000096\u000099" ";\u00009b\u0000fd\u0000cdK\u0000a3^s\u0000d0*\u0000e3\\\u0000b5\u000013<\u0000e8wA\u0000b2\u000083\u0000d20\u0000f1\u0000e6\u0000cc\u0000d8\u00001e\u00009c\u000004\u0000d7PT]\u0000ce,\u000001\u000012\u000080\u000096\u000099"
] [ ] [
"\u000066\u000053\u0000f1\u00000c\u00001a\u0000fa\u0000b5\u00004c\u000061\u0000c8\u000025\u000075\u0000a8\u00004a\u0000fe\u000030\u0000d8\u0000aa\u00001a\u00003a\u000096\u000096\u0000b3\u000018\u000099\u000092\u0000bf\u0000e1\u0000cb\u00007f\u0000a6\u0000a7" "\u000066\u000053\u0000f1\u00000c\u00001a\u0000fa\u0000b5\u00004c\u000061\u0000c8\u000025\u000075\u0000a8\u00004a\u0000fe\u000030\u0000d8\u0000aa\u00001a\u00003a\u000096\u000096\u0000b3\u000018\u000099\u000092\u0000bf\u0000e1\u0000cb\u00007f\u0000a6\u0000a7"
byte-array>sha1-interleave sha1-interleave
] unit-test ] unit-test

View File

@ -1,8 +1,8 @@
USING: arrays combinators crypto.common kernel io USING: arrays combinators crypto.common kernel io
io.encodings.binary io.files io.streams.byte-array math.vectors io.encodings.binary io.files io.streams.byte-array math.vectors
strings sequences namespaces math parser sequences vectors strings sequences namespaces math parser sequences vectors
io.binary hashtables symbols math.bitfields.lib ; io.binary hashtables symbols math.bitfields.lib checksums ;
IN: crypto.sha1 IN: checksums.sha1
! Implemented according to RFC 3174. ! Implemented according to RFC 3174.
@ -99,30 +99,22 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
[ (process-sha1-block) ] each [ (process-sha1-block) ] each
] if ; ] if ;
: (stream>sha1) ( -- ) : stream>sha1 ( -- )
64 read [ process-sha1-block ] keep 64 read [ process-sha1-block ] keep
length 64 = [ (stream>sha1) ] when ; length 64 = [ stream>sha1 ] when ;
: get-sha1 ( -- str ) : get-sha1 ( -- str )
[ [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each ] "" make ; [ [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each ] "" make ;
: stream>sha1 ( stream -- sha1 ) SINGLETON: sha1
[ initialize-sha1 (stream>sha1) get-sha1 ] with-stream ;
: byte-array>sha1 ( string -- sha1 ) INSTANCE: sha1 checksum
binary <byte-reader> stream>sha1 ;
: byte-array>sha1str ( string -- str ) M: sha1 checksum-stream ( stream -- sha1 )
byte-array>sha1 hex-string ; drop [ initialize-sha1 stream>sha1 get-sha1 ] with-stream ;
: byte-array>sha1-bignum ( string -- n ) : sha1-interleave ( string -- seq )
byte-array>sha1 be> ;
: file>sha1 ( file -- sha1 )
binary <file-reader> stream>sha1 ;
: byte-array>sha1-interleave ( string -- seq )
[ zero? ] left-trim [ zero? ] left-trim
dup length odd? [ rest ] when dup length odd? [ rest ] when
seq>2seq [ byte-array>sha1 ] bi@ seq>2seq [ sha1 checksum-bytes ] bi@
2seq>seq ; 2seq>seq ;

View File

@ -0,0 +1,11 @@
USING: help.markup help.syntax ;
IN: checksums.sha2
HELP: sha-256
{ $description "SHA-256 checksum algorithm." } ;
ARTICLE: "checksums.sha2" "SHA2 checksum"
"The SHA2 checksum algorithm implements a one-way hash function. It is generally considered to be pretty strong."
{ $subsection sha-256 } ;
ABOUT: "checksums.sha2"

View File

@ -1,7 +1,7 @@
USING: arrays kernel math namespaces sequences tools.test crypto.sha2 ; USING: arrays kernel math namespaces sequences tools.test checksums.sha2 checksums ;
[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ] [ "" byte-array>sha-256-string ] unit-test [ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ] [ "" sha-256 checksum-bytes hex-string ] unit-test
[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ] [ "abc" byte-array>sha-256-string ] unit-test [ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ] [ "abc" sha-256 checksum-bytes hex-string ] unit-test
[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ] [ "message digest" byte-array>sha-256-string ] unit-test [ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ] [ "message digest" sha-256 checksum-bytes hex-string ] unit-test
[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ] [ "abcdefghijklmnopqrstuvwxyz" byte-array>sha-256-string ] unit-test [ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ] [ "abcdefghijklmnopqrstuvwxyz" sha-256 checksum-bytes hex-string ] unit-test
[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" byte-array>sha-256-string ] unit-test [ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" sha-256 checksum-bytes hex-string ] unit-test
[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" byte-array>sha-256-string ] unit-test [ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" sha-256 checksum-bytes hex-string ] unit-test

View File

@ -1,6 +1,6 @@
USING: crypto.common kernel splitting math sequences namespaces USING: crypto.common kernel splitting math sequences namespaces
io.binary symbols math.bitfields.lib ; io.binary symbols math.bitfields.lib checksums ;
IN: crypto.sha2 IN: checksums.sha2
<PRIVATE <PRIVATE
@ -118,14 +118,15 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
PRIVATE> PRIVATE>
: byte-array>sha-256 ( string -- string ) SINGLETON: sha-256
[
INSTANCE: sha-256 checksum
M: sha-256 checksum-bytes
drop [
K-256 K set K-256 K set
initial-H-256 H set initial-H-256 H set
4 word-size set 4 word-size set
64 block-size set 64 block-size set
byte-array>sha2 byte-array>sha2
] with-scope ; ] with-scope ;
: byte-array>sha-256-string ( string -- hexstring )
byte-array>sha-256 hex-string ;

View File

@ -1,5 +1,6 @@
USING: arrays kernel io io.binary sbufs splitting strings sequences USING: arrays kernel io io.binary sbufs splitting strings sequences
namespaces math math.parser parser hints math.bitfields.lib ; namespaces math math.parser parser hints math.bitfields.lib
assocs ;
IN: crypto.common IN: crypto.common
: w+ ( int int -- int ) + 32 bits ; inline : w+ ( int int -- int ) + 32 bits ; inline
@ -39,9 +40,6 @@ SYMBOL: big-endian?
: update-old-new ( old new -- ) : update-old-new ( old new -- )
[ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline
: hex-string ( seq -- str )
[ [ >hex 2 48 pad-left % ] each ] "" make ;
: slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ; : slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ;
: seq>2seq ( seq -- seq1 seq2 ) : seq>2seq ( seq -- seq1 seq2 )
@ -50,7 +48,7 @@ SYMBOL: big-endian?
: 2seq>seq ( seq1 seq2 -- seq ) : 2seq>seq ( seq1 seq2 -- seq )
#! { aceg } { bdfh } -> { abcdefgh } #! { aceg } { bdfh } -> { abcdefgh }
[ 2array flip concat ] keep like ; [ zip concat ] keep like ;
: mod-nth ( n seq -- elt ) : mod-nth ( n seq -- elt )
#! 5 "abcd" -> b #! 5 "abcd" -> b

View File

@ -1,6 +1,7 @@
USING: arrays combinators crypto.common crypto.md5 crypto.sha1 USING: arrays combinators crypto.common checksums checksums.md5
crypto.md5.private io io.binary io.files io.streams.byte-array checksums.sha1 crypto.md5.private io io.binary io.files
kernel math math.vectors memoize sequences io.encodings.binary ; io.streams.byte-array kernel math math.vectors memoize sequences
io.encodings.binary ;
IN: crypto.hmac IN: crypto.hmac
: sha1-hmac ( Ko Ki -- hmac ) : sha1-hmac ( Ko Ki -- hmac )

View File

@ -1,18 +0,0 @@
USING: help.markup help.syntax kernel math sequences quotations
crypto.common byte-arrays ;
IN: crypto.md5
HELP: stream>md5
{ $values { "stream" "a stream" } { "byte-array" "md5 hash" } }
{ $description "Take the MD5 hash until end of stream." }
{ $notes "Used to implement " { $link byte-array>md5 } " and " { $link file>md5 } ". Call " { $link hex-string } " to convert to the canonical string representation." } ;
HELP: byte-array>md5
{ $values { "byte-array" byte-array } { "checksum" "an md5 hash" } }
{ $description "Outputs the MD5 hash of a byte array." }
{ $notes "Call " { $link hex-string } " to convert to the canonical string representation." } ;
HELP: file>md5
{ $values { "path" "a path" } { "byte-array" "byte-array md5 hash" } }
{ $description "Outputs the MD5 hash of a file." }
{ $notes "Call " { $link hex-string } " to convert to the canonical string representation." } ;

View File

@ -1,10 +0,0 @@
USING: kernel math namespaces crypto.md5 tools.test byte-arrays ;
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array byte-array>md5str ] unit-test
[ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array byte-array>md5str ] unit-test
[ "900150983cd24fb0d6963f7d28e17f72" ] [ "abc" >byte-array byte-array>md5str ] unit-test
[ "f96b697d7cb7938d525a2f31aaf161d0" ] [ "message digest" >byte-array byte-array>md5str ] unit-test
[ "c3fcd3d76192e4007dfb496cca67e13b" ] [ "abcdefghijklmnopqrstuvwxyz" >byte-array byte-array>md5str ] unit-test
[ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array byte-array>md5str ] unit-test
[ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array byte-array>md5str ] unit-test

View File

@ -204,7 +204,8 @@ ARTICLE: "io" "Input and output"
{ $heading "Other features" } { $heading "Other features" }
{ $subsection "network-streams" } { $subsection "network-streams" }
{ $subsection "io.launcher" } { $subsection "io.launcher" }
{ $subsection "io.timeouts" } ; { $subsection "io.timeouts" }
{ $subsection "checksums" } ;
ARTICLE: "tools" "Developer tools" ARTICLE: "tools" "Developer tools"
{ $subsection "tools.vocabs" } { $subsection "tools.vocabs" }

View File

@ -1,7 +1,7 @@
! 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: kernel accessors random math.parser locals USING: kernel accessors random math.parser locals
sequences math crypto.sha2 ; sequences math ;
IN: http.server.auth.providers IN: http.server.auth.providers
TUPLE: user username realname password email ticket profile deleted changed? ; TUPLE: user username realname password email ticket profile deleted changed? ;

View File

@ -3,8 +3,8 @@
USING: io.files kernel io.encodings.utf8 vocabs.loader vocabs USING: io.files kernel io.encodings.utf8 vocabs.loader vocabs
sequences namespaces math.parser arrays hashtables assocs sequences namespaces math.parser arrays hashtables assocs
memoize inspector sorting splitting combinators source-files memoize inspector sorting splitting combinators source-files
io debugger continuations compiler.errors init io.crc32 io debugger continuations compiler.errors init
sets ; checksums checksums.crc32 sets ;
IN: tools.vocabs IN: tools.vocabs
: vocab-tests-file ( vocab -- path ) : vocab-tests-file ( vocab -- path )
@ -63,7 +63,7 @@ SYMBOL: failures
dup source-files get at [ dup source-files get at [
dup source-file-path dup source-file-path
dup exists? [ dup exists? [
utf8 file-lines lines-crc32 utf8 file-lines crc32 checksum-lines
swap source-file-checksum = not swap source-file-checksum = not
] [ ] [
2drop f 2drop f