ANEW --Sha-1--                                \  Wil Baden  1999-08-19

\  *********************************************************************
\  *                                                                   *
\  *      SHA-1 Secure Hash Algorithm                                  *
\  *                                                                   *
\  *  SHA-INIT            ( -- )                                       *
\  *     Initialize the secure hash algorithm.                         *
\  *                                                                   *
\  *  SHA-UPDATE          ( str len -- )                               *
\  *     Update the algorithm for each text string.                    *
\  *                                                                   *
\  *  SHA-FINAL           ( -- )                                       *
\  *     Complete the algorithm.                                       *
\  *                                                                   *
\  *  .SHA                ( -- )                                       *
\  *     Display the message digest.                                   *
\  *                                                                   *
\  *  WARNING: Bit streams are not implemented.                        *
\  *                                                                   *
\  *********************************************************************

\  Although the complete message may be up to 2^64 bits long,
\  the length argument must be less than 2^32 bytes at a time.
\  This is not a problem yet (1999).

\    Environmental dependencies:

\    `1 CHARS`  is an 8-bit address unit.
\    `1 CELLS`  is 4.
\    Two's complement arithmetic.

\  Secure Hash Algorithm-1 (SHA-1)

\    A one-way cryptographic function which takes a message of less
\    than 18 quintillion (18,446,744,073,709,551,616) bits in length
\    and produces a 160-bit message digest. A message digest is a
\    value generated for a message or document that is unique to that
\    message, and is sometimes referred to as a "fingerprint" of that
\    message or data. Once a message digest is computed, any
\    subsequent change to the original data will, with a very high
\    probability, cause a change in the message digest, and the
\    signature will fail to verify. This process is used to compress
\    large data strings to a 20-byte length which is used in a
\    cryptographic process. The reduced data length relieves
\    computational requirements for data encryption. SHA-1 provides
\    greater security than the original Secure Hash Algorithm (SHA),
\    which had security flaws.

\  NIST and NSA designed the Secure Hash Algorithm for Standard
\  Digital Signatures and for whenever a secure hash algorithm is
\  required for Federal applications.

\  The _Federal Register_ says:

\    This Standard specifies a Secure Hash Algorithm (SHA), which is
\    necessary to ensure the security of the Digital Signature
\    Algorithm (DSA).  When a message of any length < 2^64 bits is
\    input, the SHA produces a 160-bit output called a message
\    digest. The message digest is then input to the DSA, which
\    computes the signature for the message.  Signing the message
\    digest rather than the message often improves the efficiency of
\    the process, because the message digest is usually much smaller
\    than the message.  The same message digest should be obtained by
\    the verifier of the signature when the received version of the
\    message is used as input to SHA.  The SHA is called secure
\    because it is designed to be computationally infeasible to
\    recover a message corresponding to a given message digest or to
\    find two different messages [that] produce the same message
\    digest. Any change to a message in transit will, with a very
\    high probability, result in a different message digest, and the
\    signature will fail to verify.

\  <cite>Bruce Schneier, Applied Cryptography, ISBN 0-471-11709-9</cite>

\  As an example, here are the message digests for "A" and "a".

\      6DCD4CE2 3D88E2EE 9568BA54 6C007C63 D9131C1B
\      86F7E437 FAA5A7FC E15D1DDC B9EAEAEA 377667B8

\  The algorithm is initialized by setting the message digest to
\  starting values.  The starting values are 5 constants, each with
\  unique values in its nybbles.

\  The input will be padded up to a multiple of 512 bits, with the
\  number of bits in the input at the end as 64 bits in big endian
\  form.  In between, the padding is a 1-bit followed by enough
\  0-bits.

\  Every 512 bits of input gets mangled and combined into the message
\  digest.

\  This is done by 80 rounds of complicated processing for every 512
\  bits.

\  There are four different kinds of rounds.  `Function[i]` and
\  `Constant[i]` are different for each kind of round.  The algorithm
\  specifies that the 16-cell `Message-Block` should first be
\  transformed to an 80-cell `Work-Block` by the following algorithm
\  (coded here in Forth):

\      16  0 DO  I nth Message-Block @  I nth Work-Block !  LOOP
\      80 16 DO
\          I  3 - nth Message-Block @        ( x)
\          I  8 - nth Message-Block @  XOR
\          I 14 - nth Message-Block @  XOR
\          I 16 - nth Message-Block @  XOR
\          1 LROTATE
\          I nth Work-Block !                ( )
\      LOOP

\  where: `nth aword` is `CELLS aword +`

\  The functions `BLK0` and `BLK` accomplish the effect without
\  needing a separate `Work-Block`. `BLK0` also takes care of turning
\  little endian to big endian when the environment arithmetic is
\  little endian. `BLK` recognizes that a `Work-Block` cell is made
\  out of cells from the previous 16 and so stores the cell into
\  itself.

\  A round looks like this (C style):

\      temp = (a <<< 5) + Function[i](b, c, d) + e +
\             Work[i] + Constant[i];
\      e = d;
\      d = c;
\      c = b <<< 30;
\      b = a;
\      a = temp;

\  where `<<<` is the operator for a circular left shift.

\  The `Function[]`s scramble the bits of three cells, and change
\  every 20 rounds.

\  The `Constant[]`s are 1/4 of squareroot of 2, 3, 5, and 10, times
\  2^32, changed every 20 rounds.

\  The program is for SHA revised, SHA-1.

\  Concepts from Schneier, Menezes, and Steve Reid's public domain C
\  implementation.

\  Reviewed by Jonah Thomas and Marcel Hendrix.  Tested by Marcel
\  Hendrix.

\  Tested on PowerMacForth (big endian), SwiftForth, iForth, GForth,
\  Win32Forth, mxForth (little endian).

\          Elementary Tools

\  LROTATE             ( x n -- x' )
\     Circular left shift of a 32-bit cell.

\  Flip-Endian         ( n -- n' )
\     Convert between big-endian and little-endian
\     cells.  Used here to convert to big-endian.  Used in
\     `BLK0` and `SHA-FINAL`

\  HTYPE               ( addr len -- )
\     Displays a byte array in hex.  Used in `.SHA`.

TRUE 0= [IF]  \  Comment out what is already defined.

    : NOT    0= ;
    : THIRD  ( x y z -- x y z x )  2 PICK ;
    : 3dup   ( x y z -- x y z x y z )  THIRD THIRD THIRD ;

    : H#  ( "hexnumber" -- u )  \  Simplified for easy porting.
        0 0 PARSE-WORD                  ( 0 0 str len)
        BASE @ >R  HEX  >NUMBER  R> BASE !
            ABORT" Not Hex " 2DROP      ( u)
        STATE @ IF  postpone LITERAL  THEN
        ; IMMEDIATE

[THEN]

: LROTATE           ( x n -- x' )
    2dup  LSHIFT >R  32 SWAP -  RSHIFT R>  OR ;

: Flip-Endian       ( 01020304 -- 04030201 )
    dup 24 LROTATE H# FF00FF00 AND
    SWAP 8 LROTATE H# 00FF00FF AND OR ;

: HTYPE             ( addr len -- )
    BASE @ >R HEX  0 ?DO                           ( addr)
        dup I [ BASE C@ ] [IF]  3 XOR  [THEN] + C@
        0 <# # # #> TYPE
        I 1+ 4 MOD 0= IF SPACE THEN
    LOOP DROP  R> BASE ! ;

-? : .(  [char] ) Echo-Until ; IMMEDIATE

\                                                 \  Optional
\  `IMPLEMENTATION` and `INTERFACE`

\  For encapsulation, the subordinate functions of the Secure Hash
\  Algorithm are defined in the word list of a vocabulary.
\  Rudimentary definitions of `VOCABULARY` words are given (commented
\  out) for anyone who somehow does not have them.

\  INTERFACE           ( -- )
\     Introduce the end-user words of the algorithm.

TRUE 0= [IF]                                      \  Optional

    : VOCABULARY  ( "name" -- )  CREATE  WORDLIST ,  DOES>
        @ >R  GET-ORDER  NIP  R> SWAP  SET-ORDER ;

    : ALSO    ( -- )  GET-ORDER over SWAP 1+ SET-ORDER ;

    : PREVIOUS  ( -- )  GET-ORDER  NIP 1-  SET-ORDER ;

[THEN]

: INTERFACE  ( -- )                               \  Optional
    GET-ORDER  THIRD SET-CURRENT  SET-ORDER ;

\  *********************************************************************
\  *            Secure Hash Algorithm                                  *
\  *********************************************************************

VOCABULARY Secure-Hash-Algorithm   \  Optional 1 of 5.

ALSO Secure-Hash-Algorithm         \  Optional 2 of 5.

DEFINITIONS                        \  Optional 3 of 5.

\  Message-Digest      ( -- addr )
\     5 cell contents is computed as the secure hash.

\  Message-Block       ( -- addr )
\     16 cell buffer for intermediate calculation.

\  SIZE                ( -- addr )
\     Double-number variable for the intermediate size in bits of the
\     message.

\  Final-Count         ( -- addr )
\     Double-number variable for the final size in bits of the message.

\  Single-Byte         ( -- addr )
\     Used when padding the message to a multiple of 512 bits.

CREATE Message-Digest   5 CELLS ALLOT

CREATE Message-Block   16 CELLS ALLOT

2VARIABLE SIZE

2VARIABLE Final-Count

CREATE Single-Byte      0 C,

\  `BLK0` and `BLK` treat the 16 cells of `Message-Block` as though
\  they were the 80 cell expansion.  Used in `TRANSFORM`.

\  BLK0                ( i -- x )
\     Convert the first 16 cells of `Message-Block` to `Work-Block`.

\  BLK                 ( i -- x )
\     Convert the remaining cells of `Message-Block` to `Work-Block`.

BASE C@ [IF]              \  Little Endian
    : BLK0              ( i -- x )
        CELLS Message-Block + dup >R @ Flip-Endian dup R> ! ;
[ELSE]                    \  Big Endian
    : BLK0              ( i -- x )
        CELLS Message-Block + @ ;
[THEN]

: BLK               ( i -- x )
    dup  13 + 15 AND CELLS Message-Block + @
    over  8 + 15 AND CELLS Message-Block + @  XOR
    over  2 + 15 AND CELLS Message-Block + @  XOR
    over      15 AND CELLS Message-Block + @  XOR
    1 LROTATE  \  This operation was added for SHA-1.
    dup ROT  15 AND CELLS Message-Block + ! ;

\  `F  G  H`
\     The nonlinear functions for scrambling the data.  The names are
\     taken from A. J. Menezes, _Handbook of Applied Cryptography_,
\     ISBN 0-8493-8523-7.  Used in `TRANSFORM`.

\ MIX
\     The unchanging part of the scrambling.  Used in `TRANSFORM`.

: F                 ( d c b -- bc or b'd )
    dup >R AND SWAP R> INVERT AND OR ;

: G                 ( d c b -- bc or bd or cd )
    2dup AND >R  OR AND R>  OR ;

: H                 ( d c b -- d xor c xor b )
    XOR XOR ;

: MIX               ( e d c b temp a m -- e d c b a )
    \  temp = temp + (m + (a <<< 5)) + e
    SWAP dup >R                 ( e d c b temp m a)( R: a)
    5 LROTATE + +               ( e d c b temp)    ( R: a)
    SWAP >R  SWAP >R  SWAP >R   ( e temp)    ( R: a b c d)
    +                           ( temp)      ( R: a b c d)
    \  e = d
       R> SWAP                  ( e temp)      ( R: a b c)
    \  d = c
       R> SWAP                  ( e d temp)      ( R: a b)
    \  c = (b <<< 30)
       R> 30 LROTATE            ( e d temp c)      ( R: a)
       SWAP                     ( e d c temp)      ( R: a)
    \  b = a
       R>                       ( e d c temp b)     ( R: )
    \  a = temp
       SWAP                     ( e d c b a)
    ;

\  Fetch-Message-Digest   ( -- e d c b a )
\     Fetch the values from Message-Digest. Used in `TRANSFORM`.

\  Add-to-Message-Digest  ( e d c b a -- )
\     Accumulate into Message-Digest.  Used in `TRANSFORM`.

\  TRANSFORM              ( -- )
\     Hash the 512 bits of `Message-Block` into the cells of
\     `Message-Digest`.  Does 80 rounds of complicated processing for
\     each 512 bits.  Used in `SHA-UPDATE`.

    : Fetch-Message-Digest   ( -- e d c b a )
        4 CELLS Message-Digest +       ( addr)
            dup @ SWAP 1 CELLS -       ( e addr)
            dup @ SWAP 1 CELLS -       ( e d addr)
            dup @ SWAP 1 CELLS -       ( e d c addr)
            dup @ SWAP 1 CELLS -       ( e d c b addr)
                @ ;                    ( e d c b a)

    : Add-to-Message-Digest  ( e d c b a -- )
        Message-Digest                 ( e d c b a addr)
            TUCK +! CELL+              ( e d c b addr)
            TUCK +! CELL+              ( e d c addr)
            TUCK +! CELL+              ( e d addr)
            TUCK +! CELL+              ( e addr)
                 +! ;                  ( )

: TRANSFORM         ( -- )
    Fetch-Message-Digest    ( e d c b a)

    \  Do 80 Rounds of Complicated Processing.
    16  0 DO  >R  3dup F  H# 5A827999 +  R>  I BLK0  MIX  LOOP
    20 16 DO  >R  3dup F  H# 5A827999 +  R>  I BLK   MIX  LOOP
    40 20 DO  >R  3dup H  H# 6ED9EBA1 +  R>  I BLK   MIX  LOOP
    60 40 DO  >R  3dup G  H# 8F1BBCDC +  R>  I BLK   MIX  LOOP
    80 60 DO  >R  3dup H  H# CA62C1D6 +  R>  I BLK   MIX  LOOP

    Add-to-Message-Digest ;

\  **********  SHA-INIT   SHA-UPDATE   SHA-FINAL   .SHA  **********

INTERFACE                          \  Optional 4 of 5.

: Sha-Init          ( -- )
    \  Initialize Message-Digest with starting constants.
    Message-Digest
        H# 67452301 over !  CELL+
        H# EFCDAB89 over !  CELL+
        H# 98BADCFE over !  CELL+
        H# 10325476 over !  CELL+
        H# C3D2E1F0 over !  DROP
    \  Zero bit count.
    0. SIZE 2! ;

: Sha-Update        ( str len -- )
    \  Transform 512-bit blocks of message.
    BEGIN        \  Transform Message-Block?
        SIZE CELL+ @  511 AND  3 RSHIFT  >R  64 R@ -  over U> NOT
    WHILE        \  Store some of str&len, and transform.
        2dup  64 R@ -  /STRING  dup >R  2SWAP  R> -
            Message-Block R@ + SWAP MOVE
        TRANSFORM
        SIZE 2@  64 R> -  3 LSHIFT  M+  SIZE 2!
    REPEAT
    \  Save final fraction of input.
    Message-Block   R> +  SWAP  dup >R  MOVE  ( )
    SIZE 2@  R> 0  D2* D2* D2* D+  SIZE 2! ;

: Sha-Final         ( -- )
    \  Save SIZE for final padding.
    SIZE 2@
    [ BASE C@ ] [IF]       \  Little-endian to big-endian.
        Flip-Endian  SWAP  Flip-Endian  SWAP
    [THEN]
    Final-Count 2!

    \  Pad so SIZE is 64 bits less than a multiple of 512.
    Single-Byte  H# 80  over C!  1 Sha-Update
    BEGIN  SIZE CELL+ @  511 AND  448 = NOT WHILE
        Single-Byte  0 over C!  1 Sha-Update
    REPEAT

    Final-Count 8  Sha-Update ;

: .SHA
    Message-Digest 20 HTYPE   \  Display Message-Digest.
    ;

PREVIOUS DEFINITIONS                \  Optional 5 of 5.

\          Test Vectors from Menezes and FIPS

MARKER Test-Vectors

CR Sha-Init
   Sha-Final .( DA39A3EE 5E6B4B0D 3255BFEF 95601890 AFD80709 )
   CR .SHA CR

CR Sha-Init  S" a" Sha-Update
   Sha-Final .( 86F7E437 FAA5A7FC E15D1DDC B9EAEAEA 377667B8 )
   CR .SHA CR

CR Sha-Init  S" abc" Sha-Update
   Sha-Final .( A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D )
   CR .SHA CR

CR Sha-Init  S" abcdefghijklmnopqrstuvwxyz" Sha-Update
   Sha-Final .( 32D10C7B 8CF96570 CA04CE37 F2A19D84 240D3A89 )
   CR .SHA CR

CR Sha-Init
   S" abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
      Sha-Update
   Sha-Final .( 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1 )
   CR .SHA CR

\  A million repetitions of "a".

: HACK              ( -- )
    Sha-Init
    1000000 0 DO
        S" aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
            Sha-Update
    50 +LOOP
    Sha-Final ;

CR  .( 34AA973C D4C4DAA4 F61EEB2B DBAD2731 6534016F )
CR HACK .SHA CR

( End ) Test-Vectors

\\  **************************  End of SHA1  *************************