You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

351 lines
11 KiB

(*
* 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
type analysis_issue =
{ bug_kind: string
; bug_type: string
; exception_triggered_location: Logging.ocaml_pos option
; lang: string
; procedure_name: string
; source_location: Location.t }
let create_analysis_issue_row base record =
let open JsonBuilder in
base |> add_string ~key:"bug_kind" ~data:record.bug_kind
|> add_string ~key:"bug_type" ~data:record.bug_type
|> add_string_opt ~key:"exception_triggered_location"
~data:(Option.map ~f:Logging.ocaml_pos_to_string record.exception_triggered_location)
|> add_string ~key:"lang" ~data:record.lang
|> add_string ~key:"procedure_name" ~data:record.procedure_name
|> add_string ~key:"source_location"
~data:
(String.concat
[ string_of_int record.source_location.line
; ":"
; string_of_int record.source_location.col ])
|> add_string ~key:"source_file" ~data:(SourceFile.to_rel_path record.source_location.file)
type analysis_stats =
{ analysis_nodes_visited: int
; analysis_status: SymOp.failure_kind option
; analysis_total_nodes: int
; clang_method_kind: string option
; lang: string
; method_location: Location.t
; method_name: string
; num_preposts: int
; symops: int }
let create_analysis_stats_row base record =
let open JsonBuilder in
base |> add_int ~key:"analysis_nodes_visited" ~data:record.analysis_nodes_visited
|> add_string ~key:"analysis_status"
~data:
(Option.value_map record.analysis_status ~default:"OK" ~f:(fun stats_failure ->
SymOp.failure_kind_to_string stats_failure ))
|> add_int ~key:"analysis_total_nodes" ~data:record.analysis_total_nodes
|> add_string_opt ~key:"clang_method_kind" ~data:record.clang_method_kind
|> add_string ~key:"lang" ~data:record.lang
|> add_string ~key:"method_location"
~data:
(String.concat
[ string_of_int record.method_location.line
; ":"
; string_of_int record.method_location.col ])
|> add_string ~key:"source_file" ~data:(SourceFile.to_rel_path record.method_location.file)
|> add_string ~key:"method_name" ~data:record.method_name
|> add_int ~key:"num_preposts" ~data:record.num_preposts
|> add_int ~key:"symops" ~data:record.symops
type call_trace =
{ call_location: Location.t
; call_result: string
; callee_name: string
; caller_name: string
; lang: string
; reason: string option }
let create_call_trace_row base record =
let open JsonBuilder in
base
|> add_string ~key:"call_location"
~data:
(String.concat
[string_of_int record.call_location.line; ":"; string_of_int record.call_location.col])
|> add_string ~key:"source_file" ~data:(SourceFile.to_rel_path record.call_location.file)
|> add_string ~key:"call_result" ~data:record.call_result
|> add_string ~key:"callee_name" ~data:record.callee_name
|> add_string ~key:"caller_name" ~data:record.caller_name
|> add_string ~key:"lang" ~data:record.lang |> add_string_opt ~key:"reason" ~data:record.reason
type frontend_exception =
{ ast_node: string option
; exception_triggered_location: Logging.ocaml_pos
; exception_type: string
; lang: string
; source_location_start: Location.t
; source_location_end: Location.t }
let create_frontend_exception_row base record =
let open JsonBuilder in
base |> add_string_opt ~key:"ast_node" ~data:record.ast_node
|> add_string ~key:"exception_triggered_location"
~data:(Logging.ocaml_pos_to_string record.exception_triggered_location)
|> add_string ~key:"exception_type" ~data:record.exception_type
|> add_string ~key:"lang" ~data:record.lang
|> add_string ~key:"source_location_start_file"
~data:(SourceFile.to_rel_path record.source_location_start.file)
|> add_string ~key:"source_location_start_pos"
~data:
(String.concat
[ string_of_int record.source_location_start.line
; ":"
; string_of_int record.source_location_start.col ])
|> add_string ~key:"source_location_end_file"
~data:(SourceFile.to_rel_path record.source_location_end.file)
|> add_string ~key:"source_location_end_pos"
~data:
(String.concat
[ string_of_int record.source_location_end.line
; ":"
; string_of_int record.source_location_end.col ])
type performance_stats =
{ lang: string
; source_file: SourceFile.t option
; stats_type: string
; real_time: float
; user_time: float
; sys_time: float
; children_user_time: float
; children_sys_time: float
; minor_heap_mem: float
; promoted_minor_heap_mem: float
; major_heap_mem: float
; total_allocated_mem: float
; minor_collections: int
; major_collections: int
; heap_compactions: int
; top_heap_size: int
; stack_size: int
; minor_heap_size: int }
let create_performance_stats_row base record =
let open JsonBuilder in
base |> add_string ~key:"lang" ~data:record.lang
|> add_string_opt ~key:"source_file"
~data:(Option.map ~f:SourceFile.to_rel_path record.source_file)
|> add_string ~key:"stats_type" ~data:record.stats_type
|> add_float ~key:"real_time" ~data:record.real_time
|> add_float ~key:"user_time" ~data:record.user_time
|> add_float ~key:"sys_time" ~data:record.sys_time
|> add_float ~key:"children_user_time" ~data:record.children_user_time
|> add_float ~key:"children_sys_time" ~data:record.children_sys_time
|> add_float ~key:"minor_heap_mem" ~data:record.minor_heap_mem
|> add_float ~key:"promoted_minor_heap_mem" ~data:record.promoted_minor_heap_mem
|> add_float ~key:"major_heap_mem" ~data:record.major_heap_mem
|> add_float ~key:"total_allocated_mem" ~data:record.total_allocated_mem
|> add_int ~key:"minor_collections" ~data:record.minor_collections
|> add_int ~key:"major_collections" ~data:record.major_collections
|> add_int ~key:"heap_compactions" ~data:record.heap_compactions
|> add_int ~key:"top_heap_size" ~data:record.top_heap_size
|> add_int ~key:"stack_size" ~data:record.stack_size
|> add_int ~key:"minor_heap_size" ~data:record.minor_heap_size
|> add_string ~key:"stats_type" ~data:record.stats_type
type procedures_translated =
{ lang: string
; procedures_translated_failed: int
; procedures_translated_total: int
; source_file: SourceFile.t }
let create_procedures_translated_row base record =
let open JsonBuilder in
base |> add_string ~key:"lang" ~data:record.lang
|> add_int ~key:"procedures_translated_failed" ~data:record.procedures_translated_failed
|> add_int ~key:"procedures_translated_total" ~data:record.procedures_translated_total
|> add_string ~key:"source_file" ~data:(SourceFile.to_rel_path record.source_file)
type event =
| AnalysisIssue of analysis_issue
| AnalysisStats of analysis_stats
| CallTrace of call_trace
| FrontendException of frontend_exception
| PerformanceStats of performance_stats
| ProceduresTranslatedSummary of procedures_translated
| UncaughtException of exn * int
let string_of_event event =
match event with
| AnalysisIssue _ ->
"AnalysisIssue"
| AnalysisStats _ ->
"AnalysisStats"
| CallTrace _ ->
"CallTrace"
| FrontendException _ ->
"FrontendException"
| PerformanceStats _ ->
"PerformanceStats"
| ProceduresTranslatedSummary _ ->
"ProceduresTranslatedSummary"
| 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"
module type S = sig
val get_log_identifier : unit -> string
val prepare : unit -> unit
val log : event -> unit
val dump : unit -> unit
end
module LoggerImpl : S = struct
let get_log_identifier () = Random_id.get ()
let create_row event =
incr sequence_ctr ;
let open JsonBuilder in
let base =
empty |> add_string ~key:"command" ~data:(InferCommand.to_string 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
| AnalysisIssue record ->
create_analysis_issue_row base record
| AnalysisStats record ->
create_analysis_stats_row base record
| CallTrace record ->
create_call_trace_row base record
| FrontendException record ->
create_frontend_exception_row base record
| PerformanceStats record ->
create_performance_stats_row base record
| ProceduresTranslatedSummary record ->
create_procedures_translated_row base record
| 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
end
module DummyLogger : S = struct
let get_log_identifier () = ""
let prepare () = ()
let log _ = ()
let dump _ = ()
end
(* use real logger if logging is enabled, dummy logger otherwise *)
include ( val if Config.log_events then (module LoggerImpl : S) else (module DummyLogger : S) )