[driver] better user error messages

Summary:
- Do not print OCaml backtrace unless in developer mode.
- Print javac output when it fails.
- Refactor Javac.ml so that rerunning the command doesn't duplicate code.

The output of the clang and Javac integration is good, the output for mvn is
ok, the output for Buck is still fairly "meh".

Reviewed By: jberdine

Differential Revision: D4818722

fbshipit-source-id: 1973b93

infer/src/base/Config.ml

@@ -1499,7 +1499,16 @@ let post_parsing_initialization () =
   );
   if !version <> `None then exit 0;
 
-  if !developer_mode then Printexc.record_backtrace true ;
+  (* Core sets a verbose exception handler by default, with backtrace. This is good for developers
+     but in user-mode we want something lighter weight. *)
+  if not !developer_mode then
+    Caml.Printexc.set_uncaught_exception_handler
+      (fun exn _ ->
+         let exn_msg = match exn with
+           | Failure msg -> msg
+           | _ -> "ERROR: " ^ Caml.Printexc.to_string exn in
+         Format.eprintf "%s@?" exn_msg
+      );
 
   F.set_margin !margin ;
 

infer/src/base/Utils.ml

@@ -205,14 +205,20 @@ let do_finally f g =
   let res' = g () in
   (res, res')
 
-let with_file file ~f =
-  let oc = open_out file in
+let with_file_in file ~f =
+  let ic = In_channel.create file in
+  let f () = f ic in
+  let g () =  In_channel.close ic in
+  do_finally f g |> fst
+
+let with_file_out file ~f =
+  let oc = Out_channel.create file in
   let f () = f oc in
-  let g () = Out_channel.close oc in
+  let g () =  Out_channel.close oc in
   do_finally f g |> fst
 
 let write_json_to_file destfile json =
-  with_file destfile ~f:(fun oc -> Yojson.Basic.pretty_to_channel oc json)
+  with_file_out destfile ~f:(fun oc -> Yojson.Basic.pretty_to_channel oc json)
 
 let consume_in chan_in =
   try
@@ -227,6 +233,18 @@ let with_process_in command read =
     Unix.close_process_in chan in
   do_finally f g
 
+let shell_escape_command cmd =
+  let escape arg =
+    (* ends on-going single quote, output single quote inside double quotes, then open a new single
+       quote *)
+    Escape.escape_map (function | '\'' -> Some "'\"'\"'" | _ -> None) arg
+    |> Printf.sprintf "'%s'" in
+  List.map ~f:escape cmd |> String.concat ~sep:" "
+
+let run_command_and_get_output cmd =
+  let shell_escaped_cmd = shell_escape_command cmd in
+  with_process_in (Printf.sprintf "%s 2>&1" shell_escaped_cmd) In_channel.input_lines
+
 (** Create a directory if it does not exist already. *)
 let create_dir dir =
   try

infer/src/base/Utils.mli

@@ -57,13 +57,16 @@ val dir_is_empty : string -> bool
 
 val read_optional_json_file : string -> (Yojson.Basic.json, string) Result.t
 
-val with_file : string -> f:(out_channel -> 'a) -> 'a
+val with_file_in : string -> f:(In_channel.t -> 'a) -> 'a
+val with_file_out : string -> f:(Out_channel.t -> 'a) -> 'a
 
 val write_json_to_file : string -> Yojson.Basic.json -> unit
 
 val consume_in : in_channel -> unit
 
-val with_process_in: string -> (in_channel -> 'a) -> ('a * Unix.Exit_or_signal.t)
+val with_process_in : string -> (in_channel -> 'a) -> ('a * Unix.Exit_or_signal.t)
+
+val shell_escape_command : string list -> string
 
 (** create a directory if it does not exist already *)
 val create_dir : string -> unit

infer/src/clang/ClangWrapper.re

@@ -87,12 +87,12 @@ let normalize prog::prog args::args :list action_item => {
 
 let exec_action_item =
   fun
-  | ClangError error => {
-      /* An error in the output of `clang -### ...`. Outputs the error and fail. This is because
-         `clang -###` pretty much never fails, but warns of failures on stderr instead. */
-      Logging.stderr "%s@." error;
-      exit 1
-    }
+  | ClangError error =>
+    /* An error in the output of `clang -### ...`. Outputs the error and fail. This is because
+       `clang -###` pretty much never fails, but warns of failures on stderr instead. */
+    failwithf
+      "@\n*** ERROR: Failed to execute compilation command. Output:@\n%s@\n*** Infer needs a working compilation command to run.@."
+      error
   | ClangWarning warning => Logging.stderr "%s@\n" warning
   | Command clang_cmd => Capture.capture clang_cmd;
 

infer/src/clang/cTL.ml

@@ -313,7 +313,7 @@ let save_dotty_when_in_debug_mode source_file =
       let source_file_basename = Filename.basename (SourceFile.to_abs_path source_file) in
       let file = dotty_dir ^/ (source_file_basename ^ ".dot") in
       let dotty = Debug.EvaluationTracker.DottyPrinter.dotty_of_ctl_evaluation !tracker in
-      Utils.with_file file ~f:(fun oc -> output_string oc dotty)
+      Utils.with_file_out file ~f:(fun oc -> output_string oc dotty)
   | _ -> ()
 
 (* Helper functions *)

infer/src/integration/CaptureCompilationDatabase.ml

@@ -87,8 +87,7 @@ let get_compilation_database_files_buck () =
       Process.create_process_and_wait ~prog:buck ~args:build_args;
       let buck_targets_shell =
         buck :: "targets" :: "--show-output" :: args_with_flavor
-        |> List.map ~f:(Printf.sprintf "'%s'")
-        |> String.concat ~sep:" " in
+        |> Utils.shell_escape_command in
       try
         match fst @@ Utils.with_process_in buck_targets_shell In_channel.input_lines with
         | [] -> Logging.stdout "There are no files to process, exiting."; exit 0
@@ -107,8 +106,7 @@ let get_compilation_database_files_buck () =
             List.fold ~f:scan_output ~init:[] lines
       with Unix.Unix_error (err, _, _) ->
         Process.print_error_and_exit
-          "Cannot execute %s\n%!"
-          (buck_targets_shell ^ " " ^ (Unix.error_message err))
+          "Cannot execute %s: %s\n%!" buck_targets_shell (Unix.error_message err)
     )
   | _ ->
       let cmd = String.concat ~sep:" " cmd in

infer/src/integration/ClangQuotes.re

@@ -36,7 +36,7 @@ let mk_arg_file prefix style args => {
   let file = Filename.temp_file in_dir::temp_dir prefix ".txt";
   let write_args outc =>
     output_string outc (List.map f::(quote style) args |> String.concat sep::" ");
-  Utils.with_file file f::write_args |> ignore;
+  Utils.with_file_out file f::write_args |> ignore;
   Logging.out "Clang options stored in file %s@\n" file;
   file
 };

infer/src/integration/Javac.ml

@@ -59,23 +59,37 @@ let compile compiler build_prog build_args =
     file in
   let cli_file_args = cli_args @ ["@" ^ args_file] in
   let args = prog_args @ cli_file_args in
+  L.out "Current working directory: '%s'@." (Sys.getcwd ());
   let verbose_out_file = Filename.temp_file "javac_" ".out" in
-  Unix.with_file verbose_out_file ~mode:[Unix.O_WRONLY] ~f:(
-    fun verbose_out_fd ->
-      L.out "Logging into %s@\n" verbose_out_file;
-      L.out "Current working directory: '%s'@." (Sys.getcwd ());
-      try
-        L.out "Trying to execute: '%s' '%s'@." prog (String.concat ~sep:"' '" args);
-        Unix_.fork_redirect_exec_wait ~prog ~args ~stderr:verbose_out_fd ()
-      with exn ->
-      try
-        L.out "*** Failed!@\nTrying to execute javac instead: '%s' '%s'@\nLogging into %s@."
-          "javac" (String.concat ~sep:"' '" cli_file_args) verbose_out_file;
-        Unix_.fork_redirect_exec_wait ~prog:"javac" ~args:cli_file_args ~stderr:verbose_out_fd ()
-      with _ ->
-        L.stderr "Failed to execute: %s %s@." prog (String.concat ~sep:" " args);
-        raise exn
-  );
+  let try_run cmd error_k =
+    let shell_cmd = Utils.shell_escape_command cmd in
+    let shell_cmd_redirected =
+      Printf.sprintf "%s 2>'%s'" shell_cmd verbose_out_file in
+    L.out "Trying to execute: %s@." shell_cmd_redirected;
+    let error_k_or_fail err_msg =
+      match error_k, err_msg with
+      | Some k, (`UnixError (err, log)) ->
+          L.out "*** Failed: %s!@\n%s@." (Unix.Exit_or_signal.to_string_hum (Error err)) log;
+          k ()
+      | Some k, (`ExceptionError exn) ->
+          L.out "*** Failed: %a!@\n" Exn.pp exn;
+          k ()
+      | None, (`UnixError (err, log)) ->
+          let verbose_errlog = Utils.with_file_in verbose_out_file ~f:In_channel.input_all in
+          failwithf "@\n*** ERROR Failed to execute compilation command: %s@\n*** Command: %s@\n\
+                     *** Output:@\n%s%s@\n*** Infer needs a working compilation command to run.@."
+            (Unix.Exit_or_signal.to_string_hum (Error err)) shell_cmd log verbose_errlog;
+      | None, (`ExceptionError exn) ->
+          raise exn in
+    match Utils.with_process_in shell_cmd_redirected In_channel.input_all with
+    | (log, Error err) ->
+        error_k_or_fail (`UnixError (err, log))
+    | exception exn ->
+        error_k_or_fail (`ExceptionError exn)
+    | (log, Ok ()) ->
+        L.out "*** Success. Logs:@\n%s" log in
+  let fallback () = try_run ("javac"::cli_file_args) None in
+  try_run (prog::args) (Some fallback);
   verbose_out_file
 
 

infer/src/integration/Maven.ml

@@ -120,7 +120,7 @@ let add_infer_profile mvn_pom infer_pom =
       let xml_out = Xmlm.make_output ~nl:true (`Channel out_chan) in
       add_infer_profile_to_xml (Filename.dirname mvn_pom) xml_in xml_out in
     protect ~f:with_ic ~finally:(fun () -> In_channel.close ic) in
-  Utils.with_file infer_pom ~f:with_oc
+  Utils.with_file_out infer_pom ~f:with_oc
 
 let add_profile_to_pom_in_directory dir =
   (* Even though there is a "-f" command-line arguments to change the config file Maven reads from,