(* $Id: cryptmodes_64.ml,v 1.2 2001/03/10 16:43:21 gerd Exp $
 * ----------------------------------------------------------------------
 * This module is part of the cryptgps package by Gerd Stolpmann.
 *)

open Crypt_aux


module type T =
    sig
      
      type key

      val encrypt_cbc :
	  key -> (int * int * int * int) -> string -> 
	    ((int * int * int * int) * string)

      val decrypt_cbc :
	  key -> (int * int * int * int) -> string -> 
	    ((int * int * int * int) * string)

      val encrypt_cfb8 :
	  key -> (int * int * int * int) -> string -> 
	    ((int * int * int * int) * string)

      val decrypt_cfb8 :
	  key -> (int * int * int * int) -> string -> 
	    ((int * int * int * int) * string)

      val encrypt_cfb64 :
	  key -> (int * int * int * int) -> int -> string -> 
	    ((int * int * int * int) * int * string)

      val decrypt_cfb64 :
	  key -> (int * int * int * int) -> int -> string -> 
	    ((int * int * int * int) * int * string)

      val crypt_ofb :
	  key -> (int * int * int * int) -> int -> string -> 
	    ((int * int * int * int) * int * string)
    end
;;


module Make_modes (M : Cryptsystem_64.T) =
  struct

    type key = M.key
    
    let encrypt_cbc k iv data =
      let l = String.length data in
      if l mod 8 <> 0 then failwith "encrypt_cbc";

      let n = l / 8 in
      let data' = Bytes.create l in

      let v = ref iv in
      for i = 0 to n-1 do
	let j = 8*i in

	let x3 = (Char.code(data.[j]) lsl 8) lor (Char.code(data.[j+1])) in
	let x2 = (Char.code(data.[j+2]) lsl 8) lor (Char.code(data.[j+3])) in
	let x1 = (Char.code(data.[j+4]) lsl 8) lor (Char.code(data.[j+5])) in
	let x0 = (Char.code(data.[j+6]) lsl 8) lor (Char.code(data.[j+7])) in

	let (v3,v2,v1,v0) = !v in

	v := M.encrypt_ecb k (v3 lxor x3, v2 lxor x2, v1 lxor x1, v0 lxor x0);

	let (v3',v2',v1',v0') = !v in

	Bytes.set data'  j    (Char.chr(v3' lsr 8));
	Bytes.set data' (j+1) (Char.chr(v3' land 0xff));
	Bytes.set data' (j+2) (Char.chr(v2' lsr 8));
	Bytes.set data' (j+3) (Char.chr(v2' land 0xff));
	Bytes.set data' (j+4) (Char.chr(v1' lsr 8));
	Bytes.set data' (j+5) (Char.chr(v1' land 0xff));
	Bytes.set data' (j+6) (Char.chr(v0' lsr 8));
	Bytes.set data' (j+7) (Char.chr(v0' land 0xff));
      done;

      !v, Bytes.to_string data'


    let decrypt_cbc k iv data =
      let l = String.length data in
      if l mod 8 <> 0 then failwith "decrypt_cbc";

      let n = l / 8 in
      let data' = Bytes.create l in

      let v = ref iv in
      for i = 0 to n-1 do
	let j = 8*i in

	let x3 = (Char.code(data.[j]) lsl 8) lor (Char.code(data.[j+1])) in
	let x2 = (Char.code(data.[j+2]) lsl 8) lor (Char.code(data.[j+3])) in
	let x1 = (Char.code(data.[j+4]) lsl 8) lor (Char.code(data.[j+5])) in
	let x0 = (Char.code(data.[j+6]) lsl 8) lor (Char.code(data.[j+7])) in

	let (y3,y2,y1,y0) = M.decrypt_ecb k (x3,x2,x1,x0) in

	let (v3,v2,v1,v0) = !v in

	let z3 = y3 lxor v3 in
	let z2 = y2 lxor v2 in
	let z1 = y1 lxor v1 in
	let z0 = y0 lxor v0 in

	Bytes.set data'  j    (Char.chr(z3 lsr 8));
	Bytes.set data' (j+1) (Char.chr(z3 land 0xff));
	Bytes.set data' (j+2) (Char.chr(z2 lsr 8));
	Bytes.set data' (j+3) (Char.chr(z2 land 0xff));
	Bytes.set data' (j+4) (Char.chr(z1 lsr 8));
	Bytes.set data' (j+5) (Char.chr(z1 land 0xff));
	Bytes.set data' (j+6) (Char.chr(z0 lsr 8));
	Bytes.set data' (j+7) (Char.chr(z0 land 0xff));

	v := (x3,x2,x1,x0);
      done;

      !v, Bytes.to_string data'


    let encrypt_cfb8 k iv data =
      let l = String.length data in
      let data' = Bytes.create l in

      let sr = ref iv in (* shift register *)
      
      for i = 0 to l-1 do
	let (v,_,_,_) = M.encrypt_ecb k !sr in
	let c = Char.code(data.[i]) lxor (v lsr 8) in
	Bytes.set data' i (Char.chr c);
	let (sr3, sr2, sr1, sr0) = !sr in
	sr := (((sr3 lsl 8) land 0xff00) lor (sr2 lsr 8),
	       ((sr2 lsl 8) land 0xff00) lor (sr1 lsr 8),
	       ((sr1 lsl 8) land 0xff00) lor (sr0 lsr 8),
	       ((sr0 lsl 8) land 0xff00) lor c);
      done;

      !sr, Bytes.to_string data'


    let decrypt_cfb8 k iv data = 
      let l = String.length data in
      let data' = Bytes.create l in

      let sr = ref iv in (* shift register *)
      
      for i = 0 to l-1 do
	let (v,_,_,_) = M.encrypt_ecb k !sr in  (* sic! *)
	let c = Char.code(data.[i]) in
	let p = c lxor (v lsr 8) in
	Bytes.set data' i (Char.chr p);
	let (sr3, sr2, sr1, sr0) = !sr in
	sr := (((sr3 lsl 8) land 0xff00) lor (sr2 lsr 8),
	       ((sr2 lsl 8) land 0xff00) lor (sr1 lsr 8),
	       ((sr1 lsl 8) land 0xff00) lor (sr0 lsr 8),
	       ((sr0 lsl 8) land 0xff00) lor c);
      done;

      !sr, Bytes.to_string data'


    let array_of_quadrupel (n3,n2,n1,n0) =
      [| n3 lsr 8;
	 n3 land 0xff;
	 n2 lsr 8;
	 n2 land 0xff;
	 n1 lsr 8;
	 n1 land 0xff;
	 n0 lsr 8;
	 n0 land 0xff |]

    let quadrupel_of_array a =
      ((a.(0) lsl 8) lor a.(1),
       (a.(2) lsl 8) lor a.(3),
       (a.(4) lsl 8) lor a.(5),
       (a.(6) lsl 8) lor a.(7))

    let encrypt_cfb64 k iv j data =
      if j < 0 || j > 7 then failwith "encrypt_cfb64";
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_a = ref (array_of_quadrupel iv) in
      let jc = ref j in

      for i = 0 to l-1 do
	if !jc = 0 then
	  sr_a := array_of_quadrupel 
	            (M.encrypt_ecb k (quadrupel_of_array !sr_a));

	let sr_jc = (!sr_a).(!jc) in
	let c = Char.code(data.[i]) lxor sr_jc in
	Bytes.set data' i (Char.chr c);
	(!sr_a).(!jc) <- c;
	jc := (!jc + 1) mod 8;
      done;

      let sr = quadrupel_of_array !sr_a in
      sr, !jc, Bytes.to_string data'


    let decrypt_cfb64 k iv j data =
      if j < 0 || j > 7 then failwith "decrypt_cfb64";
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_a = ref (array_of_quadrupel iv) in
      let jc = ref j in

      for i = 0 to l-1 do
	if !jc = 0 then
	  sr_a := array_of_quadrupel 
	            (M.encrypt_ecb k (quadrupel_of_array !sr_a));

	let sr_jc = (!sr_a).(!jc) in
	let c = Char.code(data.[i]) in
	Bytes.set data' i (Char.chr (c lxor sr_jc));
	(!sr_a).(!jc) <- c;
	jc := (!jc + 1) mod 8;
      done;

      let sr = quadrupel_of_array !sr_a in
      sr, !jc, Bytes.to_string data'


    let crypt_ofb k iv j data =
      if j < 0 || j > 7 then failwith "crypt_ofb";
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_a = ref (array_of_quadrupel iv) in
      let jc = ref j in

      for i = 0 to l-1 do
	if !jc = 0 then
	  sr_a := array_of_quadrupel 
	            (M.encrypt_ecb k (quadrupel_of_array !sr_a));

	let sr_jc = (!sr_a).(!jc) in
	let c = Char.code(data.[i]) lxor sr_jc in
	Bytes.set data' i (Char.chr c);
	jc := (!jc + 1) mod 8;
      done;

      let sr = quadrupel_of_array !sr_a in
      sr, !jc, Bytes.to_string data'

  end
;;


module Make_modes_int32 (M : Cryptsystem_64.T) =
  struct

    type key = M.key
    
    let encrypt_cbc k iv data =
      let l = String.length data in
      if l mod 8 <> 0 then failwith "encrypt_cbc";

      let n = l / 8 in
      let data' = Bytes.create l in

      let vl = ref Int32.zero in
      let vr = ref Int32.zero in
      int32_of_quadruple iv vl vr;

      for i = 0 to n-1 do
	let j = 8*i in

	let x3 = (Char.code(data.[j]) lsl 8) lor (Char.code(data.[j+1])) in
	let x2 = (Char.code(data.[j+2]) lsl 8) lor (Char.code(data.[j+3])) in
	let x1 = (Char.code(data.[j+4]) lsl 8) lor (Char.code(data.[j+5])) in
	let x0 = (Char.code(data.[j+6]) lsl 8) lor (Char.code(data.[j+7])) in

	let xl =
	  Int32.logor
	    (Int32.shift_left (Int32.of_int x3) 16)
	    (Int32.of_int x2)
	in
	let xr =
	  Int32.logor
	    (Int32.shift_left (Int32.of_int x1) 16)
	    (Int32.of_int x0)
	in

	let yl = Int32.logxor xl !vl in
	let yr = Int32.logxor xr !vr in

	M.encrypt_ecb_int32 k yl yr vl vr;

	let v3' = Int32.to_int (Int32.shift_right_logical !vl 16) in
	let v2' = Int32.to_int !vl in
	let v1' = Int32.to_int (Int32.shift_right_logical !vr 16) in
	let v0' = Int32.to_int !vr in

	Bytes.set data'  j    (Char.chr((v3' lsr 8) land 0xff));
	Bytes.set data' (j+1) (Char.chr(v3' land 0xff));
	Bytes.set data' (j+2) (Char.chr((v2' lsr 8) land 0xff));
	Bytes.set data' (j+3) (Char.chr(v2' land 0xff));
	Bytes.set data' (j+4) (Char.chr((v1' lsr 8) land 0xff));
	Bytes.set data' (j+5) (Char.chr(v1' land 0xff));
	Bytes.set data' (j+6) (Char.chr((v0' lsr 8) land 0xff));
	Bytes.set data' (j+7) (Char.chr(v0' land 0xff));
      done;

      quadruple_of_int32 !vl !vr, Bytes.to_string data'


    let decrypt_cbc k iv data =
      let l = String.length data in
      if l mod 8 <> 0 then failwith "decrypt_cbc";

      let n = l / 8 in
      let data' = Bytes.create l in

      let vl = ref Int32.zero in
      let vr = ref Int32.zero in
      int32_of_quadruple iv vl vr;

      for i = 0 to n-1 do
	let j = 8*i in

	let x3 = (Char.code(data.[j]) lsl 8) lor (Char.code(data.[j+1])) in
	let x2 = (Char.code(data.[j+2]) lsl 8) lor (Char.code(data.[j+3])) in
	let x1 = (Char.code(data.[j+4]) lsl 8) lor (Char.code(data.[j+5])) in
	let x0 = (Char.code(data.[j+6]) lsl 8) lor (Char.code(data.[j+7])) in

	let xl =
	  Int32.logor
	    (Int32.shift_left (Int32.of_int x3) 16)
	    (Int32.of_int x2)
	in
	let xr =
	  Int32.logor
	    (Int32.shift_left (Int32.of_int x1) 16)
	    (Int32.of_int x0)
	in

	let yl = ref Int32.zero in
	let yr = ref Int32.zero in

	M.decrypt_ecb_int32 k xl xr yl yr;

	let zl = Int32.logxor !yl !vl in
	let zr = Int32.logxor !yr !vr in

	let z3 = Int32.to_int (Int32.shift_right_logical zl 16) in
	let z2 = Int32.to_int zl in
	let z1 = Int32.to_int (Int32.shift_right_logical zr 16) in
	let z0 = Int32.to_int zr in

	Bytes.set data'  j    (Char.chr((z3 lsr 8) land 0xff));
	Bytes.set data' (j+1) (Char.chr(z3 land 0xff));
	Bytes.set data' (j+2) (Char.chr((z2 lsr 8) land 0xff));
	Bytes.set data' (j+3) (Char.chr(z2 land 0xff));
	Bytes.set data' (j+4) (Char.chr((z1 lsr 8) land 0xff));
	Bytes.set data' (j+5) (Char.chr(z1 land 0xff));
	Bytes.set data' (j+6) (Char.chr((z0 lsr 8) land 0xff));
	Bytes.set data' (j+7) (Char.chr(z0 land 0xff));

	vl := xl;
	vr := xr;
      done;

      quadruple_of_int32 !vl !vr, Bytes.to_string data'


    let encrypt_cfb8 k iv data =
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_l = ref Int32.zero in   (* shift register MSB *)
      let sr_r = ref Int32.zero in   (* shift register LSB *)
      int32_of_quadruple iv sr_l sr_r;

      let out_l = ref Int32.zero in
      let out_r = ref Int32.zero in
      
      for i = 0 to l-1 do
	M.encrypt_ecb_int32 k !sr_l !sr_r out_l out_r;
	let c = Char.code(data.[i]) lxor 
			  ((Int32.to_int 
			      (Int32.shift_right_logical !out_l 24)) land 0xff)
	in
	Bytes.set data' i (Char.chr c);
	sr_l := Int32.logor 
	          (Int32.shift_left !sr_l 8)
	          (Int32.shift_right_logical !sr_r 24);
	sr_r := Int32.logor
	          (Int32.shift_left !sr_r 8)
	          (Int32.of_int c)
      done;

      quadruple_of_int32 !sr_l !sr_r, Bytes.to_string data'


    let decrypt_cfb8 k iv data = 
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_l = ref Int32.zero in   (* shift register MSB *)
      let sr_r = ref Int32.zero in   (* shift register LSB *)
      int32_of_quadruple iv sr_l sr_r;

      let out_l = ref Int32.zero in
      let out_r = ref Int32.zero in
      
      for i = 0 to l-1 do
	M.encrypt_ecb_int32 k !sr_l !sr_r out_l out_r;    (* sic! *)
	let c = Char.code(data.[i]) in
	let p = c lxor 
		((Int32.to_int 
		    (Int32.shift_right_logical !out_l 24)) land 0xff)
	in
	Bytes.set data' i (Char.chr p);
	sr_l := Int32.logor 
	          (Int32.shift_left !sr_l 8)
	          (Int32.shift_right_logical !sr_r 24);
	sr_r := Int32.logor
	          (Int32.shift_left !sr_r 8)
	          (Int32.of_int c)
      done;

      quadruple_of_int32 !sr_l !sr_r, Bytes.to_string data'


    let mask =
      [| Int32.of_string "0x00ffffff";
	 Int32.of_string "0xff00ffff";
	 Int32.of_string "0xffff00ff";
	 Int32.of_string "0xffffff00";
      |]

    let encrypt_cfb64 k iv j data =
      if j < 0 || j > 7 then failwith "encrypt_cfb64";
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_l = ref Int32.zero in   (* shift register MSB *)
      let sr_r = ref Int32.zero in   (* shift register LSB *)
      int32_of_quadruple iv sr_l sr_r;

      let jc = ref j in

      for i = 0 to l-1 do
	if !jc = 0 then
	  M.encrypt_ecb_int32 k !sr_l !sr_r sr_l sr_r;

	let jc8 = !jc lsl 3 in

	let sr_jc = 
	  if !jc < 4 then
	    (Int32.to_int
	       (Int32.shift_right_logical !sr_l (24 - jc8)))
	    land 0xff
	  else
	    (Int32.to_int
	       (Int32.shift_right_logical !sr_r (56 - jc8)))
	    land 0xff
	in
	let c = Char.code(data.[i]) lxor sr_jc in
	Bytes.set data' i (Char.chr c);
	( if !jc < 4 then 
	    sr_l :=
	      Int32.logor
		(Int32.logand !sr_l mask.(!jc))
		(Int32.shift_left (Int32.of_int c) (24 - jc8))
	  else
	    sr_r :=
	      Int32.logor
		(Int32.logand !sr_r mask.(!jc - 4))
		(Int32.shift_left (Int32.of_int c) (56 - jc8))
	);
	jc := (!jc + 1) mod 8;
      done;

      quadruple_of_int32 !sr_l !sr_r, !jc, Bytes.to_string data'


    let decrypt_cfb64 k iv j data =
      if j < 0 || j > 7 then failwith "decrypt_cfb64";
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_l = ref Int32.zero in   (* shift register MSB *)
      let sr_r = ref Int32.zero in   (* shift register LSB *)
      int32_of_quadruple iv sr_l sr_r;

      let jc = ref j in

      for i = 0 to l-1 do
	if !jc = 0 then
	  M.encrypt_ecb_int32 k !sr_l !sr_r sr_l sr_r;

	let jc8 = !jc lsl 3 in

	let sr_jc = 
	  if !jc < 4 then
	    (Int32.to_int
	       (Int32.shift_right_logical !sr_l (24 - jc8)))
	    land 0xff
	  else
	    (Int32.to_int
	       (Int32.shift_right_logical !sr_r (56 - jc8)))
	    land 0xff
	in
	let c = Char.code(data.[i]) in
	Bytes.set data' i (Char.chr (c lxor sr_jc));
	( if !jc < 4 then 
	    sr_l :=
	      Int32.logor
		(Int32.logand !sr_l mask.(!jc))
		(Int32.shift_left (Int32.of_int c) (24 - jc8))
	  else
	    sr_r :=
	      Int32.logor
		(Int32.logand !sr_r mask.(!jc - 4))
		(Int32.shift_left (Int32.of_int c) (56 - jc8))
	);
	jc := (!jc + 1) mod 8;
      done;

      quadruple_of_int32 !sr_l !sr_r, !jc, Bytes.to_string data'


    let crypt_ofb k iv j data =
      if j < 0 || j > 7 then failwith "crypt_ofb";
      let l = String.length data in
      let data' = Bytes.create l in

      let sr_l = ref Int32.zero in   (* shift register MSB *)
      let sr_r = ref Int32.zero in   (* shift register LSB *)
      int32_of_quadruple iv sr_l sr_r;

      let jc = ref j in

      for i = 0 to l-1 do
	if !jc = 0 then
	if !jc = 0 then
	  M.encrypt_ecb_int32 k !sr_l !sr_r sr_l sr_r;

	let jc8 = !jc lsl 3 in

	let sr_jc = 
	  if !jc < 4 then
	    (Int32.to_int
	       (Int32.shift_right_logical !sr_l (24 - jc8)))
	    land 0xff
	  else
	    (Int32.to_int
	       (Int32.shift_right_logical !sr_r (56 - jc8)))
	    land 0xff
	in
	let c = Char.code(data.[i]) lxor sr_jc in
	Bytes.set data' i (Char.chr c);
	jc := (!jc + 1) mod 8;
      done;

      quadruple_of_int32 !sr_l !sr_r, !jc, Bytes.to_string data'

  end
;;


(* ======================================================================
 * History:
 * 
 * $Log: cryptmodes_64.ml,v $
 * Revision 1.2  2001/03/10 16:43:21  gerd
 * 	int32 experiments
 *
 * Revision 1.1  1999/06/04 20:42:01  gerd
 * 	Initial revision.
 *
 * 
 *)