From 017da2a36475574225399d8995e46490c3f1b537 Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Tue, 11 Jul 2017 08:48:36 +0100 Subject: [PATCH] Add some fuzz tests When running the tests individually, it: - Found https://github.com/mirage/ocaml-cstruct/pull/160 in 17s. - Found an overflow in of_bigarray in 1s. - Found an overflow in sub in 1s. --- Makefile | 10 ++++- fuzz/fuzz.ml | 115 ++++++++++++++++++++++++++++++++++++++++++++++++ fuzz/jbuild | 5 +++ lib/cstruct.ml | 4 +- lib_test/jbuild | 2 +- 5 files changed, 132 insertions(+), 4 deletions(-) create mode 100644 fuzz/fuzz.ml create mode 100644 fuzz/jbuild diff --git a/Makefile b/Makefile index 6d669e33..0f9feaff 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -.PHONY: all clean +.PHONY: all clean fuzz all: jbuilder build @@ -9,6 +9,14 @@ clean: test: jbuilder runtest --dev +build-fuzz: + jbuilder build --dev fuzz/fuzz.exe + mkdir -p _build/in + echo > _build/in/empty + +fuzz: build-fuzz + afl-fuzz -i _build/in -o _build/out -- _build/default/fuzz/fuzz.exe @@ + REPO=../../mirage/opam-repository PACKAGES=$(REPO)/packages # until we have https://github.com/ocaml/opam-publish/issues/38 diff --git a/fuzz/fuzz.ml b/fuzz/fuzz.ml new file mode 100644 index 00000000..5a6bc0ca --- /dev/null +++ b/fuzz/fuzz.ml @@ -0,0 +1,115 @@ +open Crowbar + +let create x = + match Cstruct.create x with + | c -> assert (x >= 0); c + | exception Invalid_argument _ -> assert (x <= 0); bad_test () + +let create_sub x start len = + try + let c = Cstruct.create x in + Cstruct.sub c start len + with Invalid_argument _ -> bad_test () + +let cstruct = Choose [ + Map ([int8], create); + Map ([range 0x10000; int; int], create_sub); + ] + +let buffer = Map ([uint8], Bigarray.(Array1.create Char c_layout)) + +let pp_cstruct f c = Format.pp_print_string f (Cstruct.debug c) + +let () = + assert (Array.length Sys.argv = 2); (* Prevent accidentally running in quickcheck mode *) + add_test ~name:"blit" [cstruct; int; cstruct; int; int] (fun src srcoff dst dstoff len -> + try Cstruct.blit src srcoff dst dstoff len; Ok () + with Invalid_argument _ -> Ok () + ); + add_test ~name:"sexp" [buffer] (fun b -> + b |> Cstruct.sexp_of_buffer |> Cstruct.buffer_of_sexp + |> check_eq + ~cmp:(fun x y -> Cstruct.compare (Cstruct.of_bigarray x) (Cstruct.of_bigarray y)) + b + ); + add_test ~name:"of_bigarray" [buffer; Option int; Option int] (fun b off len -> + match Cstruct.of_bigarray b ?off ?len with + | c -> check (Cstruct.len c <= Bigarray.Array1.dim b) + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"get_char" [cstruct; int] (fun c off -> + let in_range = off >= 0 && off < Cstruct.len c in + match Cstruct.get_char c off with + | _ -> check in_range + | exception Invalid_argument _ -> check (not in_range) + ); + add_test ~name:"set_char" [cstruct; int] (fun c off -> + let in_range = off >= 0 && off < Cstruct.len c in + match Cstruct.set_char c off 'x' with + | () -> check in_range + | exception Invalid_argument _ -> check (not in_range) + ); + add_test ~name:"sub" [cstruct; int; int] (fun c off len -> + Fmt.pr "sub %d %d\n%!" off len; + match Cstruct.sub c off len with + | sub -> check (Cstruct.len sub <= Cstruct.len c); + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"shift" [cstruct; int] (fun c off -> + match Cstruct.shift c off with + | sub -> check (Cstruct.len sub <= Cstruct.len c); + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"copy" [cstruct; int; int] (fun c off len -> + match Cstruct.copy c off len with + | sub -> check (String.length sub <= Cstruct.len c); + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"blit_from_bytes" [bytes; int; cstruct; int; int] (fun src srcoff dst dstoff len -> + match Cstruct.blit_from_bytes src srcoff dst dstoff len with + | () -> Ok () + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"blit_to_bytes" [cstruct; int; bytes; int; int] (fun src srcoff dst dstoff len -> + match Cstruct.blit_to_bytes src srcoff dst dstoff len with + | () -> Ok () + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"memset" [cstruct; int] (fun c x -> + Cstruct.memset c x; Ok () + ); + add_test ~name:"set_len" [cstruct; int] (fun c x -> + match Cstruct.set_len c x with + | c2 -> check (Cstruct.len c2 <= Cstruct.len c) + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"add_len" [cstruct; int] (fun c x -> + match Cstruct.add_len c x with + | c2 -> check (Cstruct.len c2 <= Cstruct.len c) + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"split" [cstruct; Option int; int] (fun c start len -> + match Cstruct.split ?start c len with + | c1, c2 -> check (Cstruct.len c2 <= Cstruct.len c && Cstruct.len c1 <= Cstruct.len c) + | exception Invalid_argument _ -> Ok () + ); + add_test ~name:"BE.set_uint64" [cstruct; int] (fun c off -> + let in_range = off >= 0 && off < Cstruct.len c - 7 in + match Cstruct.BE.set_uint64 c off 42L with + | () -> check in_range + | exception Invalid_argument _ -> check (not in_range) + ); + add_test ~name:"lenv" [List cstruct] (fun cs -> + check (Cstruct.lenv cs >= 0) + ); + add_test ~name:"copyv" [List cstruct] (fun cs -> + ignore (Cstruct.copyv cs); Ok () + ); + add_test ~name:"fillv" [List cstruct; cstruct] (fun src dst -> + let copied, rest = Cstruct.fillv ~src ~dst in + check (copied + Cstruct.lenv rest = Cstruct.lenv src); + ); + add_test ~name:"concat" [List cstruct] (fun cs -> + let len = Cstruct.len (Cstruct.concat cs) in + check (len >= 0 && len >= Cstruct.lenv cs); + ); diff --git a/fuzz/jbuild b/fuzz/jbuild new file mode 100644 index 00000000..f1a8e468 --- /dev/null +++ b/fuzz/jbuild @@ -0,0 +1,5 @@ +(jbuild_version 1) + +(executable + ((name fuzz) + (libraries (cstruct crowbar fmt)))) diff --git a/lib/cstruct.ml b/lib/cstruct.ml index 05fa4d70..9d006134 100644 --- a/lib/cstruct.ml +++ b/lib/cstruct.ml @@ -85,7 +85,7 @@ let of_bigarray ?(off=0) ?len buffer = match len with | None -> dim - off | Some len -> len in - if off < 0 || len < 0 || off + len > dim then err_of_bigarray off len + if off < 0 || len < 0 || off + len < 0 || off + len > dim then err_of_bigarray off len else { buffer; off; len } let to_bigarray buffer = @@ -96,7 +96,7 @@ let create_unsafe len = { buffer ; len ; off = 0 } let check_bounds t len = - Bigarray.Array1.dim t.buffer >= len + len >= 0 && Bigarray.Array1.dim t.buffer >= len external check_alignment_bigstring : buffer -> int -> int -> bool = "caml_check_alignment_bigstring" diff --git a/lib_test/jbuild b/lib_test/jbuild index 764961f2..3beae763 100644 --- a/lib_test/jbuild +++ b/lib_test/jbuild @@ -12,4 +12,4 @@ (alias ((name runtest) (deps (bounds.exe)) - (action (run ${<})))) \ No newline at end of file + (action (run ${<}))))