libs/sha1.f

   1 \ ANEW --Sha-1--                                \  Wil Baden  1999-08-19
   2
   3 \  *********************************************************************
   4 \  *                                                                   *
   5 \  *      SHA-1 Secure Hash Algorithm                                  *
   6 \  *                                                                   *
   7 \  *  SHA-INIT            ( -- )                                       *
   8 \  *     Initialize the secure hash algorithm.                         *
   9 \  *                                                                   *
  10 \  *  SHA-UPDATE          ( str len -- )                               *
  11 \  *     Update the algorithm for each text string.                    *
  12 \  *                                                                   *
  13 \  *  SHA-FINAL           ( -- )                                       *
  14 \  *     Complete the algorithm.                                       *
  15 \  *                                                                   *
  16 \  *  .SHA                ( -- )                                       *
  17 \  *     Display the message digest.                                   *
  18 \  *                                                                   *
  19 \  *  WARNING: Bit streams are not implemented.                        *
  20 \  *                                                                   *
  21 \  *********************************************************************
  22
  23 \  Although the complete message may be up to 2^64 bits long,
  24 \  the length argument must be less than 2^32 bytes at a time.
  25 \  This is not a problem yet (1999).
  26
  27 \  *********************************************************************
  28 \  *            Secure Hash Algorithm                                  *
  29 \  *********************************************************************
  30
  31 VOCABULARY SHA1
  32 ALSO SHA1 DEFINITIONS  \  Optional 3 of 5.
  33
  34 <hidden-words>
  35
  36 : THIRD  ( x y z -- x y z x )  2 PICK ;
  37 : 3dup   ( x y z -- x y z x y z )  THIRD THIRD THIRD ;
  38
  39 : Flip-Endian       ( 01020304 -- 04030201 )
  40     dup 24 LROTATE 0xFF00FF00 AND
  41     SWAP 8 LROTATE 0x00FF00FF AND OR ;
  42
  43 : HTYPE             ( addr len -- )
  44     BASE @ >R HEX  0 ?DO                           ( addr)
  45         dup I [ BASE C@ ] [IF]  3 XOR  [THEN] + C@
  46         0 <# # # #> TYPE
  47         I 1+ 4 MOD 0= IF SPACE THEN
  48     LOOP DROP  R> BASE ! ;
  49
  50 \  Message-Digest      ( -- addr )
  51 \     5 cell contents is computed as the secure hash.
  52
  53 \  Message-Block       ( -- addr )
  54 \     16 cell buffer for intermediate calculation.
  55
  56 \  SIZE                ( -- addr )
  57 \     Double-number variable for the intermediate size in bits of the
  58 \     message.
  59
  60 \  Final-Count         ( -- addr )
  61 \     Double-number variable for the final size in bits of the message.
  62
  63 \  Single-Byte         ( -- addr )
  64 \     Used when padding the message to a multiple of 512 bits.
  65
  66 CREATE Message-Digest   5 CELLS ALLOT  create;
  67
  68 CREATE Message-Block   16 CELLS ALLOT  create;
  69
  70 \ 2VARIABLE SIZE
  71 CREATE SIZE 2 CELLS ALLOT  create;
  72
  73 \ 2VARIABLE Final-Count
  74 CREATE Final-Count 2 CELLS ALLOT  create;
  75
  76 CREATE Single-Byte      0 C,  create;
  77
  78 \  `BLK0` and `BLK` treat the 16 cells of `Message-Block` as though
  79 \  they were the 80 cell expansion.  Used in `TRANSFORM`.
  80
  81 \  BLK0                ( i -- x )
  82 \     Convert the first 16 cells of `Message-Block` to `Work-Block`.
  83
  84 \  BLK                 ( i -- x )
  85 \     Convert the remaining cells of `Message-Block` to `Work-Block`.
  86
  87 BASE C@ [IF]              \  Little Endian
  88 : BLK0              ( i -- x )
  89   CELLS Message-Block + dup >R @ Flip-Endian dup R> ! ;
  90 [ELSE]                    \  Big Endian
  91 : BLK0              ( i -- x )
  92   CELLS Message-Block + @ ;
  93 [THEN]
  94
  95 : BLK               ( i -- x )
  96     dup  13 + 15 AND CELLS Message-Block + @
  97     over  8 + 15 AND CELLS Message-Block + @  XOR
  98     over  2 + 15 AND CELLS Message-Block + @  XOR
  99     over      15 AND CELLS Message-Block + @  XOR
 100     1 LROTATE  \  This operation was added for SHA-1.
 101     dup ROT  15 AND CELLS Message-Block + ! ;
 102
 103 \  `F  G  H`
 104 \     The nonlinear functions for scrambling the data.  The names are
 105 \     taken from A. J. Menezes, _Handbook of Applied Cryptography_,
 106 \     ISBN 0-8493-8523-7.  Used in `TRANSFORM`.
 107
 108 \ MIX
 109 \     The unchanging part of the scrambling.  Used in `TRANSFORM`.
 110
 111 : F                 ( d c b -- bc or b'd )
 112     dup >R AND SWAP R> INVERT AND OR ;
 113
 114 : G                 ( d c b -- bc or bd or cd )
 115     2dup AND >R  OR AND R>  OR ;
 116
 117 : H                 ( d c b -- d xor c xor b )
 118     XOR XOR ;
 119
 120 : MIX               ( e d c b temp a m -- e d c b a )
 121     \  temp = temp + (m + (a <<< 5)) + e
 122     SWAP dup >R                 ( e d c b temp m a)( R: a)
 123     5 LROTATE + +               ( e d c b temp)    ( R: a)
 124     SWAP >R  SWAP >R  SWAP >R   ( e temp)    ( R: a b c d)
 125     +                           ( temp)      ( R: a b c d)
 126     \  e = d
 127        R> SWAP                  ( e temp)      ( R: a b c)
 128     \  d = c
 129        R> SWAP                  ( e d temp)      ( R: a b)
 130     \  c = (b <<< 30)
 131        R> 30 LROTATE            ( e d temp c)      ( R: a)
 132        SWAP                     ( e d c temp)      ( R: a)
 133     \  b = a
 134        R>                       ( e d c temp b)     ( R: )
 135     \  a = temp
 136        SWAP                     ( e d c b a)
 137     ;
 138
 139 \  Fetch-Message-Digest   ( -- e d c b a )
 140 \     Fetch the values from Message-Digest. Used in `TRANSFORM`.
 141
 142 \  Add-to-Message-Digest  ( e d c b a -- )
 143 \     Accumulate into Message-Digest.  Used in `TRANSFORM`.
 144
 145 \  TRANSFORM              ( -- )
 146 \     Hash the 512 bits of `Message-Block` into the cells of
 147 \     `Message-Digest`.  Does 80 rounds of complicated processing for
 148 \     each 512 bits.  Used in `SHA-UPDATE`.
 149
 150     : Fetch-Message-Digest   ( -- e d c b a )
 151         4 CELLS Message-Digest +       ( addr)
 152             dup @ SWAP 1 CELLS -       ( e addr)
 153             dup @ SWAP 1 CELLS -       ( e d addr)
 154             dup @ SWAP 1 CELLS -       ( e d c addr)
 155             dup @ SWAP 1 CELLS -       ( e d c b addr)
 156                 @ ;                    ( e d c b a)
 157
 158     : Add-to-Message-Digest  ( e d c b a -- )
 159         Message-Digest                 ( e d c b a addr)
 160             TUCK +! CELL+              ( e d c b addr)
 161             TUCK +! CELL+              ( e d c addr)
 162             TUCK +! CELL+              ( e d addr)
 163             TUCK +! CELL+              ( e addr)
 164                  +! ;                  ( )
 165
 166 : TRANSFORM         ( -- )
 167     Fetch-Message-Digest    ( e d c b a)
 168
 169     \  Do 80 Rounds of Complicated Processing.
 170     16  0 DO  >R  3dup F  0x5A827999 +  R>  I BLK0  MIX  LOOP
 171     20 16 DO  >R  3dup F  0x5A827999 +  R>  I BLK   MIX  LOOP
 172     40 20 DO  >R  3dup H  0x6ED9EBA1 +  R>  I BLK   MIX  LOOP
 173     60 40 DO  >R  3dup G  0x8F1BBCDC +  R>  I BLK   MIX  LOOP
 174     80 60 DO  >R  3dup H  0xCA62C1D6 +  R>  I BLK   MIX  LOOP
 175
 176     Add-to-Message-Digest ;
 177
 178 \  **********  SHA-INIT   SHA-UPDATE   SHA-FINAL   .SHA  **********
 179 <public-words>
 180
 181 : Sha-Init          ( -- )
 182     \  Initialize Message-Digest with starting constants.
 183     Message-Digest
 184         0x67452301 over !  CELL+
 185         0xEFCDAB89 over !  CELL+
 186         0x98BADCFE over !  CELL+
 187         0x10325476 over !  CELL+
 188         0xC3D2E1F0 over !  DROP
 189     \  Zero bit count.
 190     0 0 SIZE 2! ;
 191
 192 : Sha-Update        ( str len -- )
 193     \  Transform 512-bit blocks of message.
 194     BEGIN        \  Transform Message-Block?
 195         SIZE CELL+ @  511 AND  3 RSHIFT  >R  64 R@ -  over U> NOT
 196     WHILE        \  Store some of str&len, and transform.
 197         2dup  64 R@ -  /STRING  dup >R  2SWAP  R> -
 198             Message-Block R@ + SWAP MOVE
 199         TRANSFORM
 200         SIZE 2@  64 R> -  3 LSHIFT  M+  SIZE 2!
 201     REPEAT
 202     \  Save final fraction of input.
 203     Message-Block   R> +  SWAP  dup >R  MOVE  ( )
 204     SIZE 2@  R> 0  D2* D2* D2* D+  SIZE 2! ;
 205
 206 : Sha-Final         ( -- )
 207     \  Save SIZE for final padding.
 208     SIZE 2@
 209     [ BASE C@ ] [IF]       \  Little-endian to big-endian.
 210         Flip-Endian  SWAP  Flip-Endian  SWAP
 211     [THEN]
 212     Final-Count 2!
 213
 214     \  Pad so SIZE is 64 bits less than a multiple of 512.
 215     Single-Byte  0x80  over C!  1 Sha-Update
 216     BEGIN  SIZE CELL+ @  511 AND  448 = NOT WHILE
 217         Single-Byte  0 over C!  1 Sha-Update
 218     REPEAT
 219
 220     Final-Count 8  Sha-Update ;
 221
 222 : .SHA
 223     Message-Digest 20 HTYPE   \  Display Message-Digest.
 224     ;
 225
 226 PREVIOUS DEFINITIONS