[capture] store compilation db arguments one per line

Summary:
Infer reads the arguments passed to clang, in particular to filter out some
incompatible clang command-line options. But, infer only understands arguments
in arg files if they are presented one per line. That's usually the case, but
infer itself stores clang arguments from compilation databases all on one line.
This breaks filtering.

This changes the type of compilation database items to a list of arguments, so
that they can be stored one per line when possible.

Also does some cleanup/renamings, and remove trailing `_` from temp file names, eg:

  clang_command_.tmp.2b2602.txt -> clang_command.tmp.2b2602.txt

Also, do not escape arguments from arg files when printing them in logs (that
was useless and ugly).

Reviewed By: mbouaziz

Differential Revision: D7365907

fbshipit-source-id: 5a3fe70

infer/src/base/CommandLineOption.ml

@@ -927,7 +927,7 @@ let parse ?config_file ~usage action initial_command =
          environment contributes to the length of the command to be run. If the environment + CLI is
          too big, running any command will fail with a cryptic "exit code 127" error. Use an argfile
          to prevent this from happening *)
-      let file = Filename.temp_file "args_" "" in
+      let file = Filename.temp_file "args" "" in
       Out_channel.with_file file ~f:(fun oc -> Out_channel.output_lines oc argv_to_export) ;
       if not !keep_args_file then Utils.unlink_file_on_exit file ;
       "@" ^ file )

infer/src/base/Escape.ml

@@ -12,6 +12,8 @@ open! IStd
 (** Escape a string for use in a CSV or XML file: replace reserved
     characters with escape sequences *)
 
+module F = Format
+
 (** apply a map function for escape sequences *)
 let escape_map map_fun s =
   let needs_escape = String.exists ~f:(fun c -> Option.is_some (map_fun c)) s in
@@ -134,3 +136,21 @@ let escape_double_quotes s = escape_map (function '"' -> Some "\\\"" | _ -> None
 
 let escape_in_single_quotes s =
   Printf.sprintf "'%s'" (escape_map (function '\'' -> Some "'\\''" | _ -> None) s)
+
+
+let escape_shell =
+  let no_quote_needed = Str.regexp "^[A-Za-z0-9-_%/:,.]+$" in
+  let easy_single_quotable = Str.regexp "^[^']+$" in
+  let easy_double_quotable = Str.regexp "^[^$`\\!]+$" in
+  function
+    | "" ->
+        "''"
+    | arg ->
+        if Str.string_match no_quote_needed arg 0 then arg
+        else if Str.string_match easy_single_quotable arg 0 then F.sprintf "'%s'" arg
+        else if Str.string_match easy_double_quotable arg 0 then
+          escape_double_quotes arg |> F.sprintf "\"%s\""
+        else
+          (* ends on-going single quote, output single quote inside double quotes, then open a new
+             single quote *)
+          escape_map (function '\'' -> Some "'\"'\"'" | _ -> None) arg |> F.sprintf "'%s'"

infer/src/base/Escape.mli

@@ -37,3 +37,6 @@ val escape_double_quotes : string -> string
 
 val escape_in_single_quotes : string -> string
 (** put the string inside single quotes and escape the single quotes within that string *)
+
+val escape_shell : string -> string
+(** escape the string so it can be passed to the shell without remorse *)

infer/src/base/Pp.ml

@@ -137,8 +137,7 @@ let to_string ~f fmt x = string fmt (f x)
 let cli_args fmt args =
   let pp_args fmt args =
     F.fprintf fmt "@[<hov2>  " ;
-    seq ~sep:"" ~print_env:{text with break_lines= true} string fmt
+    seq ~sep:"" ~print_env:{text with break_lines= true} string fmt args ;
-      (List.map args ~f:Escape.escape_in_single_quotes) ;
     F.fprintf fmt "@]@\n"
   in
   let rec pp_argfile_args in_argfiles fmt args =

infer/src/base/Utils.ml

@@ -208,29 +208,8 @@ let with_process_in command read =
   do_finally_swallow_timeout ~f ~finally
 
 
-let shell_escape_command =
-  let no_quote_needed = Str.regexp "^[A-Za-z0-9-_%/:,.]+$" in
-  let easy_single_quotable = Str.regexp "^[^']+$" in
-  let easy_double_quotable = Str.regexp "^[^$`\\!]+$" in
-  let escape = function
-    | "" ->
-        "''"
-    | arg ->
-        if Str.string_match no_quote_needed arg 0 then arg
-        else if Str.string_match easy_single_quotable arg 0 then F.sprintf "'%s'" arg
-        else if Str.string_match easy_double_quotable arg 0 then
-          arg |> Escape.escape_double_quotes |> F.sprintf "\"%s\""
-        else
-          (* ends on-going single quote, output single quote inside double quotes, then open a new single
-       quote *)
-          arg |> Escape.escape_map (function '\'' -> Some "'\"'\"'" | _ -> None)
-          |> F.sprintf "'%s'"
-  in
-  fun cmd -> List.map ~f:escape cmd |> String.concat ~sep:" "
-
-
 let with_process_lines ~(debug: ('a, F.formatter, unit) format -> 'a) ~cmd ~tmp_prefix ~f =
-  let shell_cmd = shell_escape_command cmd in
+  let shell_cmd = List.map ~f:Escape.escape_shell cmd |> String.concat ~sep:" " in
   let verbose_err_file = Filename.temp_file tmp_prefix ".err" in
   let shell_cmd_redirected = Printf.sprintf "%s 2>'%s'" shell_cmd verbose_err_file in
   debug "Trying to execute: %s@\n%!" shell_cmd_redirected ;

infer/src/base/Utils.mli

@@ -66,8 +66,6 @@ val echo_in : In_channel.t -> unit
 
 val with_process_in : string -> (In_channel.t -> 'a) -> 'a * Unix.Exit_or_signal.t
 
-val shell_escape_command : string list -> string
-
 val with_process_lines :
   debug:((string -> unit, Format.formatter, unit) format -> string -> unit) -> cmd:string list
   -> tmp_prefix:string -> f:(string list -> 'res) -> 'res

infer/src/integration/Buck.ml

@@ -259,7 +259,7 @@ let rec exceed_length ~max = function
 
 let store_args_in_file args =
   if exceed_length ~max:max_command_line_length args then (
-    let file = Filename.temp_file "buck_targets_" ".txt" in
+    let file = Filename.temp_file "buck_targets" ".txt" in
     let write_args outc = Out_channel.output_string outc (String.concat ~sep:"\n" args) in
     let () = Utils.with_file_out file ~f:write_args in
     L.(debug Capture Quiet) "Buck targets options stored in file '%s'@\n" file ;

infer/src/integration/CaptureCompilationDatabase.ml

@@ -12,17 +12,18 @@ module F = Format
 module CLOpt = CommandLineOption
 module L = Logging
 
-type cmd = {cwd: string; prog: string; args: string}
-
 let create_cmd (compilation_data: CompilationDatabase.compilation_data) =
-  let swap_command cmd =
+  let swap_executable cmd =
     if String.is_suffix ~suffix:"++" cmd then Config.wrappers_dir ^/ "clang++"
     else Config.wrappers_dir ^/ "clang"
   in
   let arg_file =
-    ClangQuotes.mk_arg_file "cdb_clang_args_" ClangQuotes.EscapedNoQuotes [compilation_data.args]
+    ClangQuotes.mk_arg_file "cdb_clang_args" ClangQuotes.EscapedNoQuotes
+      compilation_data.escaped_arguments
   in
-  {cwd= compilation_data.dir; prog= swap_command compilation_data.command; args= arg_file}
+  { CompilationDatabase.directory= compilation_data.directory
+  ; executable= swap_executable compilation_data.executable
+  ; escaped_arguments= ["@" ^ arg_file; "-fsyntax-only"] }
 
 
 (* A sentinel is a file which indicates that a failure occurred in another infer process.
@@ -33,7 +34,7 @@ let sentinel_exists sentinel_opt =
   Option.value_map ~default:false sentinel_opt ~f:file_exists
 
 
-let invoke_cmd ~fail_sentinel cmd =
+let invoke_cmd ~fail_sentinel (cmd: CompilationDatabase.compilation_data) =
   let create_sentinel_if_needed () =
     let create_empty_file fname = Utils.with_file_out ~f:(fun _ -> ()) fname in
     Option.iter fail_sentinel ~f:create_empty_file
@@ -42,9 +43,9 @@ let invoke_cmd ~fail_sentinel cmd =
   else
     try
       let pid =
-        let prog = cmd.prog in
+        let open Spawn in
-        let argv = [prog; "@" ^ cmd.args; "-fsyntax-only"] in
+        spawn ~cwd:(Path cmd.directory) ~prog:cmd.executable
-        Spawn.(spawn ~cwd:(Path cmd.cwd) ~prog ~argv ())
+          ~argv:(cmd.executable :: cmd.escaped_arguments) ()
       in
       match Unix.waitpid (Pid.of_int pid) with
       | Ok () ->

infer/src/integration/ClangQuotes.ml

@@ -32,9 +32,13 @@ let quote style =
 let mk_arg_file prefix style args =
   let file = Filename.temp_file prefix ".txt" in
   let write_args outc =
-    List.map ~f:(quote style) args |> String.concat ~sep:" " |> Out_channel.output_string outc
+    List.iter
+      ~f:(fun arg ->
+        quote style arg |> Out_channel.output_string outc ;
+        Out_channel.newline outc )
+      args
   in
-  Utils.with_file_out file ~f:write_args |> ignore ;
+  Utils.with_file_out file ~f:write_args ;
   L.(debug Capture Medium) "Clang options stored in file %s@\n" file ;
   if not Config.debug_mode then Utils.unlink_file_on_exit file ;
   file

infer/src/integration/CompilationDatabase.ml

@@ -10,7 +10,7 @@
 open! IStd
 module L = Logging
 
-type compilation_data = {dir: string; command: string; args: string}
+type compilation_data = {directory: string; executable: string; escaped_arguments: string list}
 
 type t = compilation_data SourceFile.Map.t ref
 
@@ -27,7 +27,7 @@ let parse_command_and_arguments command_and_arguments =
   let index = Str.search_forward regexp command_and_arguments 0 in
   let command = Str.string_before command_and_arguments (index + 1) in
   let arguments = Str.string_after command_and_arguments (index + 1) in
-  (command, arguments)
+  (command, [arguments])
 
 
 (** Parse the compilation database json file into the compilationDatabase
@@ -91,7 +91,7 @@ let decode_json_file (database: t) json_format =
                 "the value of the \"arguments\" field is an empty list in command %s"
                 (Yojson.Basic.to_string json)
           | cmd :: args ->
-              command := Some (cmd, Utils.shell_escape_command args) )
+              command := Some (cmd, List.map ~f:Escape.escape_shell args) )
       | "arguments", json ->
           exit_format_error
             "the value of the \"arguments\" field is not a list; found '%s' instead"
@@ -104,7 +104,7 @@ let decode_json_file (database: t) json_format =
     match json with
     | `Assoc fields ->
         List.iter ~f:one_field fields ;
-        let dir =
+        let directory =
           match !directory with
           | Some directory ->
               directory
@@ -120,7 +120,7 @@ let decode_json_file (database: t) json_format =
               exit_format_error "no \"file\" entry found in command %s"
                 (Yojson.Basic.to_string json)
         in
-        let command, args =
+        let executable, escaped_arguments =
           match !command with
           | Some x ->
               x
@@ -128,8 +128,8 @@ let decode_json_file (database: t) json_format =
               exit_format_error "no \"command\" or \"arguments\" entry found in command %s"
                 (Yojson.Basic.to_string json)
         in
-        let compilation_data = {dir; command; args} in
+        let compilation_data = {directory; executable; escaped_arguments} in
-        let abs_file = if Filename.is_relative file then dir ^/ file else file in
+        let abs_file = if Filename.is_relative file then directory ^/ file else file in
         let source_file = SourceFile.from_abs_path abs_file in
         database := SourceFile.Map.add source_file compilation_data !database
     | _ ->

infer/src/integration/CompilationDatabase.mli

@@ -11,7 +11,15 @@ open! IStd
 
 type t
 
-type compilation_data = {dir: string; command: string; args: string}
+type compilation_data =
+  { directory: string
+  ; executable: string
+  ; escaped_arguments: string list
+        (** argument list, where each argument is already escaped for the shell. This is because in
+            some cases the argument list contains arguments that are actually themselves a list of
+            arguments, for instance because the compilation database only contains a "command"
+            entry. *)
+  }
 
 val filter_compilation_data : t -> f:(SourceFile.t -> bool) -> compilation_data list
 

infer/src/integration/Javac.ml

@@ -44,9 +44,9 @@ let compile compiler build_prog build_args =
   let cli_file_args = cli_args @ ["@" ^ args_file] in
   let args = prog_args @ cli_file_args in
   L.(debug Capture Quiet) "Current working directory: '%s'@." (Sys.getcwd ()) ;
-  let verbose_out_file = Filename.temp_file "javac_" ".out" in
+  let verbose_out_file = Filename.temp_file "javac" ".out" in
   let try_run cmd error_k =
-    let shell_cmd = Utils.shell_escape_command cmd in
+    let shell_cmd = List.map ~f:Escape.escape_shell cmd |> String.concat ~sep:" " in
     let shell_cmd_redirected = Printf.sprintf "%s 2>'%s'" shell_cmd verbose_out_file in
     L.(debug Capture Quiet) "Trying to execute: %s@." shell_cmd_redirected ;
     match Utils.with_process_in shell_cmd_redirected In_channel.input_all with