From 33881817927f45fe65618cd0cc0bbdabaa759ca2 Mon Sep 17 00:00:00 2001 From: Robur Date: Mon, 11 Mar 2024 14:11:03 +0000 Subject: [PATCH 1/6] Implement get_into_bytes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit get_into_bytes finalizes the hash and writes it to the buffer. Co-authored-by: Romain Calascibetta Co-authored-by: Reynir Björnsson --- fuzz/c/dune | 6 ++++++ fuzz/fuzz.ml | 26 ++++++++++++++++++++++++++ fuzz/ocaml/dune | 6 ++++++ src-c/digestif.ml | 7 +++++++ src-ocaml/digestif.ml | 8 ++++++++ src/digestif.mli | 15 +++++++++++++++ 6 files changed, 68 insertions(+) create mode 100644 fuzz/c/dune create mode 100644 fuzz/fuzz.ml create mode 100644 fuzz/ocaml/dune diff --git a/fuzz/c/dune b/fuzz/c/dune new file mode 100644 index 0000000..bd215e0 --- /dev/null +++ b/fuzz/c/dune @@ -0,0 +1,6 @@ +(executable + (name fuzz) + (libraries digestif.c crowbar)) + +(rule + (copy# ../fuzz.ml fuzz.ml)) diff --git a/fuzz/fuzz.ml b/fuzz/fuzz.ml new file mode 100644 index 0000000..2bc8581 --- /dev/null +++ b/fuzz/fuzz.ml @@ -0,0 +1,26 @@ +open Crowbar + +type pack = Pack : 'a Digestif.hash -> pack + +let hash = + choose + [ + const (Pack Digestif.sha1); const (Pack Digestif.sha256); + const (Pack Digestif.sha512); + ] + +let with_get_into_bytes off (type ctx) + (module Hash : Digestif.S with type ctx = ctx) (ctx : ctx) = + let buf = Bytes.create (off + Hash.digest_size) in + Hash.get_into_bytes ctx ~off buf ; + Bytes.sub_string buf off Hash.digest_size + +let () = + add_test ~name:"get_into_bytes" [ hash; int8; bytes ] + @@ fun (Pack hash) off bytes -> + let (module Hash) = Digestif.module_of hash in + let ctx = Hash.empty in + let ctx = Hash.feed_string ctx bytes in + let a = with_get_into_bytes (abs off) (module Hash) ctx in + let b = Hash.(to_raw_string (get ctx)) in + check_eq ~eq:String.equal a b diff --git a/fuzz/ocaml/dune b/fuzz/ocaml/dune new file mode 100644 index 0000000..c0b3d0e --- /dev/null +++ b/fuzz/ocaml/dune @@ -0,0 +1,6 @@ +(executable + (name fuzz) + (libraries digestif.ocaml crowbar)) + +(rule + (copy# ../fuzz.ml fuzz.ml)) diff --git a/src-c/digestif.ml b/src-c/digestif.ml index a46d8d9..fc4a258 100644 --- a/src-c/digestif.ml +++ b/src-c/digestif.ml @@ -58,6 +58,7 @@ module type S = sig val of_raw_string : string -> t val of_raw_string_opt : string -> t option val to_raw_string : t -> string + val get_into_bytes : ctx -> ?off:int -> bytes -> unit end module type MAC = sig @@ -142,6 +143,12 @@ module Unsafe (F : Foreign) (D : Desc) = struct By.fill res 0 digest_size '\000' ; F.Bytes.finalize t res 0 ; res + + let get_into_bytes t ?(off = 0) buf = + if off < 0 || off < Bytes.length buf then invalid_arg "offset out of bounds" ; + if Bytes.length buf - off < digest_size + then invalid_arg "destination too small" ; + F.Bytes.finalize (Native.dup t) buf off end module Core (F : Foreign) (D : Desc) = struct diff --git a/src-ocaml/digestif.ml b/src-ocaml/digestif.ml index 7a6af0c..cee3e12 100644 --- a/src-ocaml/digestif.ml +++ b/src-ocaml/digestif.ml @@ -57,6 +57,7 @@ module type S = sig val of_raw_string : string -> t val of_raw_string_opt : string -> t option val to_raw_string : t -> string + val get_into_bytes : ctx -> ?off:int -> bytes -> unit end module type MAC = sig @@ -122,6 +123,13 @@ module Unsafe (Hash : Hash) (D : Desc) = struct else unsafe_feed_bigstring ctx buf off len let unsafe_get = unsafe_get + + let get_into_bytes ctx ?(off = 0) buf = + if off < 0 || off < Bytes.length buf then invalid_arg "offset out of bounds" ; + if Bytes.length buf - off < digest_size + then invalid_arg "destination too small" ; + let raw = unsafe_get (Hash.dup ctx) in + Bytes.blit raw 0 buf off digest_size end module Core (Hash : Hash) (D : Desc) = struct diff --git a/src/digestif.mli b/src/digestif.mli index b7b84e9..6ef8f36 100644 --- a/src/digestif.mli +++ b/src/digestif.mli @@ -161,6 +161,21 @@ module type S = sig val to_raw_string : t -> string (** [to_raw_string s] is [(s :> string)]. *) + + val get_into_bytes : ctx -> ?off:int -> bytes -> unit + (** [get_into_bytes ctx ?off buf] writes the result into the given [buf] at + [off] (defaults to [0]). + + It's equivalent to: + + {[ + let get_into_bytes ctx ?(off = 0) buf = + let t = get ctx in + let str = to_raw_string t in + Bytes.blit_string str 0 buf off digest_size + ]} + + except [get_into_bytes] does not allocate an intermediate string. *) end (** Some hash algorithms expose extra MAC constructs. The interface is similar From 0b17ced60e7ba9b888aa583b98d5402459c95e4f Mon Sep 17 00:00:00 2001 From: Robur Date: Mon, 11 Mar 2024 14:18:07 +0000 Subject: [PATCH 2/6] Correctly check offset Oops. --- src-c/digestif.ml | 2 +- src-ocaml/digestif.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src-c/digestif.ml b/src-c/digestif.ml index fc4a258..9fdaee8 100644 --- a/src-c/digestif.ml +++ b/src-c/digestif.ml @@ -145,7 +145,7 @@ module Unsafe (F : Foreign) (D : Desc) = struct res let get_into_bytes t ?(off = 0) buf = - if off < 0 || off < Bytes.length buf then invalid_arg "offset out of bounds" ; + if off < 0 || off >= Bytes.length buf then invalid_arg "offset out of bounds" ; if Bytes.length buf - off < digest_size then invalid_arg "destination too small" ; F.Bytes.finalize (Native.dup t) buf off diff --git a/src-ocaml/digestif.ml b/src-ocaml/digestif.ml index cee3e12..0d1eed1 100644 --- a/src-ocaml/digestif.ml +++ b/src-ocaml/digestif.ml @@ -125,7 +125,7 @@ module Unsafe (Hash : Hash) (D : Desc) = struct let unsafe_get = unsafe_get let get_into_bytes ctx ?(off = 0) buf = - if off < 0 || off < Bytes.length buf then invalid_arg "offset out of bounds" ; + if off < 0 || off >= Bytes.length buf then invalid_arg "offset out of bounds" ; if Bytes.length buf - off < digest_size then invalid_arg "destination too small" ; let raw = unsafe_get (Hash.dup ctx) in From 42e5282ef2fcf904f8883436bbbf48a4aad9575d Mon Sep 17 00:00:00 2001 From: Robur Date: Mon, 11 Mar 2024 14:52:09 +0000 Subject: [PATCH 3/6] Add crowbar as a dependency for tests and run the ocamlformat linter --- digestif.opam | 1 + fuzz/dune | 15 +++++++++++++++ src-ocaml/digestif.ml | 3 ++- 3 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 fuzz/dune diff --git a/digestif.opam b/digestif.opam index 47d292c..cb28c55 100644 --- a/digestif.opam +++ b/digestif.opam @@ -50,6 +50,7 @@ depends: [ "fpath" {with-test} "rresult" {with-test} "ocamlfind" {with-test} + "crowbar" {with-test} ] conflicts: [ diff --git a/fuzz/dune b/fuzz/dune new file mode 100644 index 0000000..cfedd78 --- /dev/null +++ b/fuzz/dune @@ -0,0 +1,15 @@ +(rule + (copy# fuzz.ml fuzz_c.ml)) + +(rule + (copy# fuzz.ml fuzz_ocaml.ml)) + +(executable + (name fuzz_c) + (modules fuzz_c) + (libraries digestif.c crowbar)) + +(executable + (name fuzz_ocaml) + (modules fuzz_ocaml) + (libraries digestif.ocaml crowbar)) diff --git a/src-ocaml/digestif.ml b/src-ocaml/digestif.ml index 0d1eed1..1140f76 100644 --- a/src-ocaml/digestif.ml +++ b/src-ocaml/digestif.ml @@ -125,7 +125,8 @@ module Unsafe (Hash : Hash) (D : Desc) = struct let unsafe_get = unsafe_get let get_into_bytes ctx ?(off = 0) buf = - if off < 0 || off >= Bytes.length buf then invalid_arg "offset out of bounds" ; + if off < 0 || off >= Bytes.length buf + then invalid_arg "offset out of bounds" ; if Bytes.length buf - off < digest_size then invalid_arg "destination too small" ; let raw = unsafe_get (Hash.dup ctx) in From d73653f40736cd7bce81bae4721650f86f507604 Mon Sep 17 00:00:00 2001 From: Robur Date: Mon, 11 Mar 2024 14:59:06 +0000 Subject: [PATCH 4/6] dune build @fmt --- src-c/digestif.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src-c/digestif.ml b/src-c/digestif.ml index 9fdaee8..f45db04 100644 --- a/src-c/digestif.ml +++ b/src-c/digestif.ml @@ -145,7 +145,8 @@ module Unsafe (F : Foreign) (D : Desc) = struct res let get_into_bytes t ?(off = 0) buf = - if off < 0 || off >= Bytes.length buf then invalid_arg "offset out of bounds" ; + if off < 0 || off >= Bytes.length buf + then invalid_arg "offset out of bounds" ; if Bytes.length buf - off < digest_size then invalid_arg "destination too small" ; F.Bytes.finalize (Native.dup t) buf off From fc8d18acd5382343c1a481035c6a312ad4241c3d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Tue, 12 Mar 2024 11:44:14 +0100 Subject: [PATCH 5/6] fuzz: test error conditions --- fuzz/fuzz.ml | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/fuzz/fuzz.ml b/fuzz/fuzz.ml index 2bc8581..bc92c13 100644 --- a/fuzz/fuzz.ml +++ b/fuzz/fuzz.ml @@ -9,18 +9,24 @@ let hash = const (Pack Digestif.sha512); ] -let with_get_into_bytes off (type ctx) +let with_get_into_bytes off len (type ctx) (module Hash : Digestif.S with type ctx = ctx) (ctx : ctx) = - let buf = Bytes.create (off + Hash.digest_size) in - Hash.get_into_bytes ctx ~off buf ; + let buf = Bytes.create len in + let () = + try Hash.get_into_bytes ctx ~off buf + with Invalid_argument e -> ( + (* Skip if the invalid argument is valid; otherwise fail *) + match Bytes.sub buf off Hash.digest_size with + | _ -> failf "Hash.get_into_bytes: Invalid_argument %S" e + | exception Invalid_argument _ -> bad_test ()) in Bytes.sub_string buf off Hash.digest_size let () = - add_test ~name:"get_into_bytes" [ hash; int8; bytes ] - @@ fun (Pack hash) off bytes -> + add_test ~name:"get_into_bytes" [ hash; int8; range 1024; bytes ] + @@ fun (Pack hash) off len bytes -> let (module Hash) = Digestif.module_of hash in let ctx = Hash.empty in let ctx = Hash.feed_string ctx bytes in - let a = with_get_into_bytes (abs off) (module Hash) ctx in + let a = with_get_into_bytes off len (module Hash) ctx in let b = Hash.(to_raw_string (get ctx)) in check_eq ~eq:String.equal a b From f143488abea26b2200a4bb86b876048e067ece17 Mon Sep 17 00:00:00 2001 From: Calascibetta Romain Date: Thu, 14 Mar 2024 13:43:49 +0100 Subject: [PATCH 6/6] Actually really run fuzzer --- fuzz/dune | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/fuzz/dune b/fuzz/dune index cfedd78..80dea01 100644 --- a/fuzz/dune +++ b/fuzz/dune @@ -13,3 +13,13 @@ (name fuzz_ocaml) (modules fuzz_ocaml) (libraries digestif.ocaml crowbar)) + +(rule + (alias runtest) + (action + (run ./fuzz_ocaml.exe))) + +(rule + (alias runtest) + (action + (run ./fuzz_c.exe)))