Commit eba42ba4 authored by gerd's avatar gerd

Added module for DES.


git-svn-id: https://godirepo.camlcity.org/svn/lib-cryptgps/trunk@2 b101cce4-44db-0310-b718-db4b2d8d2e05
parent 02333b5b
......@@ -10,8 +10,10 @@
#----------------------------------------------------------------------
# specific rules for this package:
OBJECTS = cryptsystem_64.cmo cryptmodes_64.cmo crypt_blowfish.cmo
XOBJECTS = cryptsystem_64.cmx cryptmodes_64.cmx crypt_blowfish.cmx
OBJECTS = cryptsystem_64.cmo cryptmodes_64.cmo \
crypt_blowfish.cmo crypt_des.cmo
XOBJECTS = cryptsystem_64.cmx cryptmodes_64.cmx \
crypt_blowfish.cmx crypt_des.cmx
ARCHIVE = cryptgps.cma
XARCHIVE = cryptgps.cmxa
NAME = cryptgps
......@@ -32,7 +34,7 @@ $(XARCHIVE): $(XOBJECTS)
OPTIONS =
OCAMLC = ocamlc $(OPTIONS) $(ROPTIONS)
OCAMLOPT = ocamlopt $(OPTIONS) $(ROPTIONS)
OCAMLOPT = ocamlopt -p $(OPTIONS) $(ROPTIONS)
OCAMLDEP = ocamldep $(OPTIONS)
OCAMLFIND = ocamlfind
......@@ -57,11 +59,11 @@ clean:
.PHONY: distclean
distclean: clean
rm -f *~
rm -f *~ depend depend.pkg
.PHONY: dist
dist:
r=`head -1 RELEASE`; cd ..; gtar czf $(NAME)-$$r.tar.gz $(NAME)
r=`head -1 RELEASE`; cd ..; gtar czf $(NAME)-$$r.tar.gz --exclude='*/CVS*' --exclude="*/depend.pkg" --exclude="*/depend" $(NAME)
.PHONY: tag-release
tag-release:
......
(* $Id: crypt_des.ml,v 1.1 1999/06/17 14:55:04 gerd Exp $
* ----------------------------------------------------------------------
*
*)
(* Note: Bits are numbered from MSB to LSB! *)
(* 64 bit numbers are represented as four 16 bit numbers,
* (int * int * int * int), MSB first.
* 56 bit numbers: like 64 bit numbers with 4 leading and 4 trailing zeros.
* 48 bit numbers are represented as two 24 bit numbers,
* (int * int), MSB first.
* 32 bit numbers are represented as two 16 bit numbers,
* (int * int), MSB first.
*)
(******************** key parity ************************)
let odd_parity =
[| 1; 1; 2; 2; 4; 4; 7; 7; 8; 8; 11; 11; 13; 13; 14; 14;
16; 16; 19; 19; 21; 21; 22; 22; 25; 25; 26; 26; 28; 28; 31; 31;
32; 32; 35; 35; 37; 37; 38; 38; 41; 41; 42; 42; 44; 44; 47; 47;
49; 49; 50; 50; 52; 52; 55; 55; 56; 56; 59; 59; 61; 61; 62; 62;
64; 64; 67; 67; 69; 69; 70; 70; 73; 73; 74; 74; 76; 76; 79; 79;
81; 81; 82; 82; 84; 84; 87; 87; 88; 88; 91; 91; 93; 93; 94; 94;
97; 97; 98; 98;100;100;103;103;104;104;107;107;109;109;110;110;
112;112;115;115;117;117;118;118;121;121;122;122;124;124;127;127;
128;128;131;131;133;133;134;134;137;137;138;138;140;140;143;143;
145;145;146;146;148;148;151;151;152;152;155;155;157;157;158;158;
161;161;162;162;164;164;167;167;168;168;171;171;173;173;174;174;
176;176;179;179;181;181;182;182;185;185;186;186;188;188;191;191;
193;193;194;194;196;196;199;199;200;200;203;203;205;205;206;206;
208;208;211;211;213;213;214;214;217;217;218;218;220;220;223;223;
224;224;227;227;229;229;230;230;233;233;234;234;236;236;239;239;
241;241;242;242;244;244;247;247;248;248;251;251;253;253;254;254; |];;
let check_parity key =
let l_key = String.length key in
if l_key <> 8 then
failwith "Crypt_des: invalid key length";
for i = 0 to 7 do
let k = Char.code key.[i] in
if k <> odd_parity.(k) then
failwith "Crypt_des: key parity error"
done;
()
;;
let set_parity key =
let l_key = String.length key in
if l_key <> 8 then
failwith "Crypt_des: invalid key length";
let key' = String.copy key in
for i = 0 to 7 do
let k = Char.code key.[i] in
key'.[i] <- Char.chr(odd_parity.(k))
done;
key'
;;
module Cryptsystem : Cryptsystem_64.T =
struct
type value64 = (int * int * int * int)
type value48 = (int * int)
type value32 = (int * int)
(********************* permutations **********************)
type perm64 = value64 array
(* An array with 8 * 256 elements describing 64 bit numbers.
* To permute a 64 bit number (b1,b2,b3,b4,b5,b6,b7,b8) given as byte
* sequence, do
* a.(b1) lor a.(256+b2) lor a.(512+b3) lor ... lor a.(1792+b8)
*)
type perm48 = value48 array
(* An array with 6 * 256 elements describing 48 bit numbers.
* To permute a 48 bit number (b1,b2,b3,b4,b5,b6) given as byte
* sequence, do
* a.(b1) lor a.(256+b2) lor a.(512+b3) lor ... lor a.(1280+b6)
*)
type perm32 = value32 array
(* An array with 4 * 256 elements describing 32 bit numbers.
* To permute a 32 bit number (b1,b2,b3,b4) given as byte
* sequence, do
* a.(b1) lor a.(256+b2) lor a.(512+b3) lor a.(768+b4)
*)
let quad_lor (a,b,c,d) (a',b',c',d') =
(a lor a', b lor b', c lor c', d lor d')
let ( |||| ) = quad_lor
let double_lor (a,b) (a',b') =
(a lor a', b lor b')
let ( || ) = double_lor
let inv64 p =
let rec pos k x =
if k < 64 then begin
if p.(k) = x then k else pos (k+1) x
end
else failwith "inv64"
in
let p' = Array.create 64 0 in
for k = 0 to 63 do
p'.(k) <- pos 0 k
done;
p'
let mk_perm64 p' =
(* p: a 64 element array. p(i)=j means that bit position i of the output
* is bit position j in the input.
*)
let rec pos k x =
if k < 64 then begin
if p'.(k) = x then k :: pos (k+1) x else pos (k+1) x
end
else []
in
let p = Array.create 64 [] in
for k = 0 to 63 do
p.(k) <- pos 0 k
done;
let p64 = Array.create 2048 (0,0,0,0) in
for n = 0 to 7 do (* n counts bytes *)
for v = 0 to 255 do (* v counts values of a byte *)
let v' = ref (0,0,0,0) in
for ni = 0 to 7 do (* ni counts bits within bytes *)
let i = 8*n + ni in
if ((v lsl ni) land (0x80)) > 0 then begin
List.iter
(fun j ->
(* the bit in position ni of byte v is set *)
match j lsr 4 with
0 -> v' := !v' |||| (0x8000 lsr j, 0, 0, 0)
| 1 -> v' := !v' |||| (0, 0x8000 lsr (j-16), 0, 0)
| 2 -> v' := !v' |||| (0, 0, 0x8000 lsr (j-32), 0)
| 3 -> v' := !v' |||| (0, 0, 0, 0x8000 lsr (j-48))
| _ -> ()
)
p.(i)
end;
done;
p64.(256*n + v) <- !v'
done
done;
p64
let do_perm64 (p64:perm64) (v64:value64) =
let (a,b,c,d) = v64 in
let (a0,b0,c0,d0) = p64.( a lsr 8 ) in
let (a1,b1,c1,d1) = p64.( 256 + (a land 0xff)) in
let (a2,b2,c2,d2) = p64.( 512 + (b lsr 8) ) in
let (a3,b3,c3,d3) = p64.( 768 + (b land 0xff) ) in
let (a4,b4,c4,d4) = p64.( 1024 + (c lsr 8) ) in
let (a5,b5,c5,d5) = p64.( 1280 + (c land 0xff) ) in
let (a6,b6,c6,d6) = p64.( 1536 + (d lsr 8) ) in
let (a7,b7,c7,d7) = p64.( 1792 + (d land 0xff) ) in
(a0 lor a1 lor a2 lor a3 lor a4 lor a5 lor a6 lor a7,
b0 lor b1 lor b2 lor b3 lor b4 lor b5 lor b6 lor b7,
c0 lor c1 lor c2 lor c3 lor c4 lor c5 lor c6 lor c7,
d0 lor d1 lor d2 lor d3 lor d4 lor d5 lor d6 lor d7)
let mk_perm48 p' =
(* p: a 48 element array. p(i)=j means that bit position i of the output
* is bit position j in the input.
*)
let rec pos k x =
if k < 48 then begin
if p'.(k) = x then k :: pos (k+1) x else pos (k+1) x
end
else []
in
let p = Array.create 48 [] in
for k = 0 to 47 do
p.(k) <- pos 0 k
done;
let p48 = Array.create 1536 (0,0) in
for n = 0 to 5 do (* n counts bytes *)
for v = 0 to 255 do (* v counts values of a byte *)
let v' = ref (0,0) in
for ni = 0 to 7 do (* ni counts bits within bytes *)
let i = 8*n + ni in
if ((v lsl ni) land (0x80)) > 0 then begin
(* the bit in position ni of byte v is set *)
List.iter
(fun j ->
match j / 24 with
0 -> v' := !v' || (0x800000 lsr j, 0)
| 1 -> v' := !v' || (0, 0x800000 lsr (j-24))
| _ -> ())
p.(i)
end
done;
p48.(256*n + v) <- !v'
done
done;
p48
let do_perm48 (p48:perm48) (v48:value48) =
let (a,b) = v48 in
let (a0,b0) = p48.( a lsr 16 ) in
let (a1,b1) = p48.( 256 + ((a lsr 8) land 0xff)) in
let (a2,b2) = p48.( 512 + (a land 0xff) ) in
let (a3,b3) = p48.( 768 + ( b lsr 16 ) ) in
let (a4,b4) = p48.( 1024 + ((b lsr 8) land 0xff) ) in
let (a5,b5) = p48.( 1280 + (b land 0xff) ) in
( a0 lor a1 lor a2 lor a3 lor a4 lor a5,
b0 lor b1 lor b2 lor b3 lor b4 lor b5 )
let mk_perm32 p' =
(* p: a 32 element array. p(i)=j means that bit position i of the output
* is bit position j in the input.
*)
let rec pos k x =
if k < 32 then begin
if p'.(k) = x then k :: pos (k+1) x else pos (k+1) x
end
else []
in
let p = Array.create 32 [] in
for k = 0 to 31 do
p.(k) <- pos 0 k
done;
let p32 = Array.create 1024 (0,0) in
for n = 0 to 3 do (* n counts bytes *)
for v = 0 to 255 do (* v counts values of a byte *)
let v' = ref (0,0) in
for ni = 0 to 7 do (* ni counts bits within bytes *)
let i = 8*n + ni in
let j = p.(i) in
if ((v lsl ni) land (0x80)) > 0 then begin
(* the bit in position ni of byte v is set *)
List.iter
(fun j ->
match j lsr 4 with
0 -> v' := !v' || (0x8000 lsr j, 0)
| 1 -> v' := !v' || (0, 0x8000 lsr (j-16))
| _ -> ())
p.(i)
end
done;
p32.(256*n + v) <- !v'
done
done;
p32
let do_perm32 (p32:perm32) (v32:value32) =
let (a,b) = v32 in
let (a0,b0) = p32.( a lsr 8 ) in
let (a1,b1) = p32.( 256 + (a land 0xff)) in
let (a2,b2) = p32.( 512 + (b lsr 8) ) in
let (a3,b3) = p32.( 768 + (b land 0xff)) in
( a0 lor a1 lor a2 lor a3,
b0 lor b1 lor b2 lor b3 )
let des_iperm, des_fperm = (* initial, final permutation *)
let p =
[| 57; 49; 41; 33; 25; 17; 9; 1; 59; 51; 43; 35; 27; 19; 11; 3;
61; 53; 45; 37; 29; 21; 13; 5; 63; 55; 47; 39; 31; 23; 15; 7;
56; 48; 40; 32; 24; 16; 8; 0; 58; 50; 42; 34; 26; 18; 10; 2;
60; 52; 44; 36; 28; 20; 12; 4; 62; 54; 46; 38; 30; 22; 14; 6 |] in
let p' = inv64 p in
lazy (mk_perm64 p), lazy (mk_perm64 p')
(* OK *)
let des_kperm = (* key permutation *)
lazy
(mk_perm64
[| 64; 64; 64; 64;
56; 48; 40; 32; 24; 16; 8; 0; 57; 49; 41; 33; 25; 17;
9; 1; 58; 50; 42; 34; 26; 18; 10; 2; 59; 51; 43; 35;
62; 54; 46; 38; 30; 22; 14; 6; 61; 53; 45; 37; 29; 21;
13; 5; 60; 52; 44; 36; 28; 20; 12; 4; 27; 19; 11; 3;
64; 64; 64; 64 |] )
(* OK *)
(* des_kperm: this is a 64-to-56 bit permutation. Remember that 56 bit
* numbers are represented like 64 bit numbers but have 4 leading and
* 4 trailing zeros. The "64" in the array literal above sets the corresponding
* bit to zero.
*)
let des_cperm = (* compression permutation *)
lazy
(mk_perm64
[| 64; 64; 64; 64; 64; 64; 64; 64;
17; 20; 14; 27; 4; 8; 6; 31; 18; 9; 24; 13;
26; 22; 15; 7; 29; 11; 19; 10; 30; 23; 16; 5;
64; 64; 64; 64; 64; 64; 64; 64;
44; 55; 34; 40; 50; 58; 33; 43; 54; 48; 36; 51;
47; 52; 42; 59; 37; 56; 49; 45; 53; 39; 32; 35;
|] )
(* OK *)
(* des_cperm: This is a 56-to-48 bit permutation. The input number is a
* 56 bit number represented as described above (using bits 4 to 59 of a
* 64 bit number).
* The output number has a special representation, using bits 8 to 31 and
* bits 40 to 63 of a 64 bit number. This representation simplifies the
* conversion to value48.
*)
let des_xperm = (* expansion permutation *)
lazy
(mk_perm48
(Array.map
(fun n ->
if n <= 16 then n+7 else n+15)
[| 32; 1; 2; 3; 4; 5; 4; 5; 6; 7; 8; 9;
8; 9; 10; 11; 12; 13; 12; 13; 14; 15; 16; 17;
16; 17; 18; 19; 20; 21; 20; 21; 22; 23; 24; 25;
24; 25; 26; 27; 28; 29; 28; 29; 30; 31; 32; 1 |] ))
(* (OK) *)
(* 1..16: + 7 *)
(* 17..32: + 15 *)
(* des_xperm: This is a 32-to-48 bit permutation. The input number is a
* value32 taken as value48, i.e. bits 8 to 23 and 32 to 47 are used.
* The output number is a value48.
*)
let des_pboxperm =
lazy
(mk_perm32
[| 15; 6; 19; 20; 28; 11; 27; 16; 0; 14; 22; 25; 4; 17; 30; 9;
1; 7; 23; 13; 31; 26; 2; 8; 18; 12; 29; 5; 21; 10; 3; 24 |] )
(* (OK) *)
(* des_pboxperm: a 32-to-32 bit permutation *)
(********************* S-boxes ***************************)
(* an S-box is an array with 64 numbers from 0 to 15 *)
let mk_sbox shift a =
(* transform the S-box notation found in the literature to a lookup table *)
let a' = Array.create 64 0 in
for k' = 0 to 63 do
let k = ((k' land 0x1e) lsr 1) lor (k' land 0x20) lor ((k' land 1) lsl 4) in
a'.( k' ) <- a.(k) lsl shift
done;
a'
let sbox1 =
lazy
(mk_sbox 12
[| 14; 4; 13; 1; 2; 15; 11; 8; 3; 10; 6; 12; 5; 9; 0; 7;
0; 15; 7; 4; 14; 2; 13; 1; 10; 6; 12; 11; 9; 5; 3; 8;
4; 1; 14; 8; 13; 6; 2; 11; 15; 12; 9; 7; 3; 10; 5; 0;
15; 12; 8; 2; 4; 9; 1; 7; 5; 11; 3; 14; 10; 0; 6; 13 |])
(* (OK) *)
let sbox2 =
lazy
(mk_sbox 8
[| 15; 1; 8; 14; 6; 11; 3; 4; 9; 7; 2; 13; 12; 0; 5; 10;
3; 13; 4; 7; 15; 2; 8; 14; 12; 0; 1; 10; 6; 9; 11; 5;
0; 14; 7; 11; 10; 4; 13; 1; 5; 8; 12; 6; 9; 3; 2; 15;
13; 8; 10; 1; 3; 15; 4; 2; 11; 6; 7; 12; 0; 5; 14; 9 |])
(* (OK) *)
let sbox3 =
lazy
(mk_sbox 4
[| 10; 0; 9; 14; 6; 3; 15; 5; 1; 13; 12; 7; 11; 4; 2; 8;
13; 7; 0; 9; 3; 4; 6; 10; 2; 8; 5; 14; 12; 11; 15; 1;
13; 6; 4; 9; 8; 15; 3; 0; 11; 1; 2; 12; 5; 10; 14; 7;
1; 10; 13; 0; 6; 9; 8; 7; 4; 15; 14; 3; 11; 5; 2; 12 |])
(* (OK) *)
let sbox4 =
lazy
(mk_sbox 0
[| 7; 13; 14; 3; 0; 6; 9; 10; 1; 2; 8; 5; 11; 12; 4; 15;
13; 8; 11; 5; 6; 15; 0; 3; 4; 7; 2; 12; 1; 10; 14; 9;
10; 6; 9; 0; 12; 11; 7; 13; 15; 1; 3; 14; 5; 2; 8; 4;
3; 15; 0; 6; 10; 1; 13; 8; 9; 4; 5; 11; 12; 7; 2; 14 |])
(* (OK) *)
let sbox5 =
lazy
(mk_sbox 12
[| 2; 12; 4; 1; 7; 10; 11; 6; 8; 5; 3; 15; 13; 0; 14; 9;
14; 11; 2; 12; 4; 7; 13; 1; 5; 0; 15; 10; 3; 9; 8; 6;
4; 2; 1; 11; 10; 13; 7; 8; 15; 9; 12; 5; 6; 3; 0; 14;
11; 8; 12; 7; 1; 14; 2; 13; 6; 15; 0; 9; 10; 4; 5; 3 |])
(* (OK) *)
let sbox6 =
lazy
(mk_sbox 8
[| 12; 1; 10; 15; 9; 2; 6; 8; 0; 13; 3; 4; 14; 7; 5; 11;
10; 15; 4; 2; 7; 12; 9; 5; 6; 1; 13; 14; 0; 11; 3; 8;
9; 14; 15; 5; 2; 8; 12; 3; 7; 0; 4; 10; 1; 13; 11; 6;
4; 3; 2; 12; 9; 5; 15; 10; 11; 14; 1; 7; 6; 0; 8; 13 |])
(* (OK) *)
let sbox7 =
lazy
(mk_sbox 4
[| 4; 11; 2; 14; 15; 0; 8; 13; 3; 12; 9; 7; 5; 10; 6; 1;
13; 0; 11; 7; 4; 9; 1; 10; 14; 3; 5; 12; 2; 15; 8; 6;
1; 4; 11; 13; 12; 3; 7; 14; 10; 15; 6; 8; 0; 5; 9; 2;
6; 11; 13; 8; 1; 4; 10; 7; 9; 5; 0; 15; 14; 2; 3; 12 |])
(* (OK) *)
let sbox8 =
lazy
(mk_sbox 0
[| 13; 2; 8; 4; 6; 15; 11; 1; 10; 9; 3; 14; 5; 0; 12; 7;
1; 15; 13; 8; 10; 3; 7; 4; 12; 5; 6; 11; 0; 14; 9; 2;
7; 11; 4; 1; 9; 12; 14; 2; 0; 6; 10; 13; 15; 3; 5; 8;
2; 1; 14; 7; 4; 10; 8; 13; 15; 12; 9; 0; 3; 5; 6; 11; |])
(* (OK) *)
(******************* The algorithm ************************)
type key =
{ data : string;
k64 : value64;
k56 : value64;
k_enc : value48 array;
k_dec : value48 array;
(* k_enc: encryption keys for 16 rounds;
* k_dec: decryption keys for 16 rounds
*)
}
let des k x =
let iperm = Lazy.force des_iperm in
let fperm = Lazy.force des_fperm in
let kperm = Lazy.force des_kperm in
let cperm = Lazy.force des_cperm in
let xperm = Lazy.force des_xperm in
let pboxperm = Lazy.force des_pboxperm in
let s1 = Lazy.force sbox1 in
let s2 = Lazy.force sbox2 in
let s3 = Lazy.force sbox3 in
let s4 = Lazy.force sbox4 in
let s5 = Lazy.force sbox5 in
let s6 = Lazy.force sbox6 in
let s7 = Lazy.force sbox7 in
let s8 = Lazy.force sbox8 in
let f (k48_0,k48_1) l32_0 l32_1 r32_0 r32_1 =
(* computes new right half *)
let (r48_0, r48_1) = do_perm48 xperm (r32_0,r32_1) in (* sic! *)
let r'48_0 = k48_0 lxor r48_0 in
let r'48_1 = k48_1 lxor r48_1 in
let x0 = s1.( r'48_0 lsr 18 ) in
let x1 = s2.( (r'48_0 lsr 12) land 63 ) in
let x2 = s3.( (r'48_0 lsr 6) land 63 ) in
let x3 = s4.( r'48_0 land 63 ) in
let x4 = s5.( r'48_1 lsr 18 ) in
let x5 = s6.( (r'48_1 lsr 12) land 63 ) in
let x6 = s7.( (r'48_1 lsr 6) land 63 ) in
let x7 = s8.( r'48_1 land 63 ) in
let y0 = x0 lor x1 lor x2 lor x3 in
let y1 = x4 lor x5 lor x6 lor x7 in
let p0,p1 = do_perm32 pboxperm (y0,y1) in
(p0 lxor l32_0, p1 lxor l32_1)
in
let (l00, l01, r00, r01) = do_perm64 iperm x in
let (r10, r11) = f k.(0) l00 l01 r00 r01 in
let (r20, r21) = f k.(1) r00 r01 r10 r11 in
let (r30, r31) = f k.(2) r10 r11 r20 r21 in
let (r40, r41) = f k.(3) r20 r21 r30 r31 in
let (r50, r51) = f k.(4) r30 r31 r40 r41 in
let (r60, r61) = f k.(5) r40 r41 r50 r51 in
let (r70, r71) = f k.(6) r50 r51 r60 r61 in
let (r80, r81) = f k.(7) r60 r61 r70 r71 in
let (r90, r91) = f k.(8) r70 r71 r80 r81 in
let (ra0, ra1) = f k.(9) r80 r81 r90 r91 in
let (rb0, rb1) = f k.(10) r90 r91 ra0 ra1 in
let (rc0, rc1) = f k.(11) ra0 ra1 rb0 rb1 in
let (rd0, rd1) = f k.(12) rb0 rb1 rc0 rc1 in
let (re0, re1) = f k.(13) rc0 rc1 rd0 rd1 in
let (rf0, rf1) = f k.(14) rd0 rd1 re0 re1 in
let (rg0, rg1) = f k.(15) re0 re1 rf0 rf1 in
do_perm64 fperm (rg0, rg1, rf0, rf1)
let encrypt_ecb k x =
des k.k_enc x
let decrypt_ecb k x =
des k.k_dec x
let prepare key =
let l_key = String.length key in
if l_key <> 8 (* & l_key <> 7 *) then
failwith "Crypt_des: invalid key length";
let iperm = Lazy.force des_iperm in
let fperm = Lazy.force des_fperm in
let kperm = Lazy.force des_kperm in
let cperm = Lazy.force des_cperm in
let xperm = Lazy.force des_xperm in
let pboxperm = Lazy.force des_pboxperm in
let s1 = Lazy.force sbox1 in
let s2 = Lazy.force sbox2 in
let s3 = Lazy.force sbox3 in
let s4 = Lazy.force sbox4 in
let s5 = Lazy.force sbox5 in
let s6 = Lazy.force sbox6 in
let s7 = Lazy.force sbox7 in
let s8 = Lazy.force sbox8 in
let k56, k64 =
if l_key = 8 then begin
check_parity key;
let k64 =
( (Char.code(key.[0]) lsl 8) lor (Char.code(key.[1])),
(Char.code(key.[2]) lsl 8) lor (Char.code(key.[3])),
(Char.code(key.[4]) lsl 8) lor (Char.code(key.[5])),
(Char.code(key.[6]) lsl 8) lor (Char.code(key.[7])) ) in
do_perm64 kperm k64, k64
end
else (* l_key = 7 *)
(* This is currently not supported! *)
failwith "Crypt_des"
(*
let k0 = Char.code key.[0] in
let k1 = Char.code key.[1] in
let k2 = Char.code key.[2] in
let k3 = Char.code key.[3] in
let k4 = Char.code key.[4] in
let k5 = Char.code key.[5] in
let k6 = Char.code key.[6] in
( (k0 lsl 4) lor (k1 lsr 4),
((k1 land 15) lsl 12) lor (k2 lsl 4) lor (k3 lsr 4),
((k3 land 15) lsl 12) lor (k4 lsl 4) lor (k5 lsr 4),
((k5 land 15) lsl 12) lor (k6 lsl 4) )
*)
in
(* compute encryption keys *)
let shifts = [| 1; 1; 2; 2; 2; 2; 2; 2; 1; 2; 2; 2; 2; 2; 2; 1 |] in
let cycle28 x n =
(* shift 28 bit number x circularly left by n bits; n <= 2 *)
let x' = x lsl n in
(x' land 0xfffffff) lor (x' lsr 28)
in
let k = ref k56 in
let k_enc = Array.create 16 (0,0) in
let k_dec = Array.create 16 (0,0) in
for n = 0 to 15 do
let (k0,k1,k2,k3) = !k in
let k_left = (k0 lsl 16) lor k1 in (* k_left: 28 bits *)
let k_right = (k2 lsl 12) lor (k3 lsr 4) in (* k_right: 28 bits *)
let s = shifts.(n) in
let k_left' = cycle28 k_left s in
let k_right' = cycle28 k_right s in
k := ( k_left' lsr 16,
k_left' land 0xffff,
k_right' lsr 12,
(k_right' land 0xfff) lsl 4 );
let (c0,c1,c2,c3) = do_perm64 cperm !k in
let k48 =
( (c0 lsl 16) lor c1,
(c2 lsl 16) lor c3 ) in
k_enc.(n) <- k48;
k_dec.(15 - n) <- k48
done;
{ data = key;
k64 = k64;
k56 = k56;
k_enc = k_enc;
k_dec = k_dec
}
let textkey k = k.data
let is_weak k =
let weak_keys =
[ 0x0101, 0x0101, 0x0101, 0x0101; (* weak keys *)
0x1f1f, 0x1f1f, 0x0e0e, 0x0e0e;
0xe0e0, 0xe0e0, 0xf1f1, 0xf1f1;
0xfefe, 0xfefe, 0xfefe, 0xfefe;
0x01fe, 0x01fe, 0x01fe, 0x01fe; (* semiweak keys *)
0xfe01, 0xfe01, 0xfe01, 0xfe01;
0x1fe0, 0x1fe0, 0x0ef1, 0x0ef1;
0xe01f, 0xe01f, 0xf10e, 0xf10e;
0x01e0, 0x01e0, 0x01f1, 0x01f1;
0xe001, 0xe001, 0xf101, 0xf101;
0x1ffe, 0x1ffe, 0x0efe, 0x0efe;
0xfe1f, 0xfe1f, 0xfe0e, 0xfe0e;
0x011f, 0x011f, 0x010e, 0x010e;
0x1f01, 0x1f01, 0x0e01, 0x0e01;
0xe0fe, 0xe0fe, 0xf1fe, 0xf1fe;
0xfee0, 0xfee0, 0xfef1, 0xfef1;
0x1f1f, 0x0101, 0x0e0e, 0x0101; (* possibly weak keys *)
0x011f, 0x1f01, 0x010e, 0x0e01;
0x1f01, 0x011f, 0x0e01, 0x010e;
0x0101, 0x1f1f, 0x0101, 0x0e0e;
0xe0e0, 0x0101, 0xf1f1, 0x0101;
0xfefe, 0x0101, 0xfefe, 0x0101;
0xfee0, 0x1f01, 0xfef1, 0x0e01;
0xe0fe, 0x1f01, 0xf1fe, 0x0e01;
0xfee0, 0x011f, 0xfef1, 0x010e;
0xe0fe, 0x011f, 0xf1fe, 0x010e;
0xe0e0, 0x1f1f, 0xf1f1, 0x0e0e;