diff --git a/infer/src/backend/Tasks.ml b/infer/src/backend/Tasks.ml index c31f7de46..76cb27933 100644 --- a/infer/src/backend/Tasks.ml +++ b/infer/src/backend/Tasks.ml @@ -43,6 +43,7 @@ let run t = let fork_protect ~f x = + EventLogger.prepare () ; L.reset_formatters () ; ResultsDatabase.new_database_connection () ; f x @@ -56,6 +57,8 @@ module Runner = struct let start runner ~tasks = let pool = runner.pool in Queue.enqueue_all runner.all_continuations (Queue.to_list tasks.continuations) ; + (* Flush here all buffers to avoid passing unflushed data to forked processes, leading to duplication *) + Pervasives.flush_all () ; List.iter ~f:(fun x -> ProcessPool.start_child ~f:(fun f -> fork_protect ~f ()) ~pool x) tasks.closures diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index ebcb504a0..8657786a5 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -43,6 +43,8 @@ let setup () = ResultsDir.create_results_dir () | Explore -> ResultsDir.assert_results_dir "please run an infer analysis first" + | Events -> + ResultsDir.assert_results_dir "have you run infer before?" let print_active_checkers () = @@ -72,6 +74,17 @@ let log_environment_info () = print_active_checkers () +let prepare_events_logging () = + (* there's no point in logging data from the events command. To fetch them we'd need to run events again... *) + if CLOpt.equal_command Config.command CLOpt.Events then () + else ( + L.environment_info "Infer log identifier is %s\n" (EventLogger.get_log_identifier ()) ; + let log_uncaught_exn exn ~exitcode = + EventLogger.log (EventLogger.UncaughtException (exn, exitcode)) + in + L.set_log_uncaught_exception_callback log_uncaught_exn ) + + let () = ( if Config.linters_validate_syntax_only then match CTLParserHelper.validate_al_files () with @@ -82,6 +95,7 @@ let () = if Config.print_builtins then Builtin.print_and_exit () ; setup () ; log_environment_info () ; + prepare_events_logging () ; if Config.debug_mode && CLOpt.is_originator then L.progress "Logs in %s@." (Config.results_dir ^/ Config.log_file) ; ( match Config.command with @@ -126,5 +140,9 @@ let () = if is_error (Unix.waitpid (Unix.fork_exec ~prog ~argv:(prog :: args) ())) then L.external_error "** Error running the reporting script:@\n** %s %s@\n** See error above@." prog - (String.concat ~sep:" " args) ) ; + (String.concat ~sep:" " args) + | Events -> + EventLogger.dump () ) ; + (* to make sure the exitcode=0 case is logged, explicitly invoke exit *) L.exit 0 + diff --git a/infer/src/base/CommandDoc.ml b/infer/src/base/CommandDoc.ml index 9258c5fef..bcea91158 100644 --- a/infer/src/base/CommandDoc.ml +++ b/infer/src/base/CommandDoc.ml @@ -238,6 +238,17 @@ let reportdiff = ~see_also:CLOpt.([Report]) +let events = + mk_command_doc ~title:"Infer Events" + ~short_description:"dump all the logged events in machine readable format" + ~synopsis:{|$(b,infer) $(b,events)|} + ~description: + [ `P + "Emit to stdout one JSON object per line, each describing a logged event happened during the execution of Infer" + ] + ~see_also:CLOpt.([Report; Run]) + + let run = mk_command_doc ~title:"Infer Analysis of a Project" ~short_description:"capture source files, analyze, and report" @@ -263,6 +274,7 @@ let command_to_data = ; mk Capture capture ; mk Compile compile ; mk Diff diff + ; mk Events events ; mk Explore explore ; mk Report report ; mk ReportDiff reportdiff diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 9d834fd68..34c815d83 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -95,6 +95,7 @@ type command = | Capture | Compile | Diff + | Events | Explore | Report | ReportDiff @@ -110,6 +111,7 @@ let command_to_name = ; (Capture, "capture") ; (Compile, "compile") ; (Diff, "diff") + ; (Events, "events") ; (Explore, "explore") ; (Report, "report") ; (ReportDiff, "reportdiff") diff --git a/infer/src/base/CommandLineOption.mli b/infer/src/base/CommandLineOption.mli index b46a87025..025605e49 100644 --- a/infer/src/base/CommandLineOption.mli +++ b/infer/src/base/CommandLineOption.mli @@ -30,6 +30,7 @@ type command = (** set up the infer environment then run the compilation commands without capturing the source files *) | Diff (** orchestrate a diff analysis *) + | Events (** dump logged events into stdout *) | Explore (** explore infer reports *) | Report (** post-process infer results and reports *) | ReportDiff (** compute the difference of two infer reports *) diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 2c9fafdee..0d0a7b548 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -186,6 +186,8 @@ let dotty_output = "icfg.dot" let duplicates_filename = "duplicates.txt" +let events_dir_name = "events" + (** exit code to use for the --fail-on-issue option *) let fail_on_issue_exit_code = 2 @@ -563,7 +565,7 @@ let () = match cmd with | Report -> `Add - | Analyze | Capture | Compile | Diff | Explore | ReportDiff | Run -> + | Analyze | Capture | Compile | Diff | Events | Explore | ReportDiff | Run -> `Reject in (* make sure we generate doc for all the commands we know about *) @@ -2157,8 +2159,10 @@ let post_parsing_initialization command_opt = ANSITerminal.(prerr_string []) "Run the command again with `--keep-going` to try and ignore this error." ; Out_channel.newline stderr ) ; + let exitcode = L.exit_code_of_exception exn in + L.log_uncaught_exception exn ~exitcode ; late_epilogue () ; - Pervasives.exit (L.exit_code_of_exception exn) + Pervasives.exit exitcode in Caml.Printexc.set_uncaught_exception_handler uncaught_exception_handler ; F.set_margin !margin ; diff --git a/infer/src/base/Config.mli b/infer/src/base/Config.mli index 79ae9876d..cdaaea3bb 100644 --- a/infer/src/base/Config.mli +++ b/infer/src/base/Config.mli @@ -143,6 +143,8 @@ val default_in_zip_results_dir : string val dotty_output : string +val events_dir_name : string + val etc_dir : string val fail_on_issue_exit_code : int diff --git a/infer/src/base/Die.ml b/infer/src/base/Die.ml index 54aec3beb..c9a7f6427 100644 --- a/infer/src/base/Die.ml +++ b/infer/src/base/Die.ml @@ -29,6 +29,12 @@ let raise_error error ~msg = raise (InferUserError msg) +let log_uncaught_exception_callback_ref = ref (fun _ ~exitcode:_ -> ()) + +let set_log_uncaught_exception_callback fn = log_uncaught_exception_callback_ref := fn + +let log_uncaught_exception exn ~exitcode = !log_uncaught_exception_callback_ref exn ~exitcode + let die error fmt = F.kasprintf (fun msg -> raise_error error ~msg) fmt let exit exitcode = raise (InferExit exitcode) diff --git a/infer/src/base/Die.mli b/infer/src/base/Die.mli index 502345dce..20027fd06 100644 --- a/infer/src/base/Die.mli +++ b/infer/src/base/Die.mli @@ -27,6 +27,10 @@ val exit : int -> 'a val exit_code_of_exception : Exn.t -> int +val set_log_uncaught_exception_callback : (exn -> exitcode:int -> unit) -> unit + +val log_uncaught_exception : exn -> exitcode:int -> unit + val die : error -> ('a, Format.formatter, unit, _) format4 -> 'a (** Raise the corresponding exception. *) diff --git a/infer/src/base/Epilogues.ml b/infer/src/base/Epilogues.ml index acebf78d3..b5e6844cc 100644 --- a/infer/src/base/Epilogues.ml +++ b/infer/src/base/Epilogues.ml @@ -36,3 +36,4 @@ let register ~f desc = Pervasives.at_exit f_no_exn ; (* Register signal masking. *) Lazy.force activate_run_epilogues_on_signal + diff --git a/infer/src/base/EventLogger.ml b/infer/src/base/EventLogger.ml new file mode 100644 index 000000000..0ad0ef816 --- /dev/null +++ b/infer/src/base/EventLogger.ml @@ -0,0 +1,118 @@ +(* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! IStd +module CLOpt = CommandLineOption + +module IO = struct + let log_file_extension = ".log" + + let events_dir = + Option.value (Sys.getenv Config.infer_top_results_dir_env_var) ~default:Config.results_dir + ^/ Config.events_dir_name + + + let out_chan = ref None + + let close () = + match !out_chan with + | None -> + () + | Some chan -> + Out_channel.close chan ; + out_chan := None + + + let prepare () = + close () ; + let fname = events_dir ^/ (Unix.getpid () |> Pid.to_string) ^ log_file_extension in + let oc = Pervasives.open_out_gen [Open_append; Open_creat] 0o666 fname in + out_chan := Some oc + + + let write fmt = + match !out_chan with Some oc -> Printf.fprintf oc fmt | _ -> Printf.ifprintf stdout fmt + + + let dump () = + let dump_file_to_stdout fname = + let ic = In_channel.create fname in + In_channel.iter_lines ic ~f:print_endline + in + let log_files = Utils.find_files ~path:events_dir ~extension:log_file_extension in + List.iter log_files ~f:dump_file_to_stdout + + + let () = Config.register_late_epilogue close +end + +module Random_id : sig + val get : unit -> string +end = struct + let () = Random.self_init () + + let generate () = Random.int64 1_000_000_000_000L |> Int64.to_string + + let infer_run_identifier_env_var = "INFER_RUN_IDENTIFIER" + + let get () = + match Sys.getenv infer_run_identifier_env_var with + | Some id -> + id + | None -> + let new_id = generate () in + Unix.putenv ~key:infer_run_identifier_env_var ~data:new_id ; + new_id + +end + +let get_log_identifier () = Random_id.get () + +type event = UncaughtException of exn * int + +let string_of_event event = match event with UncaughtException _ -> "UncaughtException" + +let sequence_ctr = ref 0 + +let pid () = Pid.to_int (Unix.getpid ()) + +let sysname = + try + Utils.with_process_in "uname 2>/dev/null" (fun chan -> + Scanf.bscanf (Scanf.Scanning.from_channel chan) "%s" (fun n -> n) ) + |> fst + with _ -> "Unknown" + + +let create_row event = + incr sequence_ctr ; + let open JsonBuilder in + let base = + empty |> add_string ~key:"command" ~data:(CLOpt.name_of_command Config.command) + |> add_string ~key:"event_tag" ~data:(string_of_event event) + |> add_string ~key:"hostname" ~data:(Unix.gethostname ()) + |> add_string ~key:"infer_commit" ~data:Version.commit + |> add_int ~key:"is_originator" ~data:(if CLOpt.is_originator then 1 else 0) + |> add_int ~key:"pid" ~data:(pid ()) + |> add_string ~key:"run_identifier" ~data:(get_log_identifier ()) + |> add_int ~key:"sequence" ~data:(!sequence_ctr - 1) |> add_string ~key:"sysname" ~data:sysname + |> add_int ~key:"time" ~data:(int_of_float (Unix.time ())) + in + ( match event with UncaughtException (exn, exitcode) -> + base |> add_string ~key:"exception" ~data:(Caml.Printexc.exn_slot_name exn) + |> add_string ~key:"exception_info" ~data:(Exn.to_string exn) + |> add_int ~key:"exitcode" ~data:exitcode ) + |> JsonBuilder.to_json + + +let prepare = IO.prepare + +let log event = IO.write "%s\n" (create_row event) + +let dump = IO.dump diff --git a/infer/src/base/EventLogger.mli b/infer/src/base/EventLogger.mli new file mode 100644 index 000000000..bf8f279fc --- /dev/null +++ b/infer/src/base/EventLogger.mli @@ -0,0 +1,18 @@ +(* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +type event = UncaughtException of exn * int (** exception, exitcode *) + +val get_log_identifier : unit -> string + +val prepare : unit -> unit + +val log : event -> unit + +val dump : unit -> unit diff --git a/infer/src/base/ResultsDir.ml b/infer/src/base/ResultsDir.ml index b2fd75e21..ed6143c64 100644 --- a/infer/src/base/ResultsDir.ml +++ b/infer/src/base/ResultsDir.ml @@ -42,20 +42,25 @@ let remove_results_dir () = Utils.rmtree Config.results_dir ) -let create_results_dir () = - Unix.mkdir_p Config.results_dir ; +let prepare_logging_and_db () = L.setup_log_file () ; + EventLogger.prepare () ; if Sys.is_file ResultsDatabase.database_fullpath <> `Yes then ResultsDatabase.create_db () ; - ResultsDatabase.new_database_connection () ; - List.iter ~f:Unix.mkdir_p results_dir_dir_markers + ResultsDatabase.new_database_connection () + + +let create_results_dir () = + Unix.mkdir_p Config.results_dir ; + Unix.mkdir_p (Config.results_dir ^/ Config.events_dir_name) ; + List.iter ~f:Unix.mkdir_p results_dir_dir_markers ; + prepare_logging_and_db () let assert_results_dir advice = Result.iter_error (is_results_dir ~check_correct_version:true ()) ~f:(fun err -> L.(die UserError) "ERROR: No results directory at '%s': %s@\nERROR: %s@." Config.results_dir err advice ) ; - L.setup_log_file () ; - ResultsDatabase.new_database_connection () + prepare_logging_and_db () let delete_capture_and_analysis_data () = @@ -66,4 +71,3 @@ let delete_capture_and_analysis_data () = List.iter ~f:Utils.rmtree dirs_to_delete ; List.iter ~f:Unix.mkdir_p dirs_to_delete ; () - diff --git a/infer/src/opensource/JsonBuilder.ml b/infer/src/opensource/JsonBuilder.ml new file mode 100644 index 000000000..ef8142a82 --- /dev/null +++ b/infer/src/opensource/JsonBuilder.ml @@ -0,0 +1,18 @@ +(* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +type t = (string * Yojson.Basic.json) list + +let empty = [] + +let add_string t ~key ~data = (key, `String data) :: t + +let add_int t ~key ~data = (key, `Int data) :: t + +let to_json t = Yojson.Basic.to_string (`Assoc t) diff --git a/infer/src/opensource/JsonBuilder.mli b/infer/src/opensource/JsonBuilder.mli new file mode 100644 index 000000000..73a4085af --- /dev/null +++ b/infer/src/opensource/JsonBuilder.mli @@ -0,0 +1,18 @@ +(* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +type t + +val empty : t + +val add_string : t -> key:string -> data:string -> t + +val add_int : t -> key:string -> data:int -> t + +val to_json : t -> string