unikernel/duniverse/ocaml-x509/lib/rc2.ml

@@ -0,0 +1,175 @@
+
+let pitable = [|
+  0xd9; 0x78; 0xf9; 0xc4; 0x19; 0xdd; 0xb5; 0xed;  0x28; 0xe9; 0xfd; 0x79; 0x4a; 0xa0; 0xd8; 0x9d;
+  0xc6; 0x7e; 0x37; 0x83; 0x2b; 0x76; 0x53; 0x8e;  0x62; 0x4c; 0x64; 0x88; 0x44; 0x8b; 0xfb; 0xa2;
+  0x17; 0x9a; 0x59; 0xf5; 0x87; 0xb3; 0x4f; 0x13;  0x61; 0x45; 0x6d; 0x8d; 0x09; 0x81; 0x7d; 0x32;
+  0xbd; 0x8f; 0x40; 0xeb; 0x86; 0xb7; 0x7b; 0x0b;  0xf0; 0x95; 0x21; 0x22; 0x5c; 0x6b; 0x4e; 0x82;
+  0x54; 0xd6; 0x65; 0x93; 0xce; 0x60; 0xb2; 0x1c;  0x73; 0x56; 0xc0; 0x14; 0xa7; 0x8c; 0xf1; 0xdc;
+  0x12; 0x75; 0xca; 0x1f; 0x3b; 0xbe; 0xe4; 0xd1;  0x42; 0x3d; 0xd4; 0x30; 0xa3; 0x3c; 0xb6; 0x26;
+  0x6f; 0xbf; 0x0e; 0xda; 0x46; 0x69; 0x07; 0x57;  0x27; 0xf2; 0x1d; 0x9b; 0xbc; 0x94; 0x43; 0x03;
+  0xf8; 0x11; 0xc7; 0xf6; 0x90; 0xef; 0x3e; 0xe7;  0x06; 0xc3; 0xd5; 0x2f; 0xc8; 0x66; 0x1e; 0xd7;
+  0x08; 0xe8; 0xea; 0xde; 0x80; 0x52; 0xee; 0xf7;  0x84; 0xaa; 0x72; 0xac; 0x35; 0x4d; 0x6a; 0x2a;
+  0x96; 0x1a; 0xd2; 0x71; 0x5a; 0x15; 0x49; 0x74;  0x4b; 0x9f; 0xd0; 0x5e; 0x04; 0x18; 0xa4; 0xec;
+  0xc2; 0xe0; 0x41; 0x6e; 0x0f; 0x51; 0xcb; 0xcc;  0x24; 0x91; 0xaf; 0x50; 0xa1; 0xf4; 0x70; 0x39;
+  0x99; 0x7c; 0x3a; 0x85; 0x23; 0xb8; 0xb4; 0x7a;  0xfc; 0x02; 0x36; 0x5b; 0x25; 0x55; 0x97; 0x31;
+  0x2d; 0x5d; 0xfa; 0x98; 0xe3; 0x8a; 0x92; 0xae;  0x05; 0xdf; 0x29; 0x10; 0x67; 0x6c; 0xba; 0xc9;
+  0xd3; 0x00; 0xe6; 0xcf; 0xe1; 0x9e; 0xa8; 0x2c;  0x63; 0x16; 0x01; 0x3f; 0x58; 0xe2; 0x89; 0xa9;
+  0x0d; 0x38; 0x34; 0x1b; 0xab; 0x33; 0xff; 0xb0;  0xbb; 0x48; 0x0c; 0x5f; 0xb9; 0xb1; 0xcd; 0x2e;
+  0xc5; 0xf3; 0xdb; 0x47; 0xe5; 0xa5; 0x9c; 0x77;  0x0a; 0xa6; 0x20; 0x68; 0xfe; 0x7f; 0xc1; 0xad
+|]
+
+(* effective is sometimes named t1 *)
+let tm effective =
+  let t8 = (effective + 7) / 8 in
+  (* RFC says (TM = 255 MOD 2^(8 + effective - 8*T8)) *)
+  let bits = 8 + effective - 8 * t8 in
+  (* likely there's a smarter way to do this *)
+  let rec c acc = function
+    | 0 -> acc
+    | n -> c ((acc lsl 1) + 1) (pred n)
+  in
+  t8, c 0 bits
+
+(* L[i] is the i-th byte of the key; K[i] is the i-th 16-bit-word of the key *)
+let key_expansion effective key =
+  (* result is a 128 byte key, where we need the words.. *)
+  let t = String.length key in
+  let l = Array.init 128 (fun idx -> if idx < t then String.get_uint8 key idx else 0) in
+  let t8, tm = tm effective in
+  for i = t to 127 do
+    l.(i) <- pitable.((l.(i - 1) + l.(i - t)) mod 256)
+  done;
+  l.(128 - t8) <- pitable.(l.(128 - t8) land tm);
+  for i = 127 - t8 downto 0 do
+    l.(i) <- pitable.(l.(i + 1) lxor l.(i + t8));
+  done;
+  Array.init 64 (fun idx -> l.(2 * idx) + 256 * l.(2 * idx + 1))
+
+let mod16 f = 0xFFFF land f
+
+let rol16 x k = mod16 ((x lsl k) lor (x lsr (16 - k)))
+
+let ror16 x k = mod16 ((x lsr k) lor (x lsl (16 - k)))
+
+let not16 x = mod16 (lnot x)
+
+let s = Array.init 4 (function 0 -> 1 | 1 -> 2 | 2 -> 3 | 3 -> 5 | _ -> assert false)
+
+let pmod a =
+  let b = 4 in
+  let r = a mod b in
+  if r < 0 then (r + b) mod b else r
+
+(* only used for encryption which we don't support
+let mix r i k j =
+  r.(i) <- mod16 (r.(i) + k.(j) + r.(pmod (i - 1)) land r.(pmod (i - 2)) +
+                  (not16 r.(pmod (i - 1))) land r.(pmod (i - 3)));
+  let j = succ j in
+  r.(i) <- rol16 r.(i) s.(i);
+  j
+
+let mix_round r k j =
+  let j' = mix r 0 k j in
+  let j'' = mix r 1 k j' in
+  let j''' = mix r 2 k j'' in
+  let j'''' = mix r 3 k j''' in
+  j''''
+
+let mash r i k =
+  r.(i) <- mod16 (r.(i) + k.(r.(pmod (i - 1)) land 63))
+
+let mash_round r k =
+  mash r 0 k;
+  mash r 1 k;
+  mash r 2 k;
+  mash r 3 k
+
+let encrypt_one ~key ~data =
+  let r = Array.init 4 (fun idx -> Cstruct.LE.get_uint16 data (idx * 2)) in
+  let j = 0 in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  mash_round r key;
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  mash_round r key;
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let j = mix_round r key j in
+  let _j = mix_round r key j in
+  let out = Cstruct.create 8 in
+  Cstruct.LE.set_uint16 out 0 r.(0);
+  Cstruct.LE.set_uint16 out 2 r.(1);
+  Cstruct.LE.set_uint16 out 4 r.(2);
+  Cstruct.LE.set_uint16 out 6 r.(3);
+  out
+*)
+
+let r_mix r i k j =
+  r.(i) <- ror16 r.(i) s.(i);
+  r.(i) <- mod16 (r.(i) - k.(j) -
+                  (r.(pmod (i - 1)) land r.(pmod (i - 2))) -
+                  (not16 r.(pmod (i - 1)) land (r.(pmod (i - 3)))));
+  pred j
+
+let r_mix_round r k j =
+  let j' = r_mix r 3 k j in
+  let j'' = r_mix r 2 k j' in
+  let j''' = r_mix r 1 k j'' in
+  let j'''' = r_mix r 0 k j''' in
+  j''''
+
+let r_mash r i k =
+  r.(i) <- mod16 (r.(i) - k.(r.(pmod (i - 1)) land 63))
+
+let r_mash_round r k =
+  r_mash r 3 k;
+  r_mash r 2 k;
+  r_mash r 1 k;
+  r_mash r 0 k
+
+let decrypt_one ~key ~data ?(off = 0) dst =
+  let r = Array.init 4 (fun idx -> String.get_uint16_le data (off + idx * 2)) in
+  let j = 63 in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  r_mash_round r key;
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  r_mash_round r key;
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let j = r_mix_round r key j in
+  let _j = r_mix_round r key j in
+  Bytes.set_uint16_le dst (off + 0) r.(0);
+  Bytes.set_uint16_le dst (off + 2) r.(1);
+  Bytes.set_uint16_le dst (off + 4) r.(2);
+  Bytes.set_uint16_le dst (off + 6) r.(3)
+
+let decrypt_cbc ?(effective = 128) ~key ~iv data =
+  let block = 8 in
+  let key = key_expansion effective key in
+  let l = String.length data in
+  let dst = Bytes.create l in
+  for i = 0 to pred ((l + pred block) / block) do
+    decrypt_one ~key ~data ~off:(i * block) dst
+  done;
+  Mirage_crypto.Uncommon.unsafe_xor_into iv ~src_off:0 dst ~dst_off:0 block;
+  Mirage_crypto.Uncommon.unsafe_xor_into data ~src_off:0 dst ~dst_off:block (l - block);
+  Bytes.unsafe_to_string dst