(* $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' = String.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
data'.[j] <- Char.chr(v3' lsr 8);
data'.[j+1] <- Char.chr(v3' land 0xff);
data'.[j+2] <- Char.chr(v2' lsr 8);
data'.[j+3] <- Char.chr(v2' land 0xff);
data'.[j+4] <- Char.chr(v1' lsr 8);
data'.[j+5] <- Char.chr(v1' land 0xff);
data'.[j+6] <- Char.chr(v0' lsr 8);
data'.[j+7] <- Char.chr(v0' land 0xff);
done;
!v, 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' = String.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
data'.[j] <- Char.chr(z3 lsr 8);
data'.[j+1] <- Char.chr(z3 land 0xff);
data'.[j+2] <- Char.chr(z2 lsr 8);
data'.[j+3] <- Char.chr(z2 land 0xff);
data'.[j+4] <- Char.chr(z1 lsr 8);
data'.[j+5] <- Char.chr(z1 land 0xff);
data'.[j+6] <- Char.chr(z0 lsr 8);
data'.[j+7] <- Char.chr(z0 land 0xff);
v := (x3,x2,x1,x0);
done;
!v, data'
let encrypt_cfb8 k iv data =
let l = String.length data in
let data' = String.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
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, data'
let decrypt_cfb8 k iv data =
let l = String.length data in
let data' = String.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
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, 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 or j > 7 then failwith "encrypt_cfb64";
let l = String.length data in
let data' = String.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
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, data'
let decrypt_cfb64 k iv j data =
if j < 0 or j > 7 then failwith "decrypt_cfb64";
let l = String.length data in
let data' = String.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
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, data'
let crypt_ofb k iv j data =
if j < 0 or j > 7 then failwith "crypt_ofb";
let l = String.length data in
let data' = String.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
data'.[i] <- Char.chr c;
jc := (!jc + 1) mod 8;
done;
let sr = quadrupel_of_array !sr_a in
sr, !jc, 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' = String.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
data'.[j] <- Char.chr((v3' lsr 8) land 0xff);
data'.[j+1] <- Char.chr(v3' land 0xff);
data'.[j+2] <- Char.chr((v2' lsr 8) land 0xff);
data'.[j+3] <- Char.chr(v2' land 0xff);
data'.[j+4] <- Char.chr((v1' lsr 8) land 0xff);
data'.[j+5] <- Char.chr(v1' land 0xff);
data'.[j+6] <- Char.chr((v0' lsr 8) land 0xff);
data'.[j+7] <- Char.chr(v0' land 0xff);
done;
quadruple_of_int32 !vl !vr, 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' = String.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
data'.[j] <- Char.chr((z3 lsr 8) land 0xff);
data'.[j+1] <- Char.chr(z3 land 0xff);
data'.[j+2] <- Char.chr((z2 lsr 8) land 0xff);
data'.[j+3] <- Char.chr(z2 land 0xff);
data'.[j+4] <- Char.chr((z1 lsr 8) land 0xff);
data'.[j+5] <- Char.chr(z1 land 0xff);
data'.[j+6] <- Char.chr((z0 lsr 8) land 0xff);
data'.[j+7] <- Char.chr(z0 land 0xff);
vl := xl;
vr := xr;
done;
quadruple_of_int32 !vl !vr, data'
let encrypt_cfb8 k iv data =
let l = String.length data in
let data' = String.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
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, data'
let decrypt_cfb8 k iv data =
let l = String.length data in
let data' = String.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
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, 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 or j > 7 then failwith "encrypt_cfb64";
let l = String.length data in
let data' = String.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
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, data'
let decrypt_cfb64 k iv j data =
if j < 0 or j > 7 then failwith "decrypt_cfb64";
let l = String.length data in
let data' = String.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
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, data'
let crypt_ofb k iv j data =
if j < 0 or j > 7 then failwith "crypt_ofb";
let l = String.length data in
let data' = String.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
data'.[i] <- Char.chr c;
jc := (!jc + 1) mod 8;
done;
quadruple_of_int32 !sr_l !sr_r, !jc, 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.
*
*
*)
