#SHA-256 in Perl
#
#Tom St Denis, tomstdenis@yahoo.com, http://tomstdenis.home.dhs.org
#
#
# Basically you can call the routines directly like
#
#
#        1.  sha_init($md);
#        2.  while (..) { sha_process($md, $data, $length); }
#        3.  $hash = sha_done($md);
#
#
# or you can call the routines [for text] directly such as
#
#            $hash = sha_memory_hex("hello")
#
# this returns the hex representation of the hash of the string "hello"
#
#

#state looks like
#
# 4 x 8    =>  state [8 32-bit words]              [0]
# length   =>  current message length (32-bits)    [32]
# curlen   =>  current buffer length (32-bits)     [36]
# buffer   =>  current buffer (64 bytes)           [40]
#


# /* Various logical functions */
sub sha_Ch     { return (($_[0] & $_[1]) ^ (($_[0] ^ 0xFFFFFFFF) & $_[2])) % (2**32); }
sub sha_Maj    { return (($_[0] & $_[1]) ^ ($_[0] & $_[2]) ^ ($_[1] & $_[2])) % (2**32); }
sub sha_S      { return (($_[0] >> $_[1]) | ($_[0] << (32 - $_[1]))) % (2**32); }
sub sha_R      { return ($_[0] >> $_[1]) % (2**32); }
sub sha_Sigma0 { return sha_S($_[0], 2) ^ sha_S($_[0], 13) ^ sha_S($_[0], 22); }
sub sha_Sigma1 { return sha_S($_[0], 6) ^ sha_S($_[0], 11) ^ sha_S($_[0], 25); }
sub sha_Gamma0 { return sha_S($_[0], 7) ^ sha_S($_[0], 18) ^ sha_R($_[0], 3); }
sub sha_Gamma1 { return sha_S($_[0], 17) ^ sha_S($_[0], 19) ^ sha_R($_[0], 10); }

# /* the K array */
@sha_K = (
    0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b,
    0x59f111f1, 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01,
    0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7,
    0xc19bf174, 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc,
    0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, 0x983e5152,
    0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147,
    0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc,
    0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85,
    0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819,
    0xd6990624, 0xf40e3585, 0x106aa070, 0x19a4c116, 0x1e376c08,
    0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f,
    0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208,
    0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2
);

# sha_compress(state)
sub sha_compress {
    my($W, $S, $i) = (0, 0, 0);

    # copy state locally
    for ($i = 0; $i < 8; $i++) { $S[$i] = vec($_[0], $i, 32); }
   
    # copy buffer into W[0..15]
    for ($i = 0; $i < 16; $i++) {
        $W[$i] = (vec($_[0], ($i*4)+40, 8) << 24) | (vec($_[0], ($i*4)+41, 8) << 16) | 
                 (vec($_[0], ($i*4)+42, 8) << 8) | (vec($_[0], ($i*4)+43, 8));
    }

    # fill W[16..63]
    for ($i = 16; $i < 64; $i++) {
        $W[$i] = (sha_Gamma1($W[$i - 2]) + $W[$i - 7] + sha_Gamma0($W[$i - 15]) + $W[$i - 16]) % (2**32);
    }

    for ($i = 0; $i < 64; $i++) {
        $t0 = ($S[7] + sha_Sigma1($S[4]) + sha_Ch($S[4], $S[5], $S[6]) + $sha_K[$i] + $W[$i]) % (2**32);
        $t1 = (sha_Sigma0($S[0]) + sha_Maj($S[0], $S[1], $S[2])) % (2**32);
        $S[7] = $S[6];
        $S[6] = $S[5];
        $S[5] = $S[4];
        $S[4] = ($S[3] + $t0) % (2**32);
        $S[3] = $S[2];
        $S[2] = $S[1];
        $S[1] = $S[0];
        $S[0] = ($t0 + $t1) % (2**32);
    }

    #feedback
    for ($i = 0; $i < 8; $i++) { 
        vec($_[0], $i, 32) = ($S[$i] + vec($_[0], $i, 32)) % (2**32);
    }
}

# sha_init(state)
sub sha_init {
    # zero state 
    for (my($i) = 0; $i < 104; $i++) { vec($_[0], $i, 8) = 0; }

    # set 8 32-bit words 
    vec($_[0], 0, 32) = 0x6A09E667;
    vec($_[0], 1, 32) = 0xBB67AE85;
    vec($_[0], 2, 32) = 0x3C6EF372;
    vec($_[0], 3, 32) = 0xA54FF53A;
    vec($_[0], 4, 32) = 0x510E527F;
    vec($_[0], 5, 32) = 0x9B05688C;
    vec($_[0], 6, 32) = 0x1F83D9AB;
    vec($_[0], 7, 32) = 0x5BE0CD19;
}

# sha_process(state, buf, length)
sub sha_process {
    my($len) = $_[2];
    my($i)   = 0;
    while ($len--) {
        vec($_[0],40+vec($_[0],9,32)++,8) = vec($_[1], $i++, 8);
        if (vec($_[0], 9, 32) == 64) {
           sha_compress($_[0]);
           vec($_[0], 9, 32) = 0;
           vec($_[0], 8, 32) += 512;
        }
    }
}

# sha_done(state)
sub sha_done {
    # increase current length to include incomplete packets
    vec($_[0], 8, 32) += vec($_[0], 9, 32) * 8;
 
    # append a 1 bit
    vec($_[0],40+vec($_[0],9,32)++,8) = 0x80;
  
    # if length is above 56 bytes we append zeroes and compress then fall back
    if (vec($_[0],9,32) >= 56) { 
       for (; vec($_[0],9,32) < 64; ) {
           vec($_[0],40+vec($_[0],9,32)++,8) = 0;
       }
       sha_compress($_[0]);
       vec($_[0],9,32) = 0;
    }

    # pad upto 56+4 [since the size is always 2^32 bits or less] bytes of zeroes
    for (; vec($_[0],9,32) < 60; ) {
       vec($_[0],40+vec($_[0],9,32)++,8) = 0;
    }

    # append length
    for (my($i) = 60; $i < 64; $i++) { 
        vec($_[0],40+$i,8) = ((vec($_[0], 8, 32) >> ((63 - $i) * 8))) & 255;
    }
    sha_compress($_[0]);    

    my($res) = 0;
    for ($i = 0; $i < 32; $i++) {
        vec($res, $i, 8) = (vec($_[0], $i>>2, 32) >> (((3 - $i) & 3) * 8)) & 255;
    }
    return $res;
}

# sha_memory(buf)
sub sha_memory {
   my($md) = 0;
   sha_init($md);
   sha_process($md, $_[0], length($_[0]));
   return sha_done($md);
}

# sha_memory_hex(buf)
sub sha_memory_hex {
   my($tmp) = sha_memory($_[0]);
   my($res) = "";
   my($i)   = 0;
   for ($i = 0; $i < 32; $i++) { $res = $res . sprintf("%02x", vec($tmp, $i, 8)); }
   return $res;
}