[ emit ] emit-object ;
! Strings
-: emit-chars ( seq -- )
+: emit-bytes ( seq -- )
bootstrap-cell <groups>
big-endian get [ [ be> ] map ] [ [ le> ] map ] if
emit-seq ;
-: pack-string ( string -- newstr )
+: pad-bytes ( seq -- newseq )
dup length bootstrap-cell align 0 pad-right ;
: emit-string ( string -- ptr )
dup length emit-fixnum
f ' emit
f ' emit
- pack-string emit-chars
+ pad-bytes emit-bytes
] emit-object ;
M: string '
[ 0 emit-fixnum ] emit-object
] 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 ;
"arrays"
"bit-arrays"
"byte-arrays"
+ "byte-vectors"
"classes.private"
"classes.tuple"
"classes.tuple.private"
}
} 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
tuple
{
"?{"
"BIN:"
"B{"
+ "BV{"
"C:"
"CHAR:"
"DEFER:"
--- /dev/null
+USING: arrays byte-arrays help.markup help.syntax kernel\r
+byte-vectors.private combinators ;\r
+IN: byte-vectors\r
+\r
+ARTICLE: "byte-vectors" "Byte vectors"\r
+"A byte vector is a resizable mutable sequence of unsigned bytes. Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary."\r
+$nl\r
+"Byte vectors form a class:"\r
+{ $subsection byte-vector }\r
+{ $subsection byte-vector? }\r
+"Creating byte vectors:"\r
+{ $subsection >byte-vector }\r
+{ $subsection <byte-vector> }\r
+"Literal syntax:"\r
+{ $subsection POSTPONE: BV{ }\r
+"If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:"\r
+{ $code "BV{ } clone" } ;\r
+\r
+ABOUT: "byte-vectors"\r
+\r
+HELP: byte-vector\r
+{ $description "The class of resizable byte vectors. See " { $link "byte-vectors" } " for information." } ;\r
+\r
+HELP: <byte-vector>\r
+{ $values { "n" "a positive integer specifying initial capacity" } { "byte-vector" byte-vector } }\r
+{ $description "Creates a new byte vector that can hold " { $snippet "n" } " bytes before resizing." } ;\r
+\r
+HELP: >byte-vector\r
+{ $values { "seq" "a sequence" } { "byte-vector" byte-vector } }\r
+{ $description "Outputs a freshly-allocated byte vector with the same elements as a given sequence." }\r
+{ $errors "Throws an error if the sequence contains elements other than integers." } ;\r
+\r
+HELP: byte-array>vector\r
+{ $values { "byte-array" "an array" } { "length" "a non-negative integer" } { "byte-vector" byte-vector } }\r
+{ $description "Creates a new byte vector using the array for underlying storage with the specified initial length." }\r
+{ $warning "This word is in the " { $vocab-link "byte-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >byte-vector } " instead." } ;\r
+\r
+HELP: BV{\r
+{ $syntax "BV{ elements... }" }\r
+{ $values { "elements" "a list of bytes" } }\r
+{ $description "Marks the beginning of a literal byte vector. Literal byte vectors are terminated by " { $link POSTPONE: } } "." } \r
+{ $examples { $code "BV{ 1 2 3 12 }" } } ;\r
--- /dev/null
+IN: byte-vectors.tests\r
+USING: tools.test byte-vectors vectors sequences kernel ;\r
+\r
+[ 0 ] [ 123 <byte-vector> length ] unit-test\r
+\r
+: do-it\r
+ 123 [ over push ] each ;\r
+\r
+[ t ] [\r
+ 3 <byte-vector> do-it\r
+ 3 <vector> do-it sequence=\r
+] unit-test\r
+\r
+[ t ] [ BV{ } byte-vector? ] unit-test\r
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.\r
+! See http://factorcode.org/license.txt for BSD license.\r
+USING: arrays kernel kernel.private math sequences\r
+sequences.private growable byte-arrays ;\r
+IN: byte-vectors\r
+\r
+<PRIVATE\r
+\r
+: byte-array>vector ( byte-array length -- byte-vector )\r
+ byte-vector boa ; inline\r
+\r
+PRIVATE>\r
+\r
+: <byte-vector> ( n -- byte-vector )\r
+ <byte-array> 0 byte-array>vector ; inline\r
+\r
+: >byte-vector ( seq -- byte-vector )\r
+ T{ byte-vector f B{ } 0 } clone-like ;\r
+\r
+M: byte-vector like\r
+ drop dup byte-vector? [\r
+ dup byte-array?\r
+ [ dup length byte-array>vector ] [ >byte-vector ] if\r
+ ] unless ;\r
+\r
+M: byte-vector new-sequence\r
+ drop [ <byte-array> ] keep >fixnum byte-array>vector ;\r
+\r
+M: byte-vector equal?\r
+ over byte-vector? [ sequence= ] [ 2drop f ] if ;\r
+\r
+M: byte-array new-resizable drop <byte-vector> ;\r
+\r
+INSTANCE: byte-vector growable\r
--- /dev/null
+Growable byte arrays
--- /dev/null
+collections
--- /dev/null
+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" } ;
--- /dev/null
+! 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 ;
--- /dev/null
+Slava Pestov
--- /dev/null
+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"
--- /dev/null
+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
+
--- /dev/null
+! Copyright (C) 2006 Doug Coleman
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math sequences sequences.private namespaces
+words io io.binary io.files io.streams.string quotations
+definitions checksums ;
+IN: checksums.crc32
+
+: crc32-polynomial HEX: edb88320 ; inline
+
+: crc32-table V{ } ; inline
+
+256 [
+ 8 [
+ dup even? >r 2/ r> [ crc32-polynomial bitxor ] unless
+ ] times >bignum
+] map 0 crc32-table copy
+
+: (crc32) ( crc ch -- crc )
+ >bignum dupd bitxor
+ mask-byte crc32-table nth-unsafe >bignum
+ swap -8 shift bitxor ; inline
+
+SINGLETON: crc32
+
+INSTANCE: crc32 checksum
+
+: init-crc32 drop >r HEX: ffffffff dup r> ; inline
+
+: 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 ;
--- /dev/null
+CRC32 checksum algorithm
+++ /dev/null
-Slava Pestov
+++ /dev/null
-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"
+++ /dev/null
-USING: io.crc32 kernel math tools.test namespaces ;
-
-[ 0 ] [ "" crc32 ] unit-test
-[ HEX: cbf43926 ] [ "123456789" crc32 ] unit-test
-
+++ /dev/null
-! Copyright (C) 2006 Doug Coleman
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences sequences.private namespaces
-words io io.binary io.files io.streams.string quotations
-definitions ;
-IN: io.crc32
-
-: crc32-polynomial HEX: edb88320 ; inline
-
-: crc32-table V{ } ; inline
-
-256 [
- 8 [
- dup even? >r 2/ r> [ crc32-polynomial bitxor ] unless
- ] times >bignum
-] map 0 crc32-table copy
-
-: (crc32) ( crc ch -- crc )
- >bignum dupd bitxor
- mask-byte crc32-table nth-unsafe >bignum
- swap -8 shift bitxor ; inline
-
-: crc32 ( seq -- n )
- >r HEX: ffffffff dup r> [ (crc32) ] each bitxor ;
-
-: lines-crc32 ( seq -- n )
- HEX: ffffffff tuck [
- [ (crc32) ] each CHAR: \n (crc32)
- ] reduce bitxor ;
+++ /dev/null
-CRC32 checksum algorithm
USING: alien arrays generic hashtables inference.dataflow
inference.class kernel assocs math math.private kernel.private
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
math.floats.private classes.tuple classes.tuple.private classes
classes.algebra optimizer.def-use optimizer.backend
\ >sbuf { string } "specializer" set-word-prop
-\ crc32 { string } "specializer" set-word-prop
-
\ split, { string string } "specializer" set-word-prop
\ memq? { array } "specializer" set-word-prop
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays bit-arrays generic hashtables io
-assocs kernel math namespaces sequences strings sbufs io.styles
-vectors words prettyprint.config prettyprint.sections quotations
-io io.files math.parser effects classes.tuple math.order
-classes.tuple.private classes float-arrays ;
+USING: arrays byte-arrays byte-vectors bit-arrays generic
+hashtables io assocs kernel math namespaces sequences strings
+sbufs io.styles vectors words prettyprint.config
+prettyprint.sections quotations io io.files math.parser effects
+classes.tuple math.order classes.tuple.private classes
+float-arrays ;
IN: prettyprint.backend
GENERIC: pprint* ( obj -- )
M: array pprint-delims drop \ { \ } ;
M: byte-array pprint-delims drop \ B{ \ } ;
M: bit-array pprint-delims drop \ ?{ \ } ;
+M: byte-vector pprint-delims drop \ BV{ \ } ;
M: float-array pprint-delims drop \ F{ \ } ;
M: vector pprint-delims drop \ V{ \ } ;
M: hashtable pprint-delims drop \ H{ \ } ;
M: object >pprint-sequence ;
M: vector >pprint-sequence ;
+M: byte-vector >pprint-sequence ;
M: curry >pprint-sequence ;
M: compose >pprint-sequence ;
M: hashtable >pprint-sequence >alist ;
USING: arrays definitions generic assocs kernel math namespaces
prettyprint sequences strings vectors words quotations inspector
io.styles io combinators sorting splitting math.parser effects
-continuations debugger io.files io.crc32 vocabs hashtables
-graphs compiler.units io.encodings.utf8 accessors ;
+continuations debugger io.files checksums checksums.crc32 vocabs
+hashtables graphs compiler.units io.encodings.utf8 accessors ;
IN: source-files
SYMBOL: source-files
uses definitions ;
: 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 )
dup source-file-path <pathname>
! Copyright (C) 2004, 2008 Slava Pestov.
! 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
namespaces parser sequences strings sbufs vectors words
quotations io assocs splitting classes.tuple generic.standard
"{" [ \ } [ >array ] parse-literal ] define-syntax
"V{" [ \ } [ >vector ] parse-literal ] define-syntax
"B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
+ "BV{" [ \ } [ >byte-vector ] parse-literal ] define-syntax
"?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
"F{" [ \ } [ >float-array ] parse-literal ] define-syntax
"H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
-USING: io.crc32 io.encodings.ascii io.files kernel math ;
+USING: checksums checksums.crc32 io.encodings.ascii io.files kernel math ;
IN: benchmark.crc32
: crc32-primes-list ( -- )
10 [
- "extra/math/primes/list/list.factor" resource-path
- ascii file-contents crc32 drop
+ "resource:extra/math/primes/list/list.factor"
+ crc32 checksum-file drop
] times ;
MAIN: crc32-primes-list
-USING: crypto.md5 io.files kernel ;
+USING: checksums checksums.md5 io.files kernel ;
IN: benchmark.md5
: 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
IN: benchmark.reverse-complement.tests\r
-USING: tools.test benchmark.reverse-complement crypto.md5\r
+USING: tools.test benchmark.reverse-complement\r
+checksums checksums.md5\r
io.files kernel ;\r
\r
[ "c071aa7e007a9770b2fb4304f55a17e5" ] [\r
- "extra/benchmark/reverse-complement/reverse-complement-test-in.txt"\r
- "extra/benchmark/reverse-complement/reverse-complement-test-out.txt"\r
- [ resource-path ] bi@\r
+ "resource:extra/benchmark/reverse-complement/reverse-complement-test-in.txt"\r
+ "resource:extra/benchmark/reverse-complement/reverse-complement-test-out.txt"\r
reverse-complement\r
\r
- "extra/benchmark/reverse-complement/reverse-complement-test-out.txt"\r
- resource-path file>md5str\r
+ "resource:extra/benchmark/reverse-complement/reverse-complement-test-out.txt"\r
+ md5 checksum-file hex-string\r
] unit-test\r
-USING: crypto.sha1 io.files kernel ;
+USING: checksum checksums.sha1 io.files kernel ;
IN: benchmark.sha1
: 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
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: bootstrap.image.download
-USING: http.client crypto.md5 splitting assocs kernel io.files
-bootstrap.image sequences io ;
+USING: http.client checksums checksums.md5 splitting assocs
+kernel io.files bootstrap.image sequences io ;
: url "http://factorcode.org/images/latest/" ;
: need-new-image? ( image -- ? )
dup exists?
- [ dup file>md5str swap download-checksums at = not ]
+ [ [ md5 checksum-file hex-string ] [ download-checksums at ] bi = not ]
[ drop t ] if ;
: download-image ( arch -- )
! Copyright (C) 2008 Slava Pestov.
! 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
-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
: compute-checksums ( -- )
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 ;
: upload-images ( -- )
+++ /dev/null
-USING: arrays byte-arrays help.markup help.syntax kernel\r
-byte-vectors.private combinators ;\r
-IN: byte-vectors\r
-\r
-ARTICLE: "byte-vectors" "Byte vectors"\r
-"A byte vector is a resizable mutable sequence of unsigned bytes. Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary."\r
-$nl\r
-"Byte vectors form a class:"\r
-{ $subsection byte-vector }\r
-{ $subsection byte-vector? }\r
-"Creating byte vectors:"\r
-{ $subsection >byte-vector }\r
-{ $subsection <byte-vector> }\r
-"Literal syntax:"\r
-{ $subsection POSTPONE: BV{ }\r
-"If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:"\r
-{ $code "BV{ } clone" } ;\r
-\r
-ABOUT: "byte-vectors"\r
-\r
-HELP: byte-vector\r
-{ $description "The class of resizable byte vectors. See " { $link "byte-vectors" } " for information." } ;\r
-\r
-HELP: <byte-vector>\r
-{ $values { "n" "a positive integer specifying initial capacity" } { "byte-vector" byte-vector } }\r
-{ $description "Creates a new byte vector that can hold " { $snippet "n" } " bytes before resizing." } ;\r
-\r
-HELP: >byte-vector\r
-{ $values { "seq" "a sequence" } { "byte-vector" byte-vector } }\r
-{ $description "Outputs a freshly-allocated byte vector with the same elements as a given sequence." }\r
-{ $errors "Throws an error if the sequence contains elements other than integers." } ;\r
-\r
-HELP: byte-array>vector\r
-{ $values { "byte-array" "an array" } { "length" "a non-negative integer" } { "byte-vector" byte-vector } }\r
-{ $description "Creates a new byte vector using the array for underlying storage with the specified initial length." }\r
-{ $warning "This word is in the " { $vocab-link "byte-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >byte-vector } " instead." } ;\r
-\r
-HELP: BV{\r
-{ $syntax "BV{ elements... }" }\r
-{ $values { "elements" "a list of bytes" } }\r
-{ $description "Marks the beginning of a literal byte vector. Literal byte vectors are terminated by " { $link POSTPONE: } } "." } \r
-{ $examples { $code "BV{ 1 2 3 12 }" } } ;\r
+++ /dev/null
-IN: byte-vectors.tests\r
-USING: tools.test byte-vectors vectors sequences kernel ;\r
-\r
-[ 0 ] [ 123 <byte-vector> length ] unit-test\r
-\r
-: do-it\r
- 123 [ over push ] each ;\r
-\r
-[ t ] [\r
- 3 <byte-vector> do-it\r
- 3 <vector> do-it sequence=\r
-] unit-test\r
-\r
-[ t ] [ BV{ } byte-vector? ] unit-test\r
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: arrays kernel kernel.private math sequences\r
-sequences.private growable byte-arrays prettyprint.backend\r
-parser accessors ;\r
-IN: byte-vectors\r
-\r
-TUPLE: byte-vector underlying fill ;\r
-\r
-M: byte-vector underlying underlying>> { byte-array } declare ;\r
-\r
-M: byte-vector set-underlying (>>underlying) ;\r
-\r
-M: byte-vector length fill>> { array-capacity } declare ;\r
-\r
-M: byte-vector set-fill (>>fill) ;\r
-\r
-<PRIVATE\r
-\r
-: byte-array>vector ( byte-array length -- byte-vector )\r
- byte-vector boa ; inline\r
-\r
-PRIVATE>\r
-\r
-: <byte-vector> ( n -- byte-vector )\r
- <byte-array> 0 byte-array>vector ; inline\r
-\r
-: >byte-vector ( seq -- byte-vector )\r
- T{ byte-vector f B{ } 0 } clone-like ;\r
-\r
-M: byte-vector like\r
- drop dup byte-vector? [\r
- dup byte-array?\r
- [ dup length byte-array>vector ] [ >byte-vector ] if\r
- ] unless ;\r
-\r
-M: byte-vector new-sequence\r
- drop [ <byte-array> ] keep >fixnum byte-array>vector ;\r
-\r
-M: byte-vector equal?\r
- over byte-vector? [ sequence= ] [ 2drop f ] if ;\r
-\r
-M: byte-array new-resizable drop <byte-vector> ;\r
-\r
-INSTANCE: byte-vector growable\r
-\r
-: BV{ \ } [ >byte-vector ] parse-literal ; parsing\r
-\r
-M: byte-vector >pprint-sequence ;\r
-\r
-M: byte-vector pprint-delims drop \ BV{ \ } ;\r
+++ /dev/null
-Growable byte arrays
+++ /dev/null
-collections
--- /dev/null
+Doug Coleman
--- /dev/null
+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"
--- /dev/null
+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
+
--- /dev/null
+! See http://www.faqs.org/rfcs/rfc1321.html
+
+USING: kernel io io.binary io.files io.streams.byte-array math
+math.functions math.parser namespaces splitting strings
+sequences crypto.common byte-arrays locals sequences.private
+io.encodings.binary symbols math.bitfields.lib checksums ;
+IN: checksums.md5
+
+<PRIVATE
+
+SYMBOLS: a b c d old-a old-b old-c old-d ;
+
+: T ( N -- Y )
+ sin abs 4294967296 * >bignum ; 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 s i k func a b c d -- )
+ #! 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
+
+: ABCD a b c d (ABCD) ; inline
+: BCDA b c d a (ABCD) ; inline
+: CDAB c d a b (ABCD) ; inline
+: DABC d a b c (ABCD) ; inline
+
+: F ( X Y Z -- FXYZ )
+ #! F(X,Y,Z) = XY v not(X) Z
+ pick bitnot bitand [ bitand ] [ bitor ] bi* ;
+
+: G ( X Y Z -- GXYZ )
+ #! G(X,Y,Z) = XZ v Y not(Z)
+ dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
+
+: H ( X Y Z -- HXYZ )
+ #! H(X,Y,Z) = X xor Y xor Z
+ bitxor bitxor ;
+
+: I ( X Y Z -- IXYZ )
+ #! I(X,Y,Z) = Y xor (X v not(Z))
+ rot swap bitnot bitor bitxor ;
+
+: S11 7 ; inline
+: S12 12 ; inline
+: S13 17 ; inline
+: S14 22 ; inline
+: S21 5 ; inline
+: S22 9 ; inline
+: S23 14 ; inline
+: S24 20 ; inline
+: S31 4 ; inline
+: S32 11 ; inline
+: S33 16 ; inline
+: S34 23 ; inline
+: S41 6 ; inline
+: S42 10 ; inline
+: S43 15 ; inline
+: S44 21 ; inline
+
+: (process-md5-block-F)
+ dup S11 1 0 [ F ] ABCD
+ dup S12 2 1 [ F ] DABC
+ dup S13 3 2 [ F ] CDAB
+ dup S14 4 3 [ F ] BCDA
+ dup S11 5 4 [ F ] ABCD
+ dup S12 6 5 [ F ] DABC
+ dup S13 7 6 [ F ] CDAB
+ dup S14 8 7 [ F ] BCDA
+ dup S11 9 8 [ F ] ABCD
+ dup S12 10 9 [ F ] DABC
+ dup S13 11 10 [ F ] CDAB
+ dup S14 12 11 [ F ] BCDA
+ dup S11 13 12 [ F ] ABCD
+ dup S12 14 13 [ F ] DABC
+ dup S13 15 14 [ F ] CDAB
+ dup S14 16 15 [ F ] BCDA ;
+
+: (process-md5-block-G)
+ dup S21 17 1 [ G ] ABCD
+ dup S22 18 6 [ G ] DABC
+ dup S23 19 11 [ G ] CDAB
+ dup S24 20 0 [ G ] BCDA
+ dup S21 21 5 [ G ] ABCD
+ dup S22 22 10 [ G ] DABC
+ dup S23 23 15 [ G ] CDAB
+ dup S24 24 4 [ G ] BCDA
+ dup S21 25 9 [ G ] ABCD
+ dup S22 26 14 [ G ] DABC
+ dup S23 27 3 [ G ] CDAB
+ dup S24 28 8 [ G ] BCDA
+ dup S21 29 13 [ G ] ABCD
+ dup S22 30 2 [ G ] DABC
+ dup S23 31 7 [ G ] CDAB
+ dup S24 32 12 [ G ] BCDA ;
+
+: (process-md5-block-H)
+ dup S31 33 5 [ H ] ABCD
+ dup S32 34 8 [ H ] DABC
+ dup S33 35 11 [ H ] CDAB
+ dup S34 36 14 [ H ] BCDA
+ dup S31 37 1 [ H ] ABCD
+ dup S32 38 4 [ H ] DABC
+ dup S33 39 7 [ H ] CDAB
+ dup S34 40 10 [ H ] BCDA
+ dup S31 41 13 [ H ] ABCD
+ dup S32 42 0 [ H ] DABC
+ dup S33 43 3 [ H ] CDAB
+ dup S34 44 6 [ H ] BCDA
+ dup S31 45 9 [ H ] ABCD
+ dup S32 46 12 [ H ] DABC
+ dup S33 47 15 [ H ] CDAB
+ dup S34 48 2 [ H ] BCDA ;
+
+: (process-md5-block-I)
+ dup S41 49 0 [ I ] ABCD
+ dup S42 50 7 [ I ] DABC
+ dup S43 51 14 [ I ] CDAB
+ dup S44 52 5 [ I ] BCDA
+ dup S41 53 12 [ I ] ABCD
+ dup S42 54 3 [ I ] DABC
+ dup S43 55 10 [ I ] CDAB
+ dup S44 56 1 [ I ] BCDA
+ dup S41 57 8 [ I ] ABCD
+ dup S42 58 15 [ I ] DABC
+ dup S43 59 6 [ I ] CDAB
+ dup S44 60 13 [ I ] BCDA
+ dup S41 61 4 [ I ] ABCD
+ dup S42 62 11 [ I ] DABC
+ dup S43 63 2 [ I ] CDAB
+ dup S44 64 9 [ I ] BCDA ;
+
+: (process-md5-block) ( block -- )
+ 4 <groups> [ le> ] map
+
+ (process-md5-block-F)
+ (process-md5-block-G)
+ (process-md5-block-H)
+ (process-md5-block-I)
+
+ drop
+
+ update-md ;
+
+: process-md5-block ( str -- )
+ dup length [ bytes-read [ + ] change ] keep 64 = [
+ (process-md5-block)
+ ] [
+ 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 ;
+
+: get-md5 ( -- str )
+ [ a b c d ] [ get 4 >le ] map concat >byte-array ;
+
+PRIVATE>
+
+SINGLETON: md5
+
+INSTANCE: md5 checksum
+
+M: md5 checksum-stream ( stream -- byte-array )
+ drop [ initialize-md5 stream>md5 get-md5 ] with-stream ;
--- /dev/null
+Doug Coleman
--- /dev/null
+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"
--- /dev/null
+USING: arrays kernel math namespaces sequences tools.test checksums checksums.sha1 ;
+
+[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" sha1 checksum-bytes hex-string ] unit-test
+[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test
+! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
+[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567"
+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"
+] [
+ "\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"
+ sha1-interleave
+] unit-test
--- /dev/null
+USING: arrays combinators crypto.common kernel io
+io.encodings.binary io.files io.streams.byte-array math.vectors
+strings sequences namespaces math parser sequences vectors
+io.binary hashtables symbols math.bitfields.lib checksums ;
+IN: checksums.sha1
+
+! Implemented according to RFC 3174.
+
+SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
+
+: get-wth ( n -- wth ) w get nth ; inline
+: shift-wth ( n -- x ) get-wth 1 bitroll-32 ; inline
+
+: initialize-sha1 ( -- )
+ 0 bytes-read set
+ HEX: 67452301 dup h0 set A set
+ HEX: efcdab89 dup h1 set B set
+ HEX: 98badcfe dup h2 set C set
+ HEX: 10325476 dup h3 set D set
+ HEX: c3d2e1f0 dup h4 set E set
+ [
+ 20 HEX: 5a827999 <array> %
+ 20 HEX: 6ed9eba1 <array> %
+ 20 HEX: 8f1bbcdc <array> %
+ 20 HEX: ca62c1d6 <array> %
+ ] { } make K set ;
+
+! W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
+: sha1-W ( t -- W_t )
+ dup 3 - get-wth
+ over 8 - get-wth bitxor
+ over 14 - get-wth bitxor
+ swap 16 - get-wth bitxor 1 bitroll-32 ;
+
+! f(t;B,C,D) = (B AND C) OR ((NOT B) AND D) ( 0 <= t <= 19)
+! f(t;B,C,D) = B XOR C XOR D (20 <= t <= 39)
+! f(t;B,C,D) = (B AND C) OR (B AND D) OR (C AND D) (40 <= t <= 59)
+! f(t;B,C,D) = B XOR C XOR D (60 <= t <= 79)
+: sha1-f ( B C D t -- f_tbcd )
+ 20 /i
+ {
+ { 0 [ >r over bitnot r> bitand >r bitand r> bitor ] }
+ { 1 [ bitxor bitxor ] }
+ { 2 [ 2dup bitand >r pick bitand >r bitand r> r> bitor bitor ] }
+ { 3 [ bitxor bitxor ] }
+ } case ;
+
+: make-w ( str -- )
+ #! compute w, steps a-b of RFC 3174, section 6.1
+ 16 [ nth-int-be w get push ] with each
+ 16 80 dup <slice> [ sha1-W w get push ] each ;
+
+: init-letters ( -- )
+ ! step c of RFC 3174, section 6.1
+ h0 get A set
+ h1 get B set
+ h2 get C set
+ h3 get D set
+ h4 get E set ;
+
+: inner-loop ( n -- temp )
+ ! TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
+ [
+ [ B get C get D get ] keep sha1-f ,
+ dup get-wth ,
+ K get nth ,
+ A get 5 bitroll-32 ,
+ E get ,
+ ] { } make sum 32 bits ; inline
+
+: set-vars ( temp -- )
+ ! E = D; D = C; C = S^30(B); B = A; A = TEMP;
+ D get E set
+ C get D set
+ B get 30 bitroll-32 C set
+ A get B set
+ A set ;
+
+: calculate-letters ( -- )
+ ! step d of RFC 3174, section 6.1
+ 80 [ inner-loop set-vars ] each ;
+
+: update-hs ( -- )
+ ! step e of RFC 3174, section 6.1
+ A h0 update-old-new
+ B h1 update-old-new
+ C h2 update-old-new
+ D h3 update-old-new
+ E h4 update-old-new ;
+
+: (process-sha1-block) ( str -- )
+ 80 <vector> w set make-w init-letters calculate-letters update-hs ;
+
+: process-sha1-block ( str -- )
+ dup length [ bytes-read [ + ] change ] keep 64 = [
+ (process-sha1-block)
+ ] [
+ t bytes-read get pad-last-block
+ [ (process-sha1-block) ] each
+ ] if ;
+
+: stream>sha1 ( -- )
+ 64 read [ process-sha1-block ] keep
+ length 64 = [ stream>sha1 ] when ;
+
+: get-sha1 ( -- str )
+ [ [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each ] "" make ;
+
+SINGLETON: sha1
+
+INSTANCE: sha1 checksum
+
+M: sha1 checksum-stream ( stream -- sha1 )
+ drop [ initialize-sha1 stream>sha1 get-sha1 ] with-stream ;
+
+: sha1-interleave ( string -- seq )
+ [ zero? ] left-trim
+ dup length odd? [ rest ] when
+ seq>2seq [ sha1 checksum-bytes ] bi@
+ 2seq>seq ;
--- /dev/null
+Doug Coleman
--- /dev/null
+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"
--- /dev/null
+USING: arrays kernel math namespaces sequences tools.test checksums.sha2 checksums ;
+[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ] [ "" sha-256 checksum-bytes hex-string ] unit-test
+[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ] [ "abc" sha-256 checksum-bytes hex-string ] unit-test
+[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ] [ "message digest" sha-256 checksum-bytes hex-string ] unit-test
+[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ] [ "abcdefghijklmnopqrstuvwxyz" sha-256 checksum-bytes hex-string ] unit-test
+[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" sha-256 checksum-bytes hex-string ] unit-test
+[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" sha-256 checksum-bytes hex-string ] unit-test
--- /dev/null
+USING: crypto.common kernel splitting math sequences namespaces
+io.binary symbols math.bitfields.lib checksums ;
+IN: checksums.sha2
+
+<PRIVATE
+
+SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
+
+: a 0 ; inline
+: b 1 ; inline
+: c 2 ; inline
+: d 3 ; inline
+: e 4 ; inline
+: f 5 ; inline
+: g 6 ; inline
+: h 7 ; inline
+
+: initial-H-256 ( -- seq )
+ {
+ HEX: 6a09e667 HEX: bb67ae85 HEX: 3c6ef372 HEX: a54ff53a
+ HEX: 510e527f HEX: 9b05688c HEX: 1f83d9ab HEX: 5be0cd19
+ } ;
+
+: K-256 ( -- seq )
+ {
+ HEX: 428a2f98 HEX: 71374491 HEX: b5c0fbcf HEX: e9b5dba5
+ HEX: 3956c25b HEX: 59f111f1 HEX: 923f82a4 HEX: ab1c5ed5
+ HEX: d807aa98 HEX: 12835b01 HEX: 243185be HEX: 550c7dc3
+ HEX: 72be5d74 HEX: 80deb1fe HEX: 9bdc06a7 HEX: c19bf174
+ HEX: e49b69c1 HEX: efbe4786 HEX: 0fc19dc6 HEX: 240ca1cc
+ HEX: 2de92c6f HEX: 4a7484aa HEX: 5cb0a9dc HEX: 76f988da
+ HEX: 983e5152 HEX: a831c66d HEX: b00327c8 HEX: bf597fc7
+ HEX: c6e00bf3 HEX: d5a79147 HEX: 06ca6351 HEX: 14292967
+ HEX: 27b70a85 HEX: 2e1b2138 HEX: 4d2c6dfc HEX: 53380d13
+ HEX: 650a7354 HEX: 766a0abb HEX: 81c2c92e HEX: 92722c85
+ HEX: a2bfe8a1 HEX: a81a664b HEX: c24b8b70 HEX: c76c51a3
+ HEX: d192e819 HEX: d6990624 HEX: f40e3585 HEX: 106aa070
+ HEX: 19a4c116 HEX: 1e376c08 HEX: 2748774c HEX: 34b0bcb5
+ HEX: 391c0cb3 HEX: 4ed8aa4a HEX: 5b9cca4f HEX: 682e6ff3
+ HEX: 748f82ee HEX: 78a5636f HEX: 84c87814 HEX: 8cc70208
+ HEX: 90befffa HEX: a4506ceb HEX: bef9a3f7 HEX: c67178f2
+ } ;
+
+: s0-256 ( x -- x' )
+ [ -7 bitroll-32 ] keep
+ [ -18 bitroll-32 ] keep
+ -3 shift bitxor bitxor ; inline
+
+: s1-256 ( x -- x' )
+ [ -17 bitroll-32 ] keep
+ [ -19 bitroll-32 ] keep
+ -10 shift bitxor bitxor ; inline
+
+: process-M-256 ( seq n -- )
+ [ 16 - swap nth ] 2keep
+ [ 15 - swap nth s0-256 ] 2keep
+ [ 7 - swap nth ] 2keep
+ [ 2 - swap nth s1-256 ] 2keep
+ >r >r + + w+ r> r> swap set-nth ; inline
+
+: prepare-message-schedule ( seq -- w-seq )
+ word-size get group [ be> ] map block-size get 0 pad-right
+ dup 16 64 dup <slice> [
+ process-M-256
+ ] with each ;
+
+: ch ( x y z -- x' )
+ [ bitxor bitand ] keep bitxor ;
+
+: maj ( x y z -- x' )
+ >r [ bitand ] 2keep bitor r> bitand bitor ;
+
+: S0-256 ( x -- x' )
+ [ -2 bitroll-32 ] keep
+ [ -13 bitroll-32 ] keep
+ -22 bitroll-32 bitxor bitxor ; inline
+
+: S1-256 ( x -- x' )
+ [ -6 bitroll-32 ] keep
+ [ -11 bitroll-32 ] keep
+ -25 bitroll-32 bitxor bitxor ; inline
+
+: T1 ( W n -- T1 )
+ [ swap nth ] keep
+ K get nth +
+ e vars get slice3 ch +
+ e vars get nth S1-256 +
+ h vars get nth w+ ;
+
+: T2 ( -- T2 )
+ a vars get nth S0-256
+ a vars get slice3 maj w+ ;
+
+: update-vars ( T1 T2 -- )
+ vars get
+ h g pick exchange
+ g f pick exchange
+ f e pick exchange
+ pick d pick nth w+ e pick set-nth
+ d c pick exchange
+ c b pick exchange
+ b a pick exchange
+ >r w+ a r> set-nth ;
+
+: process-chunk ( M -- )
+ H get clone vars set
+ prepare-message-schedule block-size get [
+ T1 T2 update-vars
+ ] with each vars get H get [ w+ ] 2map H set ;
+
+: seq>byte-array ( n seq -- string )
+ [ swap [ >be % ] curry each ] B{ } make ;
+
+: byte-array>sha2 ( byte-array -- string )
+ t preprocess-plaintext
+ block-size get group [ process-chunk ] each
+ 4 H get seq>byte-array ;
+
+PRIVATE>
+
+SINGLETON: sha-256
+
+INSTANCE: sha-256 checksum
+
+M: sha-256 checksum-bytes
+ drop [
+ K-256 K set
+ initial-H-256 H set
+ 4 word-size set
+ 64 block-size set
+ byte-array>sha2
+ ] with-scope ;
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
: w+ ( int int -- int ) + 32 bits ; inline
: update-old-new ( old new -- )
[ 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 ;
: seq>2seq ( seq -- seq1 seq2 )
: 2seq>seq ( seq1 seq2 -- seq )
#! { aceg } { bdfh } -> { abcdefgh }
- [ 2array flip concat ] keep like ;
+ [ zip concat ] keep like ;
: mod-nth ( n seq -- elt )
#! 5 "abcd" -> b
-USING: arrays combinators crypto.common crypto.md5 crypto.sha1
-crypto.md5.private io io.binary io.files io.streams.byte-array
-kernel math math.vectors memoize sequences io.encodings.binary ;
+USING: arrays combinators crypto.common checksums checksums.md5
+checksums.sha1 crypto.md5.private io io.binary io.files
+io.streams.byte-array kernel math math.vectors memoize sequences
+io.encodings.binary ;
IN: crypto.hmac
: sha1-hmac ( Ko Ki -- hmac )
+++ /dev/null
-Doug Coleman
+++ /dev/null
-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." } ;
+++ /dev/null
-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
-
+++ /dev/null
-! See http://www.faqs.org/rfcs/rfc1321.html
-
-USING: kernel io io.binary io.files io.streams.byte-array math
-math.functions math.parser namespaces splitting strings
-sequences crypto.common byte-arrays locals sequences.private
-io.encodings.binary symbols math.bitfields.lib ;
-IN: crypto.md5
-
-<PRIVATE
-
-SYMBOLS: a b c d old-a old-b old-c old-d ;
-
-: T ( N -- Y )
- sin abs 4294967296 * >bignum ; 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 s i k func a b c d -- )
- #! 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
-
-: ABCD a b c d (ABCD) ; inline
-: BCDA b c d a (ABCD) ; inline
-: CDAB c d a b (ABCD) ; inline
-: DABC d a b c (ABCD) ; inline
-
-: F ( X Y Z -- FXYZ )
- #! F(X,Y,Z) = XY v not(X) Z
- pick bitnot bitand [ bitand ] [ bitor ] bi* ;
-
-: G ( X Y Z -- GXYZ )
- #! G(X,Y,Z) = XZ v Y not(Z)
- dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
-
-: H ( X Y Z -- HXYZ )
- #! H(X,Y,Z) = X xor Y xor Z
- bitxor bitxor ;
-
-: I ( X Y Z -- IXYZ )
- #! I(X,Y,Z) = Y xor (X v not(Z))
- rot swap bitnot bitor bitxor ;
-
-: S11 7 ; inline
-: S12 12 ; inline
-: S13 17 ; inline
-: S14 22 ; inline
-: S21 5 ; inline
-: S22 9 ; inline
-: S23 14 ; inline
-: S24 20 ; inline
-: S31 4 ; inline
-: S32 11 ; inline
-: S33 16 ; inline
-: S34 23 ; inline
-: S41 6 ; inline
-: S42 10 ; inline
-: S43 15 ; inline
-: S44 21 ; inline
-
-: (process-md5-block-F)
- dup S11 1 0 [ F ] ABCD
- dup S12 2 1 [ F ] DABC
- dup S13 3 2 [ F ] CDAB
- dup S14 4 3 [ F ] BCDA
- dup S11 5 4 [ F ] ABCD
- dup S12 6 5 [ F ] DABC
- dup S13 7 6 [ F ] CDAB
- dup S14 8 7 [ F ] BCDA
- dup S11 9 8 [ F ] ABCD
- dup S12 10 9 [ F ] DABC
- dup S13 11 10 [ F ] CDAB
- dup S14 12 11 [ F ] BCDA
- dup S11 13 12 [ F ] ABCD
- dup S12 14 13 [ F ] DABC
- dup S13 15 14 [ F ] CDAB
- dup S14 16 15 [ F ] BCDA ;
-
-: (process-md5-block-G)
- dup S21 17 1 [ G ] ABCD
- dup S22 18 6 [ G ] DABC
- dup S23 19 11 [ G ] CDAB
- dup S24 20 0 [ G ] BCDA
- dup S21 21 5 [ G ] ABCD
- dup S22 22 10 [ G ] DABC
- dup S23 23 15 [ G ] CDAB
- dup S24 24 4 [ G ] BCDA
- dup S21 25 9 [ G ] ABCD
- dup S22 26 14 [ G ] DABC
- dup S23 27 3 [ G ] CDAB
- dup S24 28 8 [ G ] BCDA
- dup S21 29 13 [ G ] ABCD
- dup S22 30 2 [ G ] DABC
- dup S23 31 7 [ G ] CDAB
- dup S24 32 12 [ G ] BCDA ;
-
-: (process-md5-block-H)
- dup S31 33 5 [ H ] ABCD
- dup S32 34 8 [ H ] DABC
- dup S33 35 11 [ H ] CDAB
- dup S34 36 14 [ H ] BCDA
- dup S31 37 1 [ H ] ABCD
- dup S32 38 4 [ H ] DABC
- dup S33 39 7 [ H ] CDAB
- dup S34 40 10 [ H ] BCDA
- dup S31 41 13 [ H ] ABCD
- dup S32 42 0 [ H ] DABC
- dup S33 43 3 [ H ] CDAB
- dup S34 44 6 [ H ] BCDA
- dup S31 45 9 [ H ] ABCD
- dup S32 46 12 [ H ] DABC
- dup S33 47 15 [ H ] CDAB
- dup S34 48 2 [ H ] BCDA ;
-
-: (process-md5-block-I)
- dup S41 49 0 [ I ] ABCD
- dup S42 50 7 [ I ] DABC
- dup S43 51 14 [ I ] CDAB
- dup S44 52 5 [ I ] BCDA
- dup S41 53 12 [ I ] ABCD
- dup S42 54 3 [ I ] DABC
- dup S43 55 10 [ I ] CDAB
- dup S44 56 1 [ I ] BCDA
- dup S41 57 8 [ I ] ABCD
- dup S42 58 15 [ I ] DABC
- dup S43 59 6 [ I ] CDAB
- dup S44 60 13 [ I ] BCDA
- dup S41 61 4 [ I ] ABCD
- dup S42 62 11 [ I ] DABC
- dup S43 63 2 [ I ] CDAB
- dup S44 64 9 [ I ] BCDA ;
-
-: (process-md5-block) ( block -- )
- 4 <groups> [ le> ] map
-
- (process-md5-block-F)
- (process-md5-block-G)
- (process-md5-block-H)
- (process-md5-block-I)
-
- drop
-
- update-md ;
-
-: process-md5-block ( str -- )
- dup length [ bytes-read [ + ] change ] keep 64 = [
- (process-md5-block)
- ] [
- 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 ;
-
-: get-md5 ( -- str )
- [ a b c d ] [ get 4 >le ] map concat >byte-array ;
-
-PRIVATE>
-
-: stream>md5 ( stream -- byte-array )
- [ initialize-md5 (stream>md5) get-md5 ] with-stream ;
-
-: byte-array>md5 ( byte-array -- checksum )
- binary <byte-reader> stream>md5 ;
-
-: byte-array>md5str ( byte-array -- md5-string )
- byte-array>md5 hex-string ;
-
-: file>md5 ( path -- byte-array )
- binary <file-reader> stream>md5 ;
-
-: file>md5str ( path -- md5-string )
- file>md5 hex-string ;
+++ /dev/null
-Doug Coleman
+++ /dev/null
-USING: arrays kernel math namespaces sequences tools.test crypto.sha1 ;
-
-[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" byte-array>sha1str ] unit-test
-[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" byte-array>sha1str ] unit-test
-! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
-[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567"
-10 swap <array> concat byte-array>sha1str ] 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"
-] [
- "\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
-] unit-test
+++ /dev/null
-USING: arrays combinators crypto.common kernel io
-io.encodings.binary io.files io.streams.byte-array math.vectors
-strings sequences namespaces math parser sequences vectors
-io.binary hashtables symbols math.bitfields.lib ;
-IN: crypto.sha1
-
-! Implemented according to RFC 3174.
-
-SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
-
-: get-wth ( n -- wth ) w get nth ; inline
-: shift-wth ( n -- x ) get-wth 1 bitroll-32 ; inline
-
-: initialize-sha1 ( -- )
- 0 bytes-read set
- HEX: 67452301 dup h0 set A set
- HEX: efcdab89 dup h1 set B set
- HEX: 98badcfe dup h2 set C set
- HEX: 10325476 dup h3 set D set
- HEX: c3d2e1f0 dup h4 set E set
- [
- 20 HEX: 5a827999 <array> %
- 20 HEX: 6ed9eba1 <array> %
- 20 HEX: 8f1bbcdc <array> %
- 20 HEX: ca62c1d6 <array> %
- ] { } make K set ;
-
-! W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
-: sha1-W ( t -- W_t )
- dup 3 - get-wth
- over 8 - get-wth bitxor
- over 14 - get-wth bitxor
- swap 16 - get-wth bitxor 1 bitroll-32 ;
-
-! f(t;B,C,D) = (B AND C) OR ((NOT B) AND D) ( 0 <= t <= 19)
-! f(t;B,C,D) = B XOR C XOR D (20 <= t <= 39)
-! f(t;B,C,D) = (B AND C) OR (B AND D) OR (C AND D) (40 <= t <= 59)
-! f(t;B,C,D) = B XOR C XOR D (60 <= t <= 79)
-: sha1-f ( B C D t -- f_tbcd )
- 20 /i
- {
- { 0 [ >r over bitnot r> bitand >r bitand r> bitor ] }
- { 1 [ bitxor bitxor ] }
- { 2 [ 2dup bitand >r pick bitand >r bitand r> r> bitor bitor ] }
- { 3 [ bitxor bitxor ] }
- } case ;
-
-: make-w ( str -- )
- #! compute w, steps a-b of RFC 3174, section 6.1
- 16 [ nth-int-be w get push ] with each
- 16 80 dup <slice> [ sha1-W w get push ] each ;
-
-: init-letters ( -- )
- ! step c of RFC 3174, section 6.1
- h0 get A set
- h1 get B set
- h2 get C set
- h3 get D set
- h4 get E set ;
-
-: inner-loop ( n -- temp )
- ! TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
- [
- [ B get C get D get ] keep sha1-f ,
- dup get-wth ,
- K get nth ,
- A get 5 bitroll-32 ,
- E get ,
- ] { } make sum 32 bits ; inline
-
-: set-vars ( temp -- )
- ! E = D; D = C; C = S^30(B); B = A; A = TEMP;
- D get E set
- C get D set
- B get 30 bitroll-32 C set
- A get B set
- A set ;
-
-: calculate-letters ( -- )
- ! step d of RFC 3174, section 6.1
- 80 [ inner-loop set-vars ] each ;
-
-: update-hs ( -- )
- ! step e of RFC 3174, section 6.1
- A h0 update-old-new
- B h1 update-old-new
- C h2 update-old-new
- D h3 update-old-new
- E h4 update-old-new ;
-
-: (process-sha1-block) ( str -- )
- 80 <vector> w set make-w init-letters calculate-letters update-hs ;
-
-: process-sha1-block ( str -- )
- dup length [ bytes-read [ + ] change ] keep 64 = [
- (process-sha1-block)
- ] [
- t bytes-read get pad-last-block
- [ (process-sha1-block) ] each
- ] if ;
-
-: (stream>sha1) ( -- )
- 64 read [ process-sha1-block ] keep
- length 64 = [ (stream>sha1) ] when ;
-
-: get-sha1 ( -- str )
- [ [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each ] "" make ;
-
-: stream>sha1 ( stream -- sha1 )
- [ initialize-sha1 (stream>sha1) get-sha1 ] with-stream ;
-
-: byte-array>sha1 ( string -- sha1 )
- binary <byte-reader> stream>sha1 ;
-
-: byte-array>sha1str ( string -- str )
- byte-array>sha1 hex-string ;
-
-: byte-array>sha1-bignum ( string -- n )
- byte-array>sha1 be> ;
-
-: file>sha1 ( file -- sha1 )
- binary <file-reader> stream>sha1 ;
-
-: byte-array>sha1-interleave ( string -- seq )
- [ zero? ] left-trim
- dup length odd? [ rest ] when
- seq>2seq [ byte-array>sha1 ] bi@
- 2seq>seq ;
+++ /dev/null
-Doug Coleman
+++ /dev/null
-USING: arrays kernel math namespaces sequences tools.test crypto.sha2 ;
-[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ] [ "" byte-array>sha-256-string ] unit-test
-[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ] [ "abc" byte-array>sha-256-string ] unit-test
-[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ] [ "message digest" byte-array>sha-256-string ] unit-test
-[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ] [ "abcdefghijklmnopqrstuvwxyz" byte-array>sha-256-string ] unit-test
-[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" byte-array>sha-256-string ] unit-test
-[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" byte-array>sha-256-string ] unit-test
+++ /dev/null
-USING: crypto.common kernel splitting math sequences namespaces
-io.binary symbols math.bitfields.lib ;
-IN: crypto.sha2
-
-<PRIVATE
-
-SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
-
-: a 0 ; inline
-: b 1 ; inline
-: c 2 ; inline
-: d 3 ; inline
-: e 4 ; inline
-: f 5 ; inline
-: g 6 ; inline
-: h 7 ; inline
-
-: initial-H-256 ( -- seq )
- {
- HEX: 6a09e667 HEX: bb67ae85 HEX: 3c6ef372 HEX: a54ff53a
- HEX: 510e527f HEX: 9b05688c HEX: 1f83d9ab HEX: 5be0cd19
- } ;
-
-: K-256 ( -- seq )
- {
- HEX: 428a2f98 HEX: 71374491 HEX: b5c0fbcf HEX: e9b5dba5
- HEX: 3956c25b HEX: 59f111f1 HEX: 923f82a4 HEX: ab1c5ed5
- HEX: d807aa98 HEX: 12835b01 HEX: 243185be HEX: 550c7dc3
- HEX: 72be5d74 HEX: 80deb1fe HEX: 9bdc06a7 HEX: c19bf174
- HEX: e49b69c1 HEX: efbe4786 HEX: 0fc19dc6 HEX: 240ca1cc
- HEX: 2de92c6f HEX: 4a7484aa HEX: 5cb0a9dc HEX: 76f988da
- HEX: 983e5152 HEX: a831c66d HEX: b00327c8 HEX: bf597fc7
- HEX: c6e00bf3 HEX: d5a79147 HEX: 06ca6351 HEX: 14292967
- HEX: 27b70a85 HEX: 2e1b2138 HEX: 4d2c6dfc HEX: 53380d13
- HEX: 650a7354 HEX: 766a0abb HEX: 81c2c92e HEX: 92722c85
- HEX: a2bfe8a1 HEX: a81a664b HEX: c24b8b70 HEX: c76c51a3
- HEX: d192e819 HEX: d6990624 HEX: f40e3585 HEX: 106aa070
- HEX: 19a4c116 HEX: 1e376c08 HEX: 2748774c HEX: 34b0bcb5
- HEX: 391c0cb3 HEX: 4ed8aa4a HEX: 5b9cca4f HEX: 682e6ff3
- HEX: 748f82ee HEX: 78a5636f HEX: 84c87814 HEX: 8cc70208
- HEX: 90befffa HEX: a4506ceb HEX: bef9a3f7 HEX: c67178f2
- } ;
-
-: s0-256 ( x -- x' )
- [ -7 bitroll-32 ] keep
- [ -18 bitroll-32 ] keep
- -3 shift bitxor bitxor ; inline
-
-: s1-256 ( x -- x' )
- [ -17 bitroll-32 ] keep
- [ -19 bitroll-32 ] keep
- -10 shift bitxor bitxor ; inline
-
-: process-M-256 ( seq n -- )
- [ 16 - swap nth ] 2keep
- [ 15 - swap nth s0-256 ] 2keep
- [ 7 - swap nth ] 2keep
- [ 2 - swap nth s1-256 ] 2keep
- >r >r + + w+ r> r> swap set-nth ; inline
-
-: prepare-message-schedule ( seq -- w-seq )
- word-size get group [ be> ] map block-size get 0 pad-right
- dup 16 64 dup <slice> [
- process-M-256
- ] with each ;
-
-: ch ( x y z -- x' )
- [ bitxor bitand ] keep bitxor ;
-
-: maj ( x y z -- x' )
- >r [ bitand ] 2keep bitor r> bitand bitor ;
-
-: S0-256 ( x -- x' )
- [ -2 bitroll-32 ] keep
- [ -13 bitroll-32 ] keep
- -22 bitroll-32 bitxor bitxor ; inline
-
-: S1-256 ( x -- x' )
- [ -6 bitroll-32 ] keep
- [ -11 bitroll-32 ] keep
- -25 bitroll-32 bitxor bitxor ; inline
-
-: T1 ( W n -- T1 )
- [ swap nth ] keep
- K get nth +
- e vars get slice3 ch +
- e vars get nth S1-256 +
- h vars get nth w+ ;
-
-: T2 ( -- T2 )
- a vars get nth S0-256
- a vars get slice3 maj w+ ;
-
-: update-vars ( T1 T2 -- )
- vars get
- h g pick exchange
- g f pick exchange
- f e pick exchange
- pick d pick nth w+ e pick set-nth
- d c pick exchange
- c b pick exchange
- b a pick exchange
- >r w+ a r> set-nth ;
-
-: process-chunk ( M -- )
- H get clone vars set
- prepare-message-schedule block-size get [
- T1 T2 update-vars
- ] with each vars get H get [ w+ ] 2map H set ;
-
-: seq>byte-array ( n seq -- string )
- [ swap [ >be % ] curry each ] B{ } make ;
-
-: byte-array>sha2 ( byte-array -- string )
- t preprocess-plaintext
- block-size get group [ process-chunk ] each
- 4 H get seq>byte-array ;
-
-PRIVATE>
-
-: byte-array>sha-256 ( string -- string )
- [
- K-256 K set
- initial-H-256 H set
- 4 word-size set
- 64 block-size set
- byte-array>sha2
- ] with-scope ;
-
-: byte-array>sha-256-string ( string -- hexstring )
- byte-array>sha-256 hex-string ;
{ $heading "Other features" }
{ $subsection "network-streams" }
{ $subsection "io.launcher" }
-{ $subsection "io.timeouts" } ;
+{ $subsection "io.timeouts" }
+{ $subsection "checksums" } ;
ARTICLE: "tools" "Developer tools"
{ $subsection "tools.vocabs" }
! Copyright (C) 2008 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: kernel accessors random math.parser locals\r
-sequences math crypto.sha2 ;\r
+sequences math ;\r
IN: http.server.auth.providers\r
\r
TUPLE: user username realname password email ticket profile deleted changed? ;\r
USING: io.files kernel io.encodings.utf8 vocabs.loader vocabs\r
sequences namespaces math.parser arrays hashtables assocs\r
memoize inspector sorting splitting combinators source-files\r
-io debugger continuations compiler.errors init io.crc32 \r
-sets ;\r
+io debugger continuations compiler.errors init\r
+checksums checksums.crc32 sets ;\r
IN: tools.vocabs\r
\r
: vocab-tests-file ( vocab -- path )\r
dup source-files get at [\r
dup source-file-path\r
dup exists? [\r
- utf8 file-lines lines-crc32\r
+ utf8 file-lines crc32 checksum-lines\r
swap source-file-checksum = not\r
] [\r
2drop f\r
projects / factor.git / commitdiff