Commit 9e411780 authored by Stephane Glondu's avatar Stephane Glondu

Add platform AES-CCM primitives

parent 71f98814
......@@ -25,6 +25,10 @@ val pbkdf2_hex : iterations:int -> salt:string -> string -> string
val aes_hex : key:string -> data:string -> string
(** [key] and [iv] in hex, [plaintext] UTF8 string, [ciphertext] in hex *)
val encrypt : key:string -> iv:string -> plaintext:string -> string
val decrypt : key:string -> iv:string -> ciphertext:string -> string
type rng
val secure_rng : rng
val pseudo_rng : string -> rng
......
......@@ -29,6 +29,14 @@ let hex_toBits x =
Js.Unsafe.meth_call sjcl "codec.hex.toBits"
[| Js.string x |> Js.Unsafe.inject |]
let utf8String_fromBits x =
Js.Unsafe.meth_call sjcl "codec.utf8String.fromBits"
[| x |] |> Js.to_string
let utf8String_toBits x =
Js.Unsafe.meth_call sjcl "codec.utf8String.toBits"
[| Js.string x |> Js.Unsafe.inject |]
let sha256 x =
Js.Unsafe.meth_call sjcl "hash.sha256.hash"
[| Js.string x |> Js.Unsafe.inject |]
......@@ -63,6 +71,22 @@ let aes_hex ~key ~data =
let output = Js.Unsafe.meth_call cipher "encrypt" [| data |] in
hex_fromBits output
let encrypt ~key ~iv ~plaintext =
let key = hex_toBits key in
let iv = hex_toBits iv in
let plaintext = utf8String_toBits plaintext in
let prf = Js.Unsafe.(new_obj (get sjcl "cipher.aes") [| key |]) in
let ciphertext = Js.Unsafe.meth_call sjcl "mode.ccm.encrypt" [| prf; plaintext; iv |] in
hex_fromBits ciphertext
let decrypt ~key ~iv ~ciphertext =
let key = hex_toBits key in
let iv = hex_toBits iv in
let ciphertext = hex_toBits ciphertext in
let prf = Js.Unsafe.(new_obj (get sjcl "cipher.aes") [| key |]) in
let plaintext = Js.Unsafe.meth_call sjcl "mode.ccm.decrypt" [| prf; ciphertext; iv |] in
utf8String_fromBits plaintext
type rng = unit -> unit
let sjcl_random = Js.Unsafe.get sjcl "random"
......
......@@ -76,6 +76,118 @@ let aes_hex ~key ~data =
let output = transform_string (Cipher.(aes ~mode:ECB key Encrypt)) data in
transform_string (Hexa.encode ()) output
let read_i32 str i =
let open Int32 in
let (!) x = of_int (int_of_char str.[i+x]) in
logor (shift_left !0 24) (logor (shift_left !1 16) (logor (shift_left !2 8) !3))
let export_i32 x =
let open Int32 in
let (!) i = String.make 1 (char_of_int (to_int (logand 0xffl (shift_right_logical x i)))) in
!24 ^ !16 ^ !8 ^ !0
let xor128 x y =
let r = Bytes.create 16 in
for i = 0 to 15 do
Bytes.set r i (char_of_int (int_of_char x.[i] lxor int_of_char y.[i]))
done;
Bytes.to_string r
(********** Functions directly translated from SJCL **********)
let ccm_computeTag prf plaintext iv adata tlen ll =
let l = String.length plaintext in
let plaintext = plaintext ^ "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" in
let tlen = tlen / 8 in
if tlen mod 2 <> 0 || tlen < 4 || tlen > 16 then invalid_arg "ccm: invalid tag length";
let flags =
(if String.length adata <> 0 then 1 lsl 6 else 0)
lor ((tlen - 2) lsl 2) lor (ll - 1)
in
let mac = String.make 1 (char_of_int flags) ^ iv ^ "\000\000\000\000\000\000\000\000\000\000\000\000" in
(* works only for "small enough" plaintext (length < 31 bits) *)
let a = read_i32 mac 12 in
let a = Int32.(logor a (of_int l)) in
let mac = String.sub mac 0 12 ^ export_i32 a in
let mac = ref (prf mac) in
if String.length adata <> 0 then invalid_arg "ccm: adata not supported";
let i = ref 0 in
while !i < l do
mac := prf (xor128 !mac (String.sub plaintext !i 16));
i := !i + 16;
done;
String.sub !mac 0 tlen
let ccm_ctrMode prf data iv tag tlen ll =
let l = String.length data in
let data = data ^ "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" in
let ctr = String.make 1 (char_of_int (ll - 1)) ^ iv ^ "\000\000\000\000\000\000\000\000\000\000\000\000" in
let ctr = ref (String.sub ctr 0 16) in
let tag = tag ^ "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" in
let tag = String.sub (xor128 (prf !ctr) tag) 0 (tlen / 8) in
let i = ref 0 in
let res = ref "" in
while !i < l do
(* works only for "small enough" plaintexts (length < 31 bits) *)
let c = Int32.succ (read_i32 !ctr 12) in
ctr := String.sub !ctr 0 12 ^ export_i32 c;
res := !res ^ (xor128 (prf !ctr) (String.sub data !i 16));
i := !i + 16;
done;
String.sub !res 0 l, tag
let ccm_encrypt prf plaintext iv adata tlen =
let ivl = String.length iv in
let ol = String.length plaintext in
if ivl < 7 then invalid_arg "ccm: iv must be at least 7 bytes";
let l =
let l = ref 2 in
while !l < 4 && (ol asr (8 * !l) <> 0) do incr l done;
if !l < 15 - ivl then l := 15 - ivl;
!l
in
let iv = String.sub iv 0 (15 - l) in
let tag = ccm_computeTag prf plaintext iv adata tlen l in
let out, tag = ccm_ctrMode prf plaintext iv tag tlen l in
out ^ tag
let ccm_decrypt prf ciphertext iv adata tlen =
let ivl = String.length iv in
let ol = String.length ciphertext - tlen / 8 in
let out = String.sub ciphertext 0 ol in
let tag = String.sub ciphertext ol (String.length ciphertext - ol) in
if ivl < 7 then invalid_arg "ccm: iv must be at least 7 bytes";
let l =
let l = ref 2 in
while !l < 4 && (ol asr (8 * !l) <> 0) do incr l done;
if !l < 15 - ivl then l := 15 - ivl;
!l
in
let iv = String.sub iv 0 (15 - l) in
let out, tag = ccm_ctrMode prf out iv tag tlen l in
let tag2 = ccm_computeTag prf out iv adata tlen l in
if tag <> tag2 then invalid_arg "ccm: tag doesn't match";
out
(********** End of SJCL functions **********)
let encrypt ~key ~iv ~plaintext =
let open Cryptokit in
let key = transform_string (Hexa.decode ()) key in
let iv = transform_string (Hexa.decode ()) iv in
let prf x = transform_string (Cipher.(aes ~mode:ECB key Encrypt)) x in
let ciphertext = ccm_encrypt prf plaintext iv "" 64 in
transform_string (Hexa.encode ()) ciphertext
let decrypt ~key ~iv ~ciphertext =
let open Cryptokit in
let key = transform_string (Hexa.decode ()) key in
let iv = transform_string (Hexa.decode ()) iv in
let ciphertext = transform_string (Hexa.decode ()) ciphertext in
let prf x = transform_string (Cipher.(aes ~mode:ECB key Encrypt)) x in
let plaintext = ccm_decrypt prf ciphertext iv "" 64 in
plaintext
type rng = Cryptokit.Random.rng
let secure_rng =
......
......@@ -74,7 +74,13 @@ module Tests = struct
let j = Z.of_bits "\x81\xab\xd3\xed\x0b\x19\x2e\x40\x7a\xca" in
let k = Z.of_string "956173156978067279948673" in
check "of_bits" (fun () -> Z.(j =% k));
check "AES" (fun () -> aes_hex ~key:"0000000000000000000000000000000000000000000000000000000000000000" ~data:"00000000000000000000000000000000" = "dc95c078a2408989ad48a21492842087");
let key = "0000000000000000000000000000000000000000000000000000000000000000" in
let iv = "00000000000000000000000000000000" in
check "AES" (fun () -> aes_hex ~key ~data:iv = "dc95c078a2408989ad48a21492842087");
let plaintext = "Lorem ipsum dolor sit amet, consectetur adipiscing elit." in
let ciphertext = "91f136cd65db6fa83b4943395e388089d4a8d0531b43a24a6498a1433559039ce5a18734752e13418718be1c2da5cca3d89e6e62fb729a81ec1cb3d1174e770c" in
check "AES-CCM-encrypt" (fun () -> encrypt ~key ~iv ~plaintext = ciphertext);
check "AES-CCM-decrypt" (fun () -> decrypt ~key ~iv ~ciphertext = plaintext);
Printf.ksprintf alert "%d tests were successful!" !ntests
let cmds = ["do_unit_tests", unit_tests]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment