From 9f9b003697ac901008affd7008c428109d1afc5e Mon Sep 17 00:00:00 2001 From: varobert Date: Wed, 4 Apr 2012 11:59:38 +0000 Subject: Better fuzzing options git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1868 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- checklink/Check.ml | 9 ++--- checklink/Frameworks.ml | 7 ---- checklink/Fuzz.ml | 88 ++++++++++++++++++++++++++++++++----------------- checklink/Validator.ml | 32 +++++++++++------- 4 files changed, 81 insertions(+), 55 deletions(-) (limited to 'checklink') diff --git a/checklink/Check.ml b/checklink/Check.ml index 34e6efd..dfefbfb 100644 --- a/checklink/Check.ml +++ b/checklink/Check.ml @@ -181,15 +181,12 @@ let mark_covered_fun_sym_ndx (ndx: int) ffw: f_framework = in ffw.sf.ef.chkd_fun_syms.(ndx) <- true; ffw - >>> ff_ef ^%= - add_range sym_begin sym_size align (Function_symbol(sym)) + >>> (ff_ef ^%= add_range sym_begin sym_size align (Function_symbol(sym))) >>> (ff_sf ^%= if not (is_well_aligned sym_ofs_local align) then ( sf_ef ^%= - add_log (ERROR( - "Symbol not correctly aligned in the ELF file" - )) + add_log (ERROR("Symbol not correctly aligned in the ELF file")) ) else id ) @@ -2928,7 +2925,7 @@ let check_elf_identification efw = >>> ef_checkb (ei.ei_data = ELFDATA2MSB || ei.ei_data = ELFDATA2LSB) "ELF should be MSB or LSB" >>> ef_checkb (ei.ei_version = EV_CURRENT) - "ELF identificatin version should be EV_CURRENT" + "ELF identification version should be EV_CURRENT" let check_elf_header efw: e_framework = let eh = efw.elf.e_hdr in diff --git a/checklink/Frameworks.ml b/checklink/Frameworks.ml index f63eb9a..fdd0769 100644 --- a/checklink/Frameworks.ml +++ b/checklink/Frameworks.ml @@ -103,12 +103,6 @@ let log = { get = (fun ef -> ef.log); set = (fun l ef -> { ef with log = l }); } -(* -let chkd_syms = { - get = (fun ef -> ef.chkd_syms); - set = (fun s ef -> { ef with chkd_syms = s }); -} -*) let ident_to_sym_ndx = { get = (fun sf -> sf.ident_to_sym_ndx); @@ -128,7 +122,6 @@ let add_range (start: int32) (length: int32) (align: int) (bcd: byte_chunk_desc) let stop = Int32.(sub (add start length) 1l) in { efw with - (*chkd_bytes_diet = ELFCoverage.r_add start stop efw.chkd_bytes_diet;*) chkd_bytes_list = (* Float constants can appear several times in the code, we don't want to add them multiple times *) diff --git a/checklink/Fuzz.ml b/checklink/Fuzz.ml index 56b665a..9653834 100644 --- a/checklink/Fuzz.ml +++ b/checklink/Fuzz.ml @@ -4,6 +4,8 @@ open ELF_types open Frameworks open Library +let fuzz_debug = ref false + let string_of_byte = Printf.sprintf "0x%02x" let full_range_of_byte elfmap byte = @@ -18,6 +20,16 @@ let range_of_byte elfmap byte = when the check went fine) to stdout. *) let fuzz_check elfmap bs byte old sdumps = + let is_error = function ERROR(_) -> true | _ -> false in + let (str, _, _) = bs in + let fuzz_description = + string_of_int32 (int_int32 byte) ^ " <- " ^ + string_of_byte (Char.code str.[byte]) ^ " (was " ^ + string_of_byte (Char.code old) ^ ") - " ^ + string_of_byte_chunk_desc (range_of_byte elfmap byte) + in + if !fuzz_debug + then print_endline fuzz_description; try (* The point here is to go all the way through the checks, and see whether the checker returns an ERROR or raises an exception. If not, then we @@ -25,27 +37,32 @@ let fuzz_check elfmap bs byte old sdumps = *) let elf = read_elf_bs bs in let efw = check_elf_nodump elf sdumps in - if List.exists (function ERROR(s) -> true | _ -> false) efw.log - then () (* finding an ERROR is expected *) - else (* not finding an ERROR is bad! This is reported. *) - let (str, _, _) = bs in - print_endline ( - string_of_int32 (int_int32 byte) ^ " <- " ^ - string_of_byte (Char.code str.[byte]) ^ " (was " ^ - string_of_byte (Char.code old) ^ ") - " ^ - string_of_byte_chunk_desc (range_of_byte elfmap byte) - ) + if List.exists is_error efw.log + then (* finding an ERROR is the expected behavior *) + begin + if !fuzz_debug + then print_endline ( + string_of_log_entry false (List.find is_error efw.log) + ) + end + else (* not finding an ERROR is bad thus reported *) + print_endline (fuzz_description ^ "DID NOT CAUSE AN ERROR!") with | Assert_failure(s, l, c) -> - Printf.eprintf "fuzz_check failed an assertion at %s (%d, %d)\n" s l c + if !fuzz_debug + then Printf.printf "fuzz_check failed an assertion at %s (%d, %d)\n" s l c | Match_failure(s, l, c) -> - Printf.eprintf "fuzz_check raised a match failure at %s (%d, %d)\n" s l c + if !fuzz_debug + then Printf.printf "fuzz_check raised a match failure at %s (%d, %d)\n" s l c | Not_found -> - Printf.eprintf "fuzz_check raised a not found exception\n" + if !fuzz_debug + then Printf.printf "fuzz_check raised a not found exception\n" | Invalid_argument(s) -> - Printf.eprintf "fuzz_check raised an invalid argument: %s\n" s + if !fuzz_debug + then Printf.printf "fuzz_check raised an invalid argument: %s\n" s | ELF_parsers.Unknown_endianness -> - Printf.eprintf "fuzz_check raised an unknown endianness exception\n" + if !fuzz_debug + then Printf.printf "fuzz_check raised an unknown endianness exception\n" (** Tries to prevent some easy-to-catch false positives. Some known false positives are however hard to predict. For instance, when the virtual @@ -136,21 +153,32 @@ let fuzz_loop elffilename sdumps = fuzz_loop_aux () in fuzz_loop_aux () +let rec fuzz_every_byte_once_aux elfmap bs sdumps (current: int): unit = + let (str, ofs, len) = bs in + if current = len / 8 (* len is in bits *) + then () + else ( + let fuzz = fuzz_byte str current in + if ok_fuzz elfmap str current fuzz + then ( + let str' = String.copy str in + str'.[current] <- fuzz; + fuzz_check elfmap (str', ofs, len) current str.[current] sdumps + ); + fuzz_every_byte_once_aux elfmap bs sdumps (current + 1) + ) + (** Fuzz each byte of the file once with a random new value *) let fuzz_every_byte_once elffilename sdumps = let elfmap = get_elfmap elffilename in - let (str, ofs, len) = Bitstring.bitstring_of_file elffilename in - let rec fuzz_every_byte_once_aux current limit = - if current = limit - then () - else ( - let fuzz = fuzz_byte str current in - if ok_fuzz elfmap str current fuzz - then ( - let str' = String.copy str in - str'.[current] <- fuzz; - fuzz_check elfmap (str', ofs, len) current str.[current] sdumps - ); - fuzz_every_byte_once_aux (current + 1) limit - ) - in fuzz_every_byte_once_aux 0 (len/8) + let bs = Bitstring.bitstring_of_file elffilename in + fuzz_every_byte_once_aux elfmap bs sdumps 0 + +(** Fuzz each byte of the file, then loop *) +let fuzz_every_byte_loop elffilename sdumps = + let elfmap = get_elfmap elffilename in + let bs = Bitstring.bitstring_of_file elffilename in + let rec fuzz_every_byte_loop_aux () = + fuzz_every_byte_once_aux elfmap bs sdumps 0; + fuzz_every_byte_loop_aux () + in fuzz_every_byte_loop_aux () diff --git a/checklink/Validator.ml b/checklink/Validator.ml index f91a131..c413c75 100644 --- a/checklink/Validator.ml +++ b/checklink/Validator.ml @@ -6,6 +6,7 @@ open Fuzz let elf_file = ref (None: string option) let sdump_files = ref ([] : string list) let option_fuzz = ref false +let option_bytefuzz = ref false let option_printelf = ref false let set_elf_file s = @@ -14,20 +15,24 @@ let set_elf_file s = | Some _ -> raise (Arg.Bad "multiple ELF executables given on command line") let options = [ + "-exe ", Arg.String set_elf_file, + "Specify the ELF executable file to analyze"; + "-debug", Arg.Set Check.debug, + "Print a detailed trace of verification"; + "-noexhaust", Arg.Clear Check.exhaustivity, + "Disable the exhaustivity check of ELF function and data symbols"; "-printelf", Arg.Set option_printelf, - "Print the contents of the unanalyzed ELF executable"; + "Print the contents of the unanalyzed ELF executable"; "-printelfmap", Arg.Set Check.print_elfmap, - "Print a map of the analyzed ELF executable"; - "-debug", Arg.Set Check.debug, - "Print a detailed trace of verification"; + "Print a map of the analyzed ELF executable"; "-dumpelfmap", Arg.Set Check.dump_elfmap, - "Dump an ELF map to .elfmap, for use with random fuzzing"; - "-exe ", Arg.String set_elf_file, - "Specify the ELF executable file to analyze"; + "Dump an ELF map to .elfmap, for use with random fuzzing"; "-fuzz", Arg.Set option_fuzz, - "Random fuzzing test"; - "-noexhaust", Arg.Clear Check.exhaustivity, - "Disable the exhaustivity check of ELF function and data symbols" + "Random fuzz testing"; + "-bytefuzz", Arg.Set option_bytefuzz, + "Random fuzz testing byte per byte"; + "-debugfuzz", Arg.Set Fuzz.fuzz_debug, + "Print a detailed trace of ongoing fuzz testing"; ] let anonymous arg = @@ -37,7 +42,7 @@ let anonymous arg = set_elf_file arg let usage = -"The CompCert C post-linking validator, version " ^ Configuration.version ^ " + "The CompCert C post-linking validator, version " ^ Configuration.version ^ " Usage: cchecklink [options] <.sdump files> In the absence of options, checks are performed and a short result is displayed. Options are:" @@ -50,7 +55,10 @@ let _ = exit 2 | Some elffilename -> let sdumps = List.rev !sdump_files in - if !option_fuzz then begin + if !option_bytefuzz then begin + Random.self_init(); + fuzz_every_byte_loop elffilename sdumps + end else if !option_fuzz then begin Random.self_init(); fuzz_loop elffilename sdumps end else if !option_printelf then begin -- cgit v1.2.3