diff --git a/contrib/crypto/common.factor b/contrib/crypto/common.factor index f9c0ba2f48..dfde878ab2 100644 --- a/contrib/crypto/common.factor +++ b/contrib/crypto/common.factor @@ -10,23 +10,15 @@ USING: kernel io strings sequences namespaces math parser ; : update-old-new ( old new -- ) [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline -! calculate pad length. leave 8 bytes for length after padding -: zero-pad-length ( length -- pad-length ) - dup 56 < 55 119 ? swap - ; ! one less for first byte of padding 0x80 +: calculate-pad-length ( length -- pad-length ) + dup 56 < 55 119 ? swap - ; ! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits -: pad-string-md5 ( string -- padded-string ) - [ +: preprocess-plaintext ( string big-endian? -- padded-string ) + swap [ dup % HEX: 80 , - dup length HEX: 3f bitand zero-pad-length 0 % - dup length 3 shift 8 >le % - ] "" make nip ; - -: pad-string-sha1 ( string -- padded-string ) - [ - dup % HEX: 80 , - dup length HEX: 3f bitand zero-pad-length 0 % - dup length 3 shift 8 >be % + dup length HEX: 3f bitand calculate-pad-length 0 % + dup length 3 shift 8 >r rot r> swap [ >be ] [ >le ] if % ] "" make nip ; : num-blocks ( length -- num ) -6 shift ; diff --git a/contrib/crypto/md5.factor b/contrib/crypto/md5.factor index d78e7bb11d..f199c27258 100644 --- a/contrib/crypto/md5.factor +++ b/contrib/crypto/md5.factor @@ -156,7 +156,7 @@ SYMBOL: old-d IN: crypto : string>md5 ( string -- md5 ) [ - initialize-md5 pad-string-md5 + initialize-md5 f preprocess-plaintext dup length num-blocks [ 2dup get-block process-md5-block ] repeat drop get-md5 ] with-scope ; diff --git a/contrib/crypto/sha1.factor b/contrib/crypto/sha1.factor index a3d62d75a2..76bfd790d0 100644 --- a/contrib/crypto/sha1.factor +++ b/contrib/crypto/sha1.factor @@ -130,7 +130,7 @@ SYMBOL: K IN: crypto : string>sha1 ( string -- sha1 ) [ - initialize-sha1 pad-string-sha1 + initialize-sha1 t preprocess-plaintext dup length num-blocks [ reset-w 2dup get-block process-sha1-block ] repeat drop get-sha1 ] with-scope ;