├── .gitignore ├── CHANGES.md ├── LICENSE.md ├── README.md ├── afl-persistent.opam ├── aflPersistent.ml ├── aflPersistent.mli ├── config.sh ├── dune ├── dune-project ├── test.ml └── test ├── harness.ml ├── test.ml └── test.sh /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | afl-persistent.config 3 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v1.3 (13th Nov 2018) 2 | --------------------- 3 | 4 | Uses /bin/sh instead of /bin/bash to fix install problems 5 | 6 | v1.2 (22nd May 2017) 7 | --------------------- 8 | 9 | Allow installation on non-AFL switches. 10 | (Doesn't do much, but lets you use Crowbar in quickcheck mode) 11 | 12 | 13 | v1.1 (12th January 2017) 14 | --------------------- 15 | 16 | Improved stability of instrumentation output 17 | 18 | 19 | v1.0 (6th December 2016) 20 | --------------------- 21 | 22 | Initial release 23 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Stephen Dolan 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # afl-persistent - persistent-mode afl-fuzz for ocaml 2 | 3 | by using `AflPersistent.run`, you can fuzz things really fast: 4 | 5 | ```ocaml 6 | let f () = 7 | let s = read_line () in 8 | match Array.to_list (Array.init (String.length s) (String.get s)) with 9 | ['s'; 'e'; 'c'; 'r'; 'e'; 't'; ' '; 'c'; 'o'; 'd'; 'e'] -> failwith "uh oh" 10 | | _ -> () 11 | 12 | let _ = AflPersistent.run f 13 | ``` 14 | 15 | compile with a version of ocaml that supports afl. that means trunk 16 | for now, but the next release (4.05) will work too, and pass the 17 | `-afl-instrument` option to ocamlopt. 18 | -------------------------------------------------------------------------------- /afl-persistent.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "stephen.dolan@cl.cam.ac.uk" 3 | authors: ["Stephen Dolan"] 4 | homepage: "https://github.com/stedolan/ocaml-afl-persistent" 5 | bug-reports: "https://github.com/stedolan/ocaml-afl-persistent/issues" 6 | dev-repo: "git+https://github.com/stedolan/ocaml-afl-persistent.git" 7 | license: "MIT" 8 | build: [ 9 | [ "dune" "build" "-p" name "-j" jobs ] 10 | [ "./config.sh" ] 11 | ] 12 | depends: [ 13 | "ocaml" {>= "4.05"} 14 | "dune" {>= "2.9"} 15 | "base-unix" 16 | ] 17 | post-messages: [ 18 | "afl-persistent is installed, but since the current OCaml compiler does 19 | not enable AFL instrumentation by default, most packages will not be 20 | instrumented and fuzzing with afl-fuzz may not be effective. 21 | 22 | To globally enable AFL instrumentation, create an OCaml switch like: 23 | 24 | opam switch create %{ocaml:version}%+afl ocaml-variants.%{ocaml:version}%+options ocaml-option-afl" {success & afl-available & !afl-always} 25 | ] 26 | synopsis: "Use afl-fuzz in persistent mode" 27 | description: """ 28 | afl-fuzz normally works by repeatedly fork()ing the program being 29 | tested. using this package, you can run afl-fuzz in 'persistent mode', 30 | which avoids repeated forking and is much faster.""" 31 | -------------------------------------------------------------------------------- /aflPersistent.ml: -------------------------------------------------------------------------------- 1 | external reset_instrumentation : bool -> unit = "caml_reset_afl_instrumentation" 2 | external sys_exit : int -> 'a = "caml_sys_exit" 3 | 4 | let run ?(max_cycles = 1000) f = 5 | let _ = try ignore (Sys.getenv "##SIG_AFL_PERSISTENT##") with Not_found -> () in 6 | let persist = match Sys.getenv "__AFL_PERSISTENT" with 7 | | _ -> true 8 | | exception Not_found -> false in 9 | let pid = Unix.getpid () in 10 | if persist then begin 11 | reset_instrumentation true; 12 | for _ = 1 to max_cycles do 13 | f (); 14 | Unix.kill pid Sys.sigstop; 15 | reset_instrumentation false 16 | done; 17 | f (); 18 | sys_exit 0; 19 | end else 20 | f () 21 | 22 | -------------------------------------------------------------------------------- /aflPersistent.mli: -------------------------------------------------------------------------------- 1 | val run : ?max_cycles:int -> (unit -> unit) -> unit 2 | -------------------------------------------------------------------------------- /config.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | tmpdir="$(mktemp -d 2>/dev/null || mktemp -d -t 'mytmpdir')" 5 | curdir="$(pwd)" 6 | output="$(pwd)/afl-persistent.config" 7 | cd "$tmpdir" 8 | echo 'print_string "Hello"' > test.ml 9 | if ocamlopt -dcmm -c test.ml 2>&1 | grep -q caml_afl; then 10 | afl_always=true 11 | else 12 | afl_always=false 13 | fi 14 | rm test.* 15 | cd "$curdir" 16 | rmdir "$tmpdir" 17 | 18 | cat > "$output" < exit 0); 3 | failwith "AflPersistent.run failed" 4 | -------------------------------------------------------------------------------- /test/harness.ml: -------------------------------------------------------------------------------- 1 | external reset_instrumentation : bool -> unit = "caml_reset_afl_instrumentation" 2 | external sys_exit : int -> 'a = "caml_sys_exit" 3 | 4 | let name n = 5 | fst (Test.tests.(int_of_string n - 1)) 6 | let run n = 7 | snd (Test.tests.(int_of_string n - 1)) () 8 | 9 | let orig_random = Random.get_state () 10 | 11 | let () = 12 | (* Random.set_state orig_random; *) 13 | reset_instrumentation true; 14 | begin 15 | match Sys.argv with 16 | | [| _; "len" |] -> print_int (Array.length Test.tests); print_newline (); flush stdout 17 | | [| _; "name"; n |] -> print_string (name n); flush stdout 18 | | [| _; "1"; n |] -> run n 19 | | [| _; "2"; n |] -> run n; (* Random.set_state orig_random; *)reset_instrumentation false; run n 20 | | _ -> failwith "error" 21 | end; 22 | sys_exit 0 23 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | let opaque = Sys.opaque_identity 2 | 3 | let lists n = 4 | let l = opaque [n; n; n] in 5 | match List.rev l with 6 | | [a; b; c] when a = n && b = n && c = n -> () 7 | | _ -> assert false 8 | 9 | let fresh_exception x = 10 | opaque @@ 11 | let module M = struct 12 | exception E of int 13 | let throw () = raise (E x) 14 | end in 15 | try 16 | M.throw () 17 | with 18 | M.E n -> assert (n = x) 19 | 20 | let obj_with_closure x = 21 | opaque (object method foo = x end) 22 | 23 | let r = ref 42 24 | let state () = 25 | incr r; 26 | if !r > 43 then print_string "woo" else () 27 | 28 | let classes (x : int) = 29 | opaque @@ 30 | let module M = struct 31 | class a = object 32 | method foo = x 33 | end 34 | class c = object 35 | inherit a 36 | end 37 | end in 38 | let o = new M.c in 39 | assert (o#foo = x) 40 | 41 | 42 | class c_global = object 43 | method foo = 42 44 | end 45 | let obj_ordering () = opaque @@ 46 | (* Object IDs change, but should be in the same relative order *) 47 | let a = new c_global in 48 | let b = new c_global in 49 | if a < b then print_string "a" else print_string "b" 50 | 51 | let random () = opaque @@ 52 | (* as long as there's no self_init, this should be deterministic *) 53 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 54 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 55 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 56 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 57 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 58 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 59 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 60 | if Random.int 100 < 50 then print_string "a" else print_string "b"; 61 | if Random.int 100 < 50 then print_string "a" else print_string "b" 62 | 63 | let tests = 64 | [| ("lists", fun () -> lists 42); 65 | ("manylists", fun () -> for i = 1 to 10 do lists 42 done); 66 | ("exceptions", fun () -> fresh_exception 100); 67 | ("objects", fun () -> ignore (obj_with_closure 42)); 68 | (* ("state", state); *) (* this one should fail *) 69 | ("classes", fun () -> classes 42); 70 | ("obj_ordering", obj_ordering); 71 | (* ("random", random); *) 72 | |] 73 | 74 | -------------------------------------------------------------------------------- /test/test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | ocamlopt -c -afl-instrument test.ml 6 | ocamlopt -afl-inst-ratio 0 test.cmx harness.ml -o test 7 | 8 | NTESTS=`./test len` 9 | failures='' 10 | echo "running $NTESTS tests..." 11 | for t in `seq 1 $NTESTS`; do 12 | printf "%14s: " `./test name $t` 13 | # when run twice, the instrumentation output should double 14 | afl-showmap -q -o output-1 -- ./test 1 $t 15 | afl-showmap -q -o output-2 -- ./test 2 $t 16 | # see afl-showmap.c for what the numbers mean 17 | cat output-1 | sed ' 18 | s/:6/:7/; s/:5/:6/; 19 | s/:4/:5/; s/:3/:4/; 20 | s/:2/:4/; s/:1/:2/; 21 | ' > output-2-predicted 22 | if cmp -s output-2-predicted output-2; then 23 | echo "passed." 24 | else 25 | echo "failed:" 26 | paste output-2 output-1 27 | failures=1 28 | fi 29 | done 30 | 31 | if [ -z "$failures" ]; then echo "all tests passed"; fi 32 | 33 | rm -f {test,harness}.{cmi,cmx,o} test output-{1,2,2-predicted} 34 | --------------------------------------------------------------------------------