From 90d20af5326681223f33b05455f06c150d0b3129 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 5 Apr 2024 10:47:05 +0200 Subject: [PATCH 1/4] Implement feedable hmac Analogous to `ctx` and `feed_*` but for computing hmacs incrementally. For when `hmaci_*` is not suitable. --- src-c/digestif.ml | 56 ++++++++++++++++++++++++++++--------------- src-ocaml/digestif.ml | 56 ++++++++++++++++++++++++++++--------------- src/digestif.mli | 29 ++++++++++++++++++++++ 3 files changed, 103 insertions(+), 38 deletions(-) diff --git a/src-c/digestif.ml b/src-c/digestif.ml index 5cfceec..c3cfa43 100644 --- a/src-c/digestif.ml +++ b/src-c/digestif.ml @@ -18,6 +18,7 @@ module type S = sig val digest_size : int type ctx + type hmac type t val empty : ctx @@ -29,6 +30,14 @@ module type S = sig val feedi_string : ctx -> String.t iter -> ctx val feedi_bigstring : ctx -> bigstring iter -> ctx val get : ctx -> t + val hmac_init : key:string -> hmac + val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac + val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac + val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac + val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac + val hmac_feedi_string : hmac -> String.t iter -> hmac + val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac + val hmac_get : hmac -> t val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t val digest_string : ?off:int -> ?len:int -> String.t -> t val digest_bigstring : ?off:int -> ?len:int -> bigstring -> t @@ -211,6 +220,8 @@ end module Make (F : Foreign) (D : Desc) = struct include Core (F) (D) + type hmac = ctx * string + let bytes_opad = By.make block_size '\x5c' let bytes_ipad = By.make block_size '\x36' @@ -220,33 +231,40 @@ module Make (F : Foreign) (D : Desc) = struct | -1 -> By.rpad (By.unsafe_of_string key) block_size '\000' | _ -> By.of_string key - let hmaci_bytes ~key iter = + let hmac_init ~key = let key = norm_bytes key in let outer = Native.XOR.Bytes.xor key bytes_opad in let inner = Native.XOR.Bytes.xor key bytes_ipad in let ctx = feed_bytes empty inner in - let res = feedi_bytes ctx iter |> get in - let ctx = feed_bytes empty outer in - feed_string ctx (res :> string) |> get + (ctx, Bytes.unsafe_to_string outer) + + let hmac_feed_bytes (t, outer) ?off ?len buf = + (feed_bytes t ?off ?len buf, outer) + + let hmac_feed_string (t, outer) ?off ?len buf = + (feed_string t ?off ?len buf, outer) + + let hmac_feed_bigstring (t, outer) ?off ?len buf = + (feed_bigstring t ?off ?len buf, outer) + + let hmac_get (ctx, outer) = + feed_string (feed_string empty outer) (get ctx) |> get + + let hmac_feedi_bytes (t, outer) iter = (feedi_bytes t iter, outer) + let hmac_feedi_string (t, outer) iter = (feedi_string t iter, outer) + let hmac_feedi_bigstring (t, outer) iter = (feedi_bigstring t iter, outer) + + let hmaci_bytes ~key iter = + let t = hmac_init ~key in + hmac_feedi_bytes t iter |> hmac_get let hmaci_string ~key iter = - let key = norm_bytes key in - (* XXX(dinosaure): safe, [rpad] and [digest] have a read-only access. *) - let outer = Native.XOR.Bytes.xor key bytes_opad in - let inner = Native.XOR.Bytes.xor key bytes_ipad in - let ctx = feed_bytes empty inner in - let res = feedi_string ctx iter |> get in - let ctx = feed_bytes empty outer in - feed_string ctx (res :> string) |> get + let t = hmac_init ~key in + hmac_feedi_string t iter |> hmac_get let hmaci_bigstring ~key iter = - let key = norm_bytes key in - let outer = Native.XOR.Bytes.xor key bytes_opad in - let inner = Native.XOR.Bytes.xor key bytes_ipad in - let ctx = feed_bytes empty inner in - let res = feedi_bigstring ctx iter |> get in - let ctx = feed_bytes empty outer in - feed_string ctx (res :> string) |> get + let t = hmac_init ~key in + hmac_feedi_bigstring t iter |> hmac_get let hmac_bytes ~key ?off ?len buf = let buf = diff --git a/src-ocaml/digestif.ml b/src-ocaml/digestif.ml index 56d6ecc..fab088a 100644 --- a/src-ocaml/digestif.ml +++ b/src-ocaml/digestif.ml @@ -17,6 +17,7 @@ module type S = sig val digest_size : int type ctx + type hmac type t val empty : ctx @@ -28,6 +29,14 @@ module type S = sig val feedi_string : ctx -> String.t iter -> ctx val feedi_bigstring : ctx -> bigstring iter -> ctx val get : ctx -> t + val hmac_init : key:string -> hmac + val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac + val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac + val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac + val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac + val hmac_feedi_string : hmac -> String.t iter -> hmac + val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac + val hmac_get : hmac -> t val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t val digest_string : ?off:int -> ?len:int -> String.t -> t val digest_bigstring : ?off:int -> ?len:int -> bigstring -> t @@ -192,6 +201,8 @@ end module Make (H : Hash) (D : Desc) = struct include Core (H) (D) + type hmac = ctx * string + let bytes_opad = By.init block_size (fun _ -> '\x5c') let bytes_ipad = By.init block_size (fun _ -> '\x36') @@ -201,33 +212,40 @@ module Make (H : Hash) (D : Desc) = struct | -1 -> By.rpad (Bytes.unsafe_of_string key) block_size '\000' | _ -> By.of_string key - let hmaci_bytes ~key iter = + let hmac_init ~key = let key = norm_bytes key in let outer = Xor.Bytes.xor key bytes_opad in let inner = Xor.Bytes.xor key bytes_ipad in let ctx = feed_bytes empty inner in - let res = feedi_bytes ctx iter |> get in - let ctx = feed_bytes empty outer in - feed_string ctx (res :> string) |> get + (ctx, Bytes.unsafe_to_string outer) + + let hmac_feed_bytes (t, outer) ?off ?len buf = + (feed_bytes t ?off ?len buf, outer) + + let hmac_feed_string (t, outer) ?off ?len buf = + (feed_string t ?off ?len buf, outer) + + let hmac_feed_bigstring (t, outer) ?off ?len buf = + (feed_bigstring t ?off ?len buf, outer) + + let hmac_get (ctx, outer) = + feed_string (feed_string empty outer) (get ctx) |> get + + let hmac_feedi_bytes (t, outer) iter = (feedi_bytes t iter, outer) + let hmac_feedi_string (t, outer) iter = (feedi_string t iter, outer) + let hmac_feedi_bigstring (t, outer) iter = (feedi_bigstring t iter, outer) + + let hmaci_bytes ~key iter = + let t = hmac_init ~key in + hmac_feedi_bytes t iter |> hmac_get let hmaci_string ~key iter = - let key = norm_bytes key in - (* XXX(dinosaure): safe, [rpad] and [digest] have a read-only access. *) - let outer = Xor.Bytes.xor key bytes_opad in - let inner = Xor.Bytes.xor key bytes_ipad in - let ctx = feed_bytes empty inner in - let res = feedi_string ctx iter |> get in - let ctx = feed_bytes empty outer in - feed_string ctx (res :> string) |> get + let t = hmac_init ~key in + hmac_feedi_string t iter |> hmac_get let hmaci_bigstring ~key iter = - let key = norm_bytes key in - let outer = Xor.Bytes.xor key bytes_opad in - let inner = Xor.Bytes.xor key bytes_ipad in - let ctx = feed_bytes empty inner in - let res = feedi_bigstring ctx iter |> get in - let ctx = feed_bytes empty outer in - feed_string ctx (res :> string) |> get + let t = hmac_init ~key in + hmac_feedi_bigstring t iter |> hmac_get let hmac_bytes ~key ?off ?len buf = let buf = diff --git a/src/digestif.mli b/src/digestif.mli index d9388a1..4a93e60 100644 --- a/src/digestif.mli +++ b/src/digestif.mli @@ -18,6 +18,7 @@ module type S = sig (** Size of hash results, in bytes. *) type ctx + type hmac type t val empty : ctx @@ -49,6 +50,34 @@ module type S = sig val get : ctx -> t (** [get t] is the digest corresponding to [t]. *) + val hmac_init : key:string -> hmac + (** Create a new hmac state. *) + + val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac + (** [hmac_feed_bytes msg t] adds informations in [msg] to [t]. [hmac_feed] is + analogous to appending: + [hmac_feed (hmac_feed t msg1) msg2 = hmac_feed t + (append msg1 msg2)] *) + + val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac + (** Same as {!hmac_feed_bytes} but for {!String.t}. *) + + val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac + (** Same as {!hmac_feed_bytes} but for {!bigstring}. *) + + val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac + (** [hmac_feedi_bytes t iter = let r = ref t in iter (fun msg -> r := hmac_feed !r msg); + !r] *) + + val hmac_feedi_string : hmac -> String.t iter -> hmac + (** Same as {!hmac_feedi_bytes} but for {!String.t}. *) + + val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac + (** Same as {!hmac_feedi_bytes} but for {!bigstring}. *) + + val hmac_get : hmac -> t + (** [hmac_get t] is the hmac corresponding to [t]. *) + val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t (** [digest_bytes msg] is the digest of [msg]. From 73225030bb445295ebe06edc5edda4df34482052 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 5 Apr 2024 11:21:43 +0200 Subject: [PATCH 2/4] Add tests for feed --- test/test.ml | 59 +++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 49 insertions(+), 10 deletions(-) diff --git a/test/test.ml b/test/test.ml index 7c0eabd..f8cfc82 100644 --- a/test/test.ml +++ b/test/test.ml @@ -3,10 +3,11 @@ type _ s = Bytes : Bytes.t s | String : String.t s | Bigstring : bigstring s and bigstring = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -let title : type a k. [ `HMAC | `Digest ] -> k Digestif.hash -> a s -> string = +let title : type a k. [ `HMAC | `HMAC_feed | `Digest ] -> k Digestif.hash -> a s -> string = fun computation hash input -> let pp_computation ppf = function | `HMAC -> Fmt.string ppf "hmac" + | `HMAC_feed -> Fmt.string ppf "hmac_feed" | `Digest -> Fmt.string ppf "digest" in let pp_hash : type k. k Digestif.hash Fmt.t = fun ppf -> function @@ -52,6 +53,21 @@ let test_hmac : let result = Digestif.hmaci_bigstring hash ~key (fun f -> f input) in Alcotest.(check test_hash) title expect result +let test_hmac_feed : + type k a. a s -> k Digestif.hash -> string -> a -> k -> unit = + fun kind hash key input expect -> + let title = title `HMAC_feed hash kind in + let module H = (val Digestif.module_of hash) in + let test_hash = Alcotest.testable H.pp H.equal in + let hmac_ctx = H.hmac_init ~key in + let hmac_ctx = + match kind with + | Bytes -> H.hmac_feed_bytes hmac_ctx input + | String -> H.hmac_feed_string hmac_ctx input + | Bigstring -> H.hmac_feed_bigstring hmac_ctx input + in + Alcotest.check test_hash title expect (H.hmac_get hmac_ctx) + let test_digest : type k a. a s -> k Digestif.hash -> a -> k Digestif.t -> unit = fun kind hash input expect -> @@ -80,6 +96,18 @@ let make_hmac : fun ~name kind hash key input expect -> (name, `Quick, fun () -> test_hmac kind hash key input expect) +let make_hmac_feed : + type a k. + name:string -> + a s -> + k Digestif.hash -> + string -> + a -> + k -> + unit Alcotest.test_case = + fun ~name kind hash key input expect -> + (name, `Quick, fun () -> test_hmac_feed kind hash key input expect) + let make_digest : type a k. name:string -> @@ -104,6 +132,11 @@ let makes ~name kind hash keys inputs expects = (fun (key, input, expect) -> make_hmac ~name kind hash key input expect) (combine keys inputs expects) +let makes' ~name kind hash keys inputs expects = + List.map + (fun (key, input, expect) -> make_hmac_feed ~name kind hash key input expect) + (combine keys inputs expects) + let to_bigstring s = let ln = Bytes.length s in let bi = Bigarray.Array1.create Bigarray.Char Bigarray.c_layout ln in @@ -173,15 +206,18 @@ let results_sha224 = ] |> List.map (Digestif.of_hex Digestif.sha224) -let results_sha256 = - [ - "2178f5f21b4311607bf9347bcde5f6552edb9ec5aa13b954d53de2fbfd8b75de"; - "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843"; - "aa36cd61caddefe26b07ba1d3d07ea978ed575c9d1f921837dff9f73e019713e"; - "a7c8b53d68678a8e6e4d403c6b97cf0f82c4ef7b835c41039c0a73aa4d627d05"; - "b2a83b628f7e0da71c3879b81075775072d0d35935c62cc6c5a79b337ccccca1"; - ] - |> List.map (Digestif.of_hex Digestif.sha256) +let results_sha256, results_sha256' = + let raw_results_sha256 = + [ + "2178f5f21b4311607bf9347bcde5f6552edb9ec5aa13b954d53de2fbfd8b75de"; + "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843"; + "aa36cd61caddefe26b07ba1d3d07ea978ed575c9d1f921837dff9f73e019713e"; + "a7c8b53d68678a8e6e4d403c6b97cf0f82c4ef7b835c41039c0a73aa4d627d05"; + "b2a83b628f7e0da71c3879b81075775072d0d35935c62cc6c5a79b337ccccca1"; + ] + in + List.map (Digestif.of_hex Digestif.sha256) raw_results_sha256, + List.map Digestif.SHA256.of_hex raw_results_sha256 let results_sha384 = [ @@ -614,6 +650,9 @@ let tests () = ( "sha256 (bigstring)", makes ~name:"sha256" bigstring Digestif.sha256 keys_st inputs_bi results_sha256 ); + ( "sha256 (feed bytes)", + makes' ~name:"sha256" bytes Digestif.sha256 keys_st inputs_by + results_sha256' ); ( "sha384", makes ~name:"sha384" bytes Digestif.sha384 keys_st inputs_by results_sha384 ); From e09f8224c14eac31529aee12f2dca79e489cdd2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 5 Apr 2024 11:27:39 +0200 Subject: [PATCH 3/4] Make hmac feed test slightly more interesting --- test/test.ml | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/test/test.ml b/test/test.ml index f8cfc82..72112bf 100644 --- a/test/test.ml +++ b/test/test.ml @@ -60,13 +60,23 @@ let test_hmac_feed : let module H = (val Digestif.module_of hash) in let test_hash = Alcotest.testable H.pp H.equal in let hmac_ctx = H.hmac_init ~key in - let hmac_ctx = - match kind with - | Bytes -> H.hmac_feed_bytes hmac_ctx input - | String -> H.hmac_feed_string hmac_ctx input - | Bigstring -> H.hmac_feed_bigstring hmac_ctx input + let total_len = match kind with + | Bytes -> Bytes.length input + | String -> String.length input + | Bigstring -> Bigarray.Array1.dim input + in + let rec loop hmac_ctx off = + if off = total_len then hmac_ctx else + let len = min (total_len - off) 16 in + let hmac_ctx = + match kind with + | Bytes -> H.hmac_feed_bytes hmac_ctx ~off ~len input + | String -> H.hmac_feed_string hmac_ctx ~off ~len input + | Bigstring -> H.hmac_feed_bigstring hmac_ctx ~off ~len input + in + loop hmac_ctx (off + len) in - Alcotest.check test_hash title expect (H.hmac_get hmac_ctx) + Alcotest.check test_hash title expect (H.hmac_get (loop hmac_ctx 0)) let test_digest : type k a. a s -> k Digestif.hash -> a -> k Digestif.t -> unit = From ce05bc220f4a34a55ac1376314bfcaeda7cf8733 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 5 Apr 2024 12:53:57 +0200 Subject: [PATCH 4/4] Format --- test/test.ml | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/test/test.ml b/test/test.ml index 72112bf..c8d5cdf 100644 --- a/test/test.ml +++ b/test/test.ml @@ -3,7 +3,9 @@ type _ s = Bytes : Bytes.t s | String : String.t s | Bigstring : bigstring s and bigstring = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -let title : type a k. [ `HMAC | `HMAC_feed | `Digest ] -> k Digestif.hash -> a s -> string = +let title : + type a k. + [ `HMAC | `HMAC_feed | `Digest ] -> k Digestif.hash -> a s -> string = fun computation hash input -> let pp_computation ppf = function | `HMAC -> Fmt.string ppf "hmac" @@ -54,28 +56,28 @@ let test_hmac : Alcotest.(check test_hash) title expect result let test_hmac_feed : - type k a. a s -> k Digestif.hash -> string -> a -> k -> unit = - fun kind hash key input expect -> + type k a. a s -> k Digestif.hash -> string -> a -> k -> unit = + fun kind hash key input expect -> let title = title `HMAC_feed hash kind in let module H = (val Digestif.module_of hash) in let test_hash = Alcotest.testable H.pp H.equal in let hmac_ctx = H.hmac_init ~key in - let total_len = match kind with + let total_len = + match kind with | Bytes -> Bytes.length input | String -> String.length input - | Bigstring -> Bigarray.Array1.dim input - in + | Bigstring -> Bigarray.Array1.dim input in let rec loop hmac_ctx off = - if off = total_len then hmac_ctx else + if off = total_len + then hmac_ctx + else let len = min (total_len - off) 16 in let hmac_ctx = match kind with | Bytes -> H.hmac_feed_bytes hmac_ctx ~off ~len input | String -> H.hmac_feed_string hmac_ctx ~off ~len input - | Bigstring -> H.hmac_feed_bigstring hmac_ctx ~off ~len input - in - loop hmac_ctx (off + len) - in + | Bigstring -> H.hmac_feed_bigstring hmac_ctx ~off ~len input in + loop hmac_ctx (off + len) in Alcotest.check test_hash title expect (H.hmac_get (loop hmac_ctx 0)) let test_digest : type k a. a s -> k Digestif.hash -> a -> k Digestif.t -> unit @@ -144,7 +146,8 @@ let makes ~name kind hash keys inputs expects = let makes' ~name kind hash keys inputs expects = List.map - (fun (key, input, expect) -> make_hmac_feed ~name kind hash key input expect) + (fun (key, input, expect) -> + make_hmac_feed ~name kind hash key input expect) (combine keys inputs expects) let to_bigstring s = @@ -224,10 +227,9 @@ let results_sha256, results_sha256' = "aa36cd61caddefe26b07ba1d3d07ea978ed575c9d1f921837dff9f73e019713e"; "a7c8b53d68678a8e6e4d403c6b97cf0f82c4ef7b835c41039c0a73aa4d627d05"; "b2a83b628f7e0da71c3879b81075775072d0d35935c62cc6c5a79b337ccccca1"; - ] - in - List.map (Digestif.of_hex Digestif.sha256) raw_results_sha256, - List.map Digestif.SHA256.of_hex raw_results_sha256 + ] in + ( List.map (Digestif.of_hex Digestif.sha256) raw_results_sha256, + List.map Digestif.SHA256.of_hex raw_results_sha256 ) let results_sha384 = [