[log] die in a proper fashion

Summary: Introduce `Logging.die` to try and exit with consistent error codes depending on what failed.

Reviewed By: mbouaziz

Differential Revision: D5406642

fbshipit-source-id: 25d98fc

infer/src/backend/InferPrint.ml

@@ -935,7 +935,7 @@ module AnalysisResults = struct
     let load_file fname =
       match Specs.load_summary (DB.filename_from_string fname) with
       | None
-       -> L.user_error "Error: cannot open file %s@." fname ; exit 1
+       -> L.(die UserError) "Error: cannot open file %s@." fname
       | Some summary
        -> summaries := (fname, summary) :: !summaries
     in
@@ -958,7 +958,7 @@ module AnalysisResults = struct
     let do_spec f fname =
       match Specs.load_summary (DB.filename_from_string fname) with
       | None
-       -> L.user_error "Error: cannot open file %s@." fname ; exit 1
+       -> L.(die UserError) "Error: cannot open file %s@." fname
       | Some summary
        -> f (fname, summary)
     in
@@ -996,7 +996,7 @@ module AnalysisResults = struct
       | Some r
        -> iterator_of_summary_list r
       | None
-       -> L.user_error "Error: cannot open analysis results file %s@." fname ; exit 1
+       -> L.(die UserError) "Error: cannot open analysis results file %s@." fname
 end
 
 let register_perf_stats_report () =

infer/src/backend/infer.ml

@@ -55,18 +55,16 @@ let create_results_dir () = List.iter ~f:Unix.mkdir_p results_dir_dir_markers ;
 
 let assert_results_dir advice =
   Result.iter_error (is_results_dir ()) ~f:(fun err ->
-      L.user_error "ERROR: No results directory at '%s': %s@\nERROR: %s@." Config.results_dir err
+      L.(die UserError)
-        advice ;
+        "ERROR: No results directory at '%s': %s@\nERROR: %s@." Config.results_dir err advice ) ;
-      exit 1 ) ;
   L.setup_log_file ()
 
 let remove_results_dir () =
   if Sys.is_directory Config.results_dir = `Yes then (
     Result.iter_error (is_results_dir ()) ~f:(fun err ->
-        L.user_error
+        L.(die UserError)
           "ERROR: '%s' exists but does not seem to be an infer results directory: %s@\nERROR: Please delete '%s' and try again@."
-          Config.results_dir err Config.results_dir ;
+          Config.results_dir err Config.results_dir ) ;
-        exit 1 ) ;
     Utils.rmtree Config.results_dir )
 
 let setup_results_dir () =

infer/src/base/CommandLineOption.ml

@@ -784,7 +784,7 @@ let parse_args ~usage initial_action ?initial_command args =
      -> if !anon_arg_action.on_unknown <> `Reject && is_unknown usage_msg then (
           anon_fun !args_to_parse.(!arg_being_parsed) ;
           parse_loop () )
-        else ( Pervasives.prerr_string usage_msg ; exit 2 )
+        else ( Pervasives.prerr_string usage_msg ; exit 1 )
     | Arg.Help _
      -> (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help
            anymore *)

infer/src/base/Logging.ml

@@ -142,16 +142,18 @@ let close_logs () =
 
 let () = Epilogues.register ~f:close_logs "flushing logs and closing log file"
 
-let log ~to_console ?(to_file= true) (lazy formatters) =
+let log_k ~to_console ?(to_file= true) ~k (lazy formatters) =
   match (to_console, to_file) with
   | false, false
-   -> F.ifprintf F.std_formatter
+   -> F.ikfprintf k F.std_formatter
   | true, _ when not Config.print_logs
-   -> F.fprintf !formatters.console_file
+   -> F.kfprintf k !formatters.console_file
   | _
    -> (* to_console might be true, but in that case so is Config.print_logs so do not print to
          stderr because it will get logs from the log file already *)
-      F.fprintf !formatters.file
+      F.kfprintf k !formatters.file
+
+let log = log_k ~k:ignore
 
 let debug_file_fmts = register_formatter "debug"
 
@@ -196,7 +198,9 @@ let progressbar_timeout_event failure_kind =
 
 let user_warning fmt = log ~to_console:(not Config.quiet) user_warning_file_fmts fmt
 
-let user_error fmt = log ~to_console:(not Config.quiet) user_error_file_fmts fmt
+let user_error_k ~k fmt = log_k ~to_console:(not Config.quiet) ~k user_error_file_fmts fmt
+
+let user_error fmt = user_error_k ~k:ignore fmt
 
 type debug_level = Quiet | Medium | Verbose [@@deriving compare]
 
@@ -238,9 +242,14 @@ let environment_info fmt = log ~to_console:false environment_info_file_fmts fmt
 
 let external_warning fmt = log ~to_console:(not Config.quiet) external_warning_file_fmts fmt
 
-let external_error fmt = log ~to_console:(not Config.quiet) external_error_file_fmts fmt
+let external_error_k ~k fmt = log_k ~to_console:(not Config.quiet) ~k external_error_file_fmts fmt
+
+let external_error fmt = external_error_k ~k:ignore fmt
+
+let internal_error_k ~k fmt =
+  log_k ~to_console:Config.developer_mode ~k internal_error_file_fmts fmt
 
-let internal_error fmt = log ~to_console:Config.developer_mode internal_error_file_fmts fmt
+let internal_error fmt = internal_error_k ~k:ignore fmt
 
 (** Type of location in ml source: __POS__ *)
 type ml_loc = string * int * int * int
@@ -255,6 +264,21 @@ let pp_ml_loc_opt fmt ml_loc_opt =
   if Config.developer_mode then
     match ml_loc_opt with None -> () | Some ml_loc -> F.fprintf fmt "(%a)" pp_ml_loc ml_loc
 
+type error = UserError | ExternalError | InternalError
+
+(* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions, avoid it *)
+let exit_code_of_kind = function UserError -> 1 | ExternalError -> 10 | InternalError -> 3
+
+let log_of_kind = function
+  | UserError
+   -> user_error_k
+  | ExternalError
+   -> external_error_k
+  | InternalError
+   -> internal_error_k
+
+let die error msg = log_of_kind error ~k:(fun _ -> exit (exit_code_of_kind error)) msg
+
 (* create new channel from the log file, and dumps the contents of the temporary log buffer there *)
 let setup_log_file () =
   match !log_file with

infer/src/base/Logging.mli

@@ -12,10 +12,12 @@ open! IStd
 
 (** log messages at different levels of verbosity *)
 
-val environment_info : ('a, Format.formatter, unit) format -> 'a
+module F = Format
+
+val environment_info : ('a, F.formatter, unit) format -> 'a
 (** log information about the environment *)
 
-val progress : ('a, Format.formatter, unit) format -> 'a
+val progress : ('a, F.formatter, unit) format -> 'a
 (** print immediately to standard error unless --quiet is specified *)
 
 val progressbar_file : unit -> unit
@@ -27,23 +29,23 @@ val progressbar_procedure : unit -> unit
 val progressbar_timeout_event : SymOp.failure_kind -> unit
 (** Progress bar: log a timeout event if in developer mode. *)
 
-val result : ('a, Format.formatter, unit) format -> 'a
+val result : ('a, F.formatter, unit) format -> 'a
 (** Emit a result to stdout. Use only if the output format is stable and useful enough that it may
     conceivably get piped to another program, ie, almost never (use [progress] instead otherwise).
 *)
 
-val user_error : ('a, Format.formatter, unit) format -> 'a
+val user_error : ('a, F.formatter, unit) format -> 'a
 (** bad input, etc. detected *)
 
-val user_warning : ('a, Format.formatter, unit) format -> 'a
+val user_warning : ('a, F.formatter, unit) format -> 'a
 
-val internal_error : ('a, Format.formatter, unit) format -> 'a
+val internal_error : ('a, F.formatter, unit) format -> 'a
 (** huho, infer has a bug *)
 
-val external_error : ('a, Format.formatter, unit) format -> 'a
+val external_error : ('a, F.formatter, unit) format -> 'a
 (** some other tool has a bug or is called wrongly *)
 
-val external_warning : ('a, Format.formatter, unit) format -> 'a
+val external_warning : ('a, F.formatter, unit) format -> 'a
 
 type debug_kind = Analysis | BufferOverrun | Capture | Linters | MergeCapture
 
@@ -53,16 +55,25 @@ type debug_level =
   | Medium  (** still fairly lightweight, eg emitted O(<number of infer processes>) *)
   | Verbose  (** go crazy *)
 
-val debug : debug_kind -> debug_level -> ('a, Format.formatter, unit) format -> 'a
+val debug : debug_kind -> debug_level -> ('a, F.formatter, unit) format -> 'a
 (** log debug info *)
 
+(** kind of error for [die], with similar semantics as above *)
+type error = UserError | ExternalError | InternalError
+
+val die : error -> ('a, F.formatter, unit, _) format4 -> 'a
+(** Print message and exit. The error code depends on [error].
+
+    Do not use lightly: failing hard should not be considered unless it's impossible to keep
+    going. *)
+
 (** Type of location in ml source: __POS__ *)
 type ml_loc = string * int * int * int
 
 val ml_loc_to_string : ml_loc -> string
 (** Convert a ml location to a string *)
 
-val pp_ml_loc_opt : Format.formatter -> ml_loc option -> unit
+val pp_ml_loc_opt : F.formatter -> ml_loc option -> unit
 (** Pretty print a location of ml source *)
 
 (** log management *)
@@ -119,7 +130,7 @@ type print_type =
 (** delayable print action *)
 type print_action = print_type * Obj.t  (** data to be printed *)
 
-val printer_hook : (Format.formatter -> print_action -> unit) ref
+val printer_hook : (F.formatter -> print_action -> unit) ref
 (** hook for the current printer of delayed print actions *)
 
 val add_print_action : print_action -> unit

infer/src/base/Process.ml

@@ -28,11 +28,11 @@ let create_process_and_wait ~prog ~args =
   |> function
     | Ok ()
      -> ()
-    | Error err as status
+    | Error _ as status
-     -> L.external_error "Error executing: %s@\n%s@\n"
+     -> L.(die ExternalError)
+          "Error executing: %s@\n%s@\n"
           (String.concat ~sep:" " (prog :: args))
-          (Unix.Exit_or_signal.to_string_hum status) ;
+          (Unix.Exit_or_signal.to_string_hum status)
-        exit (match err with `Exit_non_zero i -> i | `Signal _ -> 1)
 
 (** Given a process id and a function that describes the command that the process id
     represents, prints a message explaining the command and its status, if in debug or stats mode.

infer/src/integration/CaptureCompilationDatabase.ml

@@ -128,7 +128,7 @@ let get_compilation_database_files_xcodebuild ~prog ~args =
   | Ok (), Ok ()
    -> [`Escaped tmp_file]
   | _
-   -> L.external_error "There was an error executing the build command" ; exit 1
+   -> L.(die ExternalError) "There was an error executing the build command"
 
 let capture_files_in_database ~changed_files compilation_database =
   let filter_changed =