From db8fd1cc50d77453b872c505b3f1d17264de7db1 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@trifocus.net>
Date: Mon, 19 Sep 2005 00:19:59 +0000
Subject: [PATCH] sha1 refactoring string>md5 now gives a binary string. the
 old string>md5 is now string>md5str

---
 contrib/crypto/md5.factor  | 19 +++++++-----
 contrib/crypto/sha1.factor | 61 +++++++++++++++++---------------------
 2 files changed, 39 insertions(+), 41 deletions(-)

diff --git a/contrib/crypto/md5.factor b/contrib/crypto/md5.factor
index 17762e86f7..49213ddeb0 100644
--- a/contrib/crypto/md5.factor
+++ b/contrib/crypto/md5.factor
@@ -145,7 +145,7 @@ SYMBOL: old-d
     drop ;
 
 : get-md5 ( -- str )
-    [ [ a b c d ] [ get 4 >le % ] each ] "" make hex-string ;
+    [ [ a b c d ] [ get 4 >le % ] each ] "" make ;
 
 : string>md5 ( string -- md5 )
     [
@@ -154,16 +154,19 @@ SYMBOL: old-d
         drop get-md5
     ] with-scope ;
 
+: string>md5str ( string -- str )
+    string>md5 hex-string ;
+
 : stream>md5 ( stream -- md5 ) contents string>md5 ;
 
 : file>md5 ( file -- md5 ) <file-reader> stream>md5 ;
 
 : test-md5 ( -- )
-    [ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" string>md5 ] unit-test
-    [ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" string>md5 ] unit-test
-    [ "900150983cd24fb0d6963f7d28e17f72" ] [ "abc" string>md5 ] unit-test
-    [ "f96b697d7cb7938d525a2f31aaf161d0" ] [ "message digest" string>md5 ] unit-test
-    [ "c3fcd3d76192e4007dfb496cca67e13b" ] [ "abcdefghijklmnopqrstuvwxyz" string>md5 ] unit-test
-    [ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" string>md5 ] unit-test
-    [ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" string>md5 ] unit-test
+    [ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" string>md5str ] unit-test
+    [ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" string>md5str ] unit-test
+    [ "900150983cd24fb0d6963f7d28e17f72" ] [ "abc" string>md5str ] unit-test
+    [ "f96b697d7cb7938d525a2f31aaf161d0" ] [ "message digest" string>md5str ] unit-test
+    [ "c3fcd3d76192e4007dfb496cca67e13b" ] [ "abcdefghijklmnopqrstuvwxyz" string>md5str ] unit-test
+    [ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" string>md5str ] unit-test
+    [ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" string>md5str ] unit-test
     ;
diff --git a/contrib/crypto/sha1.factor b/contrib/crypto/sha1.factor
index f04c0ead47..d01a15d7d5 100644
--- a/contrib/crypto/sha1.factor
+++ b/contrib/crypto/sha1.factor
@@ -92,26 +92,26 @@ SYMBOL: K
     h3 get D set
     h4 get E set ;
 
+: (inner-loop) ( -- )
+    ! 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 ,
+        dup K get nth ,
+        A get 5 32 bitroll ,
+        E get ,
+    ] { } make sum 4294967295 bitand ; inline
+
+: (set-vars) ( -- )
+    ! E = D;  D = C;  C = S^30(B);  B = A; A = TEMP;
+    D get E set
+    C get D set
+    B get 30 32 bitroll C set
+    A get B set ;
+
 : calculate-letters ( -- )
     ! step d of RFC 3174, section 6.1
-    80 [
-        ! 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 ,
-            dup K get nth ,
-            A get 5 32 bitroll ,
-            E get ,
-        ] { } make sum 4294967296 mod
-
-        ! E = D;  D = C;  C = S^30(B);  B = A; A = TEMP;
-        >r
-        D get E set
-        C get D set
-        B get 30 32 bitroll C set
-        A get B set
-        r> A set
-    ] repeat ;
+    80 [ (inner-loop) >r (set-vars) r> A set ] repeat ;
 
 : update-hs ( -- )
     ! step e of RFC 3174, section 6.1
@@ -125,9 +125,7 @@ SYMBOL: K
     make-w init-letters calculate-letters update-hs drop ;
 
 : get-sha1 ( -- str )
-    [
-        [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each
-    ] "" make hex-string ;
+    [ [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each ] "" make ;
 
 : string>sha1 ( string -- sha1 )
     [
@@ -136,20 +134,17 @@ SYMBOL: K
         drop get-sha1
     ] with-scope ;
 
-: stream>sha1 ( stream -- sha1 )
-    [
-        contents string>sha1
-    ] with-scope ;
+: string>sha1str ( string -- sha1str )
+    string>sha1 hex-string ;
 
-: file>sha1 ( file -- sha1 )
-    [
-        <file-reader> stream>sha1
-    ] with-scope ;
+: stream>sha1 ( stream -- sha1 ) contents string>sha1 ;
+
+: file>sha1 ( file -- sha1 ) <file-reader> stream>sha1 ;
 
 ! unit test from the RFC
 : test-sha1 ( -- )
-    [ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" string>sha1 ] unit-test
-    [ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" string>sha1 ] unit-test
-    ! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1 ] unit-test ! takes a long time...
-    [ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567" [ 10 [ dup % ] times ] "" make nip string>sha1 ] unit-test ;
+    [ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" string>sha1str ] unit-test
+    [ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" string>sha1str ] unit-test
+    ! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
+    [ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567" [ 10 [ dup % ] times ] "" make nip string>sha1str ] unit-test ;