(* SHA1 secure hash.
   Copyright (C) 2003 Jean Goubault-Larrecq and LSV, CNRS UMR 8643 & ENS Cachan.

   This file is part of h1.

   h1 is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   h1 is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with h1; see the file COPYING.  If not, write to
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*)

open "sha_h";

local
    fun f1 (x,y,z) = bxor (z, band (x, bxor (y, z))) (* bor (band (x, y), band (bnot x, z)) *)
    fun f2 (x,y,z) = bxor (x, bxor (y, z))
    fun f3 (x,y,z) = bor (band (x, y), band (z, bor (x, y))) (* bor (band (x, y), bor (band (x, z), band (y, z))) *)

    val fs = [|fn _ => 0, f1, f2, f3, f2|];
    val consts = [|0,
		   0x5a827999,
		   0x6ed9eba1,
		   0x8f1bbcdc,
		   0xca62c1d6
		 |]

    fun rot32(x,n) = bor (lsl (x,n), lsr (x,32-n))
in
    fun sha_init () =
	SHA_INFO ([|0x67452301,
		    0xefcdab89,
		    0x98badcfe,
		    0x10325476,
		    0xc3d2e1f0
		  |],
		    ref 0,
		    ref 0,
		    array (64, 0))

    fun sha_transform (SHA_INFO (digest, _, _, data)) =
	let val W = array (80, 0)
	    val i = ref 0
	    val A = ref (digest.(0))
	    val B = ref (digest.(1))
	    val C = ref (digest.(2))
	    val D = ref (digest.(3))
	    val E = ref (digest.(4))
	    fun FUNC n =
		let val f = sub (fs, n)
		    val c = sub (consts, n)
		in
		    fn i =>
		    let val temp = rot32(!A,5) + f (!B, !C, !D) + !E + sub (W, i) + c
		    in
			E := !D;
			D := !C;
			C := rot32(!B, 30);
			B := !A;
			A := temp
		    end
		end
	in
	    while !i<16 do
		let val j = 4 * !i
		in
		    W.(!i) .:= bor (lsl (data.(j), 24),
				    bor (lsl (data.(j+1), 16),
					 bor (lsl (data.(j+2), 8),
					      data.(j+3))));
		    inc i
		end;
		while !i<80 do
		    (W.(!i) .:= bxor (W.(!i-3),
				      bxor (W.(!i-8),
					    bxor (W.(!i-14),
						  W.(!i-16))));
		     inc i);
		    (* Modified SHA: replace the latter by
		     W.(!i) .:= rot32(W.(!i), 1) *)
		    i := 0;
		    let val F = FUNC 1
		    in
			while !i<20 do (F (!i); inc i)
		    end;
		    let val F = FUNC 2
		    in
			while !i<40 do (F (!i); inc i)
		    end;
		    let val F = FUNC 3
		    in
			while !i<60 do (F (!i); inc i)
		    end;
		    let val F = FUNC 4
		    in
			while !i<80 do (F (!i); inc i)
		    end;
		    digest.(0) .:= digest.(0) + !A;
		    digest.(1) .:= digest.(1) + !A;
		    digest.(2) .:= digest.(2) + !A;
		    digest.(3) .:= digest.(3) + !A;
		    digest.(4) .:= digest.(4) + !A
	end
end

fun sha_update (si as SHA_INFO (_, count, n, data)) =
    let fun upd1 nil = ()
	  | upd1 (c::s) =
	    ((if !count=64
		  then (sha_transform si;
			count := 1;
			data.(0) .:= ord c)
	      else (data.(!count) .:= ord c;
		    inc count));
		  inc n;
		  upd1 s)
    in
	upd1 o explode
    end

fun sha_final (si as SHA_INFO (digest, count, n, data)) =
    ((if !count=64 then (sha_transform si; count := 0) else ());
	  data.(!count) .:= 128;
	  inc count;
	  let val c = !count
	  in
	      (if c>56
		   then (while !count<64 do (data.(!count).:= 0; inc count);
			     sha_transform si;
			     count := 0)
	       else ());
		   while !count<56 do (data.(!count).:= 0; inc count);
		       data.(56) .:= 0;
		       data.(57) .:= 0;
		       data.(58) .:= 0;
		       data.(59) .:= lsr (!n, 29);
		       data.(60) .:= band (lsr (!n, 21), 255);
		       data.(61) .:= band (lsr (!n, 13), 255);
		       data.(62) .:= band (lsr (!n, 5), 255);
		       data.(63) .:= band (lsl (!n, 3), 255);
		       sha_transform si;
		       digest
	  end);
	 
fun outsha () =
    let val si as SHA_INFO (_, _, n, _) = sha_init ()
    in
	|[ put = sha_update si,
	   tell = fn () => !n,
	   convert = fn () => sha_final si
	   ]|
    end
