[infra] Collect low-prio logs during execution and flush them to Scuba at the end in one go

Reviewed By: mityal

Differential Revision: D15898726

fbshipit-source-id: e8609f10d

infer/src/backend/InferAnalyze.ml

@@ -27,7 +27,7 @@ let analyze_target : TaskScheduler.target Tasks.doer =
           Dotty.print_icfg_dotty Topl.sourcefile Topl.cfg ;
         if Config.write_html then Printer.write_all_html_files source_file )
   in
-  (* In call-graph scheduling, log progress every [per_procedure_logging_granularity] procedures. 
+  (* In call-graph scheduling, log progress every [per_procedure_logging_granularity] procedures.
      The default roughly reflects the average number of procedures in a C++ file. *)
   let per_procedure_logging_granularity = 200 in
   (* [procs_left] is set to 1 so that we log the first procedure sent to us. *)
@@ -102,7 +102,7 @@ let main ~changed_files =
     if result then incr n_source_files_to_analyze ;
     result
   in
-  ScubaEventLogging.log_count ~name:"source_files_to_analyze" ~value:!n_source_files_to_analyze ;
+  ScubaLogging.log_count ~label:"source_files_to_analyze" ~value:!n_source_files_to_analyze ;
   let source_files_to_analyze = SourceFiles.get_all ~filter () in
   L.progress "Found %d%s source file%s to analyze in %s@." !n_source_files_to_analyze
     ( if Config.reactive_mode || Option.is_some changed_files then

infer/src/base/Utils.ml

@@ -392,3 +392,10 @@ let yojson_lookup yojson_assoc elt_name ~src ~f ~default =
   Option.value_map ~default
     ~f:(fun res -> f res ~src)
     (List.Assoc.find ~equal:String.equal yojson_assoc elt_name)
+
+
+let timeit ~f =
+  let start_time = Mtime_clock.counter () in
+  let ret_val = f () in
+  let duration_ms = Mtime_clock.count start_time |> Mtime.Span.to_ms |> int_of_float in
+  (ret_val, duration_ms)

infer/src/base/Utils.mli

@@ -131,3 +131,6 @@ val yojson_lookup :
   -> default:'a
   -> 'a
 (** Lookup a json value on an assoc list.  If not present, returns default.  Otherwise returns (f json_value ~src) where src has element name appended. f is typically one of the above _of_yojson functions. *)
+
+val timeit : f:(unit -> 'a) -> 'a * int
+(** Returns the execution time of [f] in milliseconds together with its result *)

infer/src/infer.ml

@@ -22,7 +22,7 @@ let run driver_mode =
   run_epilogue ()
 
 
-let run driver_mode = ScubaEventLogging.execute_with_time_logging "run" (fun () -> run driver_mode)
+let run driver_mode = ScubaLogging.execute_with_time_logging "run" (fun () -> run driver_mode)
 
 let setup () =
   ( match Config.command with
@@ -101,6 +101,9 @@ let prepare_events_logging () =
 
 
 let () =
+  (* We specifically want to collect samples only from the main process until
+     we figure out what other entries and how we want to collect *)
+  if CommandLineOption.is_originator then ScubaLogging.register_global_log_flushing_at_exit () ;
   ( if Config.linters_validate_syntax_only then
     match CTLParserHelper.validate_al_files () with
     | Ok () ->

infer/src/integration/Driver.ml

@@ -315,7 +315,7 @@ let capture ~changed_files mode =
 
 
 let capture ~changed_files mode =
-  ScubaEventLogging.execute_with_time_logging "capture" (fun () -> capture ~changed_files mode)
+  ScubaLogging.execute_with_time_logging "capture" (fun () -> capture ~changed_files mode)
 
 
 let execute_analyze ~changed_files =
@@ -421,7 +421,7 @@ let analyze_and_report ?suppress_console_report ~changed_files mode =
 
 
 let analyze_and_report ?suppress_console_report ~changed_files mode =
-  ScubaEventLogging.execute_with_time_logging "analyze_and_report" (fun () ->
+  ScubaLogging.execute_with_time_logging "analyze_and_report" (fun () ->
       analyze_and_report ?suppress_console_report ~changed_files mode )
 
 
@@ -570,7 +570,7 @@ let run_prologue mode =
 
 
 let run_prologue mode =
-  ScubaEventLogging.execute_with_time_logging "run_prologue" (fun () -> run_prologue mode)
+  ScubaLogging.execute_with_time_logging "run_prologue" (fun () -> run_prologue mode)
 
 
 let run_epilogue () =
@@ -582,7 +582,7 @@ let run_epilogue () =
   ()
 
 
-let run_epilogue () = ScubaEventLogging.execute_with_time_logging "run_epilogue" run_epilogue
+let run_epilogue () = ScubaLogging.execute_with_time_logging "run_epilogue" run_epilogue
 
 let read_config_changed_files () =
   match Config.changed_files_index with

infer/src/scuba/LogEntry.ml

@@ -0,0 +1,40 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+
+type count_entry_data = {value: int}
+
+type time_entry_data = {duration_ms: int}
+
+type entry_data = Count of count_entry_data | Time of time_entry_data
+
+type t = {label: string; created_at_ts: int; data: entry_data}
+
+let mk_count ~label ~value =
+  let created_at_ts = Unix.time () |> int_of_float in
+  let data = Count {value} in
+  {label; created_at_ts; data}
+
+
+let mk_time ~label ~duration_ms =
+  let created_at_ts = Unix.time () |> int_of_float in
+  let data = Time {duration_ms} in
+  {label; created_at_ts; data}
+
+
+(** What _global_ mean at this point is subject to discussion. Right now
+    there is only one use-case which is Scuba+Scribe logging at the end of
+    execution. But there might be more. Let's change the naming accordingly
+    when the purpose gets clearer. *)
+let global_entry_log : t list ref = ref []
+
+let global_log_get () = List.rev !global_entry_log
+
+let global_log_erase () = global_entry_log := []
+
+let global_log_add entry = global_entry_log := entry :: !global_entry_log

infer/src/scuba/LogEntry.mli

@@ -0,0 +1,32 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+
+(**
+  Log entry data model, global log entry store and functions to manipulate it.
+  Direct access to the store is not exposed.
+*)
+
+type count_entry_data = {value: int}
+
+type time_entry_data = {duration_ms: int}
+
+type entry_data = Count of count_entry_data | Time of time_entry_data
+
+(** created_at_ts is a unix timestamp (in seconds) *)
+type t = {label: string; created_at_ts: int; data: entry_data}
+
+val mk_count : label:string -> value:int -> t
+
+val mk_time : label:string -> duration_ms:int -> t
+
+val global_log_get : unit -> t list
+
+val global_log_erase : unit -> unit
+
+val global_log_add : t -> unit

infer/src/scuba/ScubaEventLogging.ml

@@ -1,64 +0,0 @@
-(*
- * Copyright (c) Facebook, Inc. and its affiliates.
- *
- * This source code is licensed under the MIT license found in the
- * LICENSE file in the root directory of this source tree.
- *)
-(* FB-ONLY *)
-
-(*
- * Utilities to log in "infer_events" key-value scuba table.
- *)
-open! IStd
-
-let hostname = Unix.gethostname ()
-
-let maybe_add_normal ~name ~value sample =
-  match value with None -> sample | Some value -> Scuba.add_normal ~name ~value sample
-
-
-let set_command_line_normales sample =
-  let add_normal ~key ~data = Scuba.add_normal ~name:key ~value:data in
-  Map.fold Config.scuba_normals ~init:sample ~f:add_normal
-
-
-let set_common_fields sample =
-  let open Scuba in
-  sample
-  |> add_int ~name:"pid" ~value:(ProcessPoolState.get_pid () |> Pid.to_int)
-  |> add_int ~name:"is_main_process" ~value:(Bool.to_int CommandLineOption.is_originator)
-  |> add_normal ~name:"hostname" ~value:hostname
-  |> maybe_add_normal ~name:"job_id" ~value:Config.job_id
-  |> add_normal ~name:"command" ~value:(InferCommand.to_string Config.command)
-  |> add_normal ~name:"infer_commit" ~value:Version.commit
-
-
-let create_sample ~event_name ~value =
-  Scuba.new_sample ~time:None |> set_common_fields |> set_command_line_normales
-  |> Scuba.add_normal ~name:"event" ~value:event_name
-  |> Scuba.add_int ~name:"value" ~value
-
-
-type event_type = Count | Time
-
-let string_of_event_type = function Count -> "count" | Time -> "time"
-
-let log event_type ~event_suffix ~value =
-  let event_name = string_of_event_type event_type ^ "." ^ event_suffix in
-  let sample = create_sample ~event_name ~value in
-  Scuba.log Scuba.InferEvents [sample]
-
-
-(* If scuba logging is disabled, we would not log anyway, but let's not even try
-   to create samples to save perf *)
-let log = if Config.scuba_logging then log else fun _ ~event_suffix:_ ~value:_ -> ()
-
-let log_count ~name ~value = log Count ~event_suffix:name ~value
-
-let log_time ~name ~duration_ms = log Time ~event_suffix:name ~value:duration_ms
-
-let execute_with_time_logging name f =
-  let start_time = Mtime_clock.counter () in
-  let ret_val = f () in
-  let duration_ms = Mtime_clock.count start_time |> Mtime.Span.to_ms |> int_of_float in
-  log_time ~name ~duration_ms ; ret_val

infer/src/scuba/ScubaLogging.ml

@@ -0,0 +1,76 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+(* FB-ONLY *)
+
+(*
+ * Utilities to log in "infer_events" key-value scuba table.
+ *)
+open! IStd
+
+let hostname = Unix.gethostname ()
+
+let maybe_add_normal ~name ~value sample =
+  match value with None -> sample | Some value -> Scuba.add_normal ~name ~value sample
+
+
+let set_command_line_normales sample =
+  let add_normal ~key ~data = Scuba.add_normal ~name:key ~value:data in
+  Map.fold Config.scuba_normals ~init:sample ~f:add_normal
+
+
+let set_common_fields sample =
+  let open Scuba in
+  sample
+  |> add_int ~name:"pid" ~value:(ProcessPoolState.get_pid () |> Pid.to_int)
+  |> add_int ~name:"is_main_process" ~value:(Bool.to_int CommandLineOption.is_originator)
+  |> add_normal ~name:"hostname" ~value:hostname
+  |> maybe_add_normal ~name:"job_id" ~value:Config.job_id
+  |> add_normal ~name:"command" ~value:(InferCommand.to_string Config.command)
+  |> add_normal ~name:"infer_commit" ~value:Version.commit
+
+
+let sample_from_event ({label; created_at_ts; data} : LogEntry.t) =
+  let event_name, value =
+    match data with
+    | LogEntry.Count {value} ->
+        (Printf.sprintf "count.%s" label, value)
+    | LogEntry.Time {duration_ms} ->
+        (Printf.sprintf "time.%s" label, duration_ms)
+  in
+  Scuba.new_sample ~time:(Some created_at_ts)
+  |> set_common_fields |> set_command_line_normales
+  |> Scuba.add_normal ~name:"event" ~value:event_name
+  |> Scuba.add_int ~name:"value" ~value
+
+
+(** Consider buffering or batching if proves to be a problem *)
+let log_many entries =
+  let samples = List.map entries ~f:sample_from_event in
+  Scuba.log Scuba.InferEvents samples
+
+
+(** If scuba logging is disabled, we would not log anyway, but let's not even try
+    to create samples to save perf *)
+let log_many = if Config.scuba_logging then log_many else fun _ -> ()
+
+let log_one entry = log_many [entry]
+
+let log_count ~label ~value = log_one (LogEntry.mk_count ~label ~value)
+
+let execute_with_time_logging label f =
+  let ret_val, duration_ms = Utils.timeit ~f in
+  let entry = LogEntry.mk_time ~label ~duration_ms in
+  log_one entry ; ret_val
+
+
+let flush_log_events () =
+  log_many (LogEntry.global_log_get ()) ;
+  LogEntry.global_log_erase ()
+
+
+let register_global_log_flushing_at_exit () =
+  Epilogues.register ~f:flush_log_events ~description:"Flushing global log entries to Scuba"

infer/src/scuba/ScubaLogging.mli

@@ -17,9 +17,13 @@ open! IStd
    run of Infer.
  *)
 
-val log_count : name:string -> value:int -> unit
+val log_count : label:string -> value:int -> unit
 (** Log anything that can be counted. Events will be prefixed with "count." *)
 
+val log_many : LogEntry.t list -> unit
+
+val log_one : LogEntry.t -> unit
+
 val execute_with_time_logging : string -> (unit -> 'a) -> 'a
 (**
     A helper to log execution time of a particular function.
@@ -27,6 +31,10 @@ val execute_with_time_logging : string -> (unit -> 'a) -> 'a
     Example:
     {|
       let f a b = <some code>
-      let f a b = ScubaEventLogging.execute_with_time_logging "f" (fun () -> f a b)
+      let f a b = ScubaLogging.execute_with_time_logging "f" (fun () -> f a b)
     |}
  *)
+
+val flush_log_events : unit -> unit
+
+val register_global_log_flushing_at_exit : unit -> unit