[infer][PR] Clean temporary files created by the clang frontend

Summary:
This commit augments codes to clean up temporary files generated by the clang frontend.

Currently clang frontend leaves large number of temporary files int the tmp directory, and it could be seen for example by running these command:
```
git clean -xdf infer/models/
mkdir /tmp/infer
env TMPDIR=/tmp/infer make infer_models
ls -l /tmp/infer
```
P.S. Analyzing real project could easily cause each infer capture to leave hundreds of  files in /tmp
P.P.S.  There are 11 total references to Filename.temp_file however, other 9 seems don't leak temporary files in such large scale (at least not when using the clang frontend).
Closes https://github.com/facebook/infer/pull/816

Reviewed By: jvillard

Differential Revision: D6385311

Pulled By: dulmarod

fbshipit-source-id: f7956b0

infer/src/base/CommandLineOption.ml

@@ -965,6 +965,8 @@ let parse_args ~usage initial_action ?initial_command args =
   parse_loop () ; curr_usage
 
 
+let keep_args_file = ref false
+
 let parse ?config_file ~usage action initial_command =
   let env_args = decode_env_to_argv (Option.value (Sys.getenv args_env_var) ~default:"") in
   let inferconfig_args =
@@ -1008,6 +1010,7 @@ let parse ?config_file ~usage action initial_command =
          to prevent this from happening *)
       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
     else ""
   in

infer/src/base/CommandLineOption.mli

@@ -249,3 +249,5 @@ val show_manual :
 (** Display the manual of [command] to the user, or [command_doc] if [command] is None. [format] is
     used as for [Cmdliner.Manpage.print]. If [internal_section] is specified, add a section titled
     [internal_section] about internal (hidden) options. *)
+
+val keep_args_file : bool ref

infer/src/base/Config.ml

@@ -1057,6 +1057,7 @@ and ( bo_debug
       "Debug mode (also sets $(b,--debug-level 2), $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), $(b,--print-types), $(b,--reports-include-ml-loc), $(b,--no-only-cheap-debug), $(b,--trace-error), $(b,--write-dotty), $(b,--write-html))"
       ~f:(fun debug ->
         if debug then set_debug_level 2 else set_debug_level 0 ;
+        CommandLineOption.keep_args_file := debug ;
         debug )
       [ developer_mode
       ; print_buckets
@@ -2055,14 +2056,7 @@ let inferconfig_file =
       find (Sys.getcwd ()) |> Option.map ~f:(fun dir -> dir ^/ CommandDoc.inferconfig_file)
 
 
-let late_epilogue_callback = ref (fun () -> ())
-
-let register_late_epilogue f =
-  let g = !late_epilogue_callback in
-  late_epilogue_callback := fun () -> f () ; g ()
-
-
-let late_epilogue () = !late_epilogue_callback ()
+let register_late_epilogue = Epilogues.register_late
 
 let post_parsing_initialization command_opt =
   if CommandLineOption.is_originator then
@@ -2160,7 +2154,7 @@ let post_parsing_initialization command_opt =
       Out_channel.newline stderr ) ;
     let exitcode = L.exit_code_of_exception exn in
     L.log_uncaught_exception exn ~exitcode ;
-    late_epilogue () ;
+    Epilogues.late () ;
     Pervasives.exit exitcode
   in
   Caml.Printexc.set_uncaught_exception_handler uncaught_exception_handler ;

infer/src/base/Config.mli

@@ -741,5 +741,3 @@ val print_usage_exit : unit -> 'a
 (** Miscellanous *)
 
 val register_late_epilogue : (unit -> unit) -> unit
-
-val late_epilogue : unit -> unit

infer/src/base/Epilogues.ml

@@ -9,6 +9,15 @@
 open! IStd
 module F = Format
 
+let late_callback = ref (fun () -> ())
+
+let register_late f =
+  let g = !late_callback in
+  late_callback := fun () -> f () ; g ()
+
+
+let late () = !late_callback ()
+
 (* Run the epilogues when we get SIGINT (Control-C). We do not want to mask SIGINT unless at least
    one epilogue has been registered, so make this value lazy. *)
 let activate_run_epilogues_on_signal =
@@ -18,7 +27,7 @@ let activate_run_epilogues_on_signal =
          (Filename.basename Sys.executable_name)
          (Signal.to_string s) ;
        (* Invoke the callback that runs at the end of uncaught_exception_handler *)
-       Config.late_epilogue () ;
+       late () ;
        (* Epilogues are registered with [at_exit] so exiting will make them run. *)
        Pervasives.exit 0
      in
@@ -27,7 +36,7 @@ let activate_run_epilogues_on_signal =
 
 let register ~f desc =
   let f_no_exn () =
-    if not !ProcessPool.in_child then
+    if not !ProcessPoolState.in_child then
       try f () with exn ->
         F.eprintf "Error while running epilogue \"%s\":@ %a.@ Powering through...@." desc Exn.pp
           exn

infer/src/base/Epilogues.mli

@@ -12,3 +12,7 @@ open! IStd
 val register : f:(unit -> unit) -> string -> unit
 (** Register a function to run when the program exits or is interrupted. Registered functions are
     run in the reverse order in which they were registered. *)
+
+val register_late : (unit -> unit) -> unit
+
+val late : unit -> unit

infer/src/base/ProcessPool.ml

@@ -8,9 +8,6 @@
  *)
 open! IStd
 
-(** Keep track of whether the current execution is in a child process *)
-let in_child = ref false
-
 type t = {mutable num_processes: int; jobs: int}
 
 exception Execution_error of string
@@ -39,7 +36,7 @@ let should_wait counter = counter.num_processes >= counter.jobs
 let start_child ~f ~pool x =
   match Unix.fork () with
   | `In_the_child ->
-      in_child := true ;
+      ProcessPoolState.in_child := true ;
       f x ;
       Pervasives.exit 0
   | `In_the_parent _pid ->

infer/src/base/ProcessPool.mli

@@ -24,5 +24,3 @@ val start_child : f:('a -> unit) -> pool:t -> 'a -> unit
 val wait_all : t -> unit
 (** Wait until all the currently executing processes terminate *)
 
-val in_child : bool ref
-(** Keep track of whether the current execution is in a child process *)

infer/src/base/ProcessPoolState.ml

@@ -0,0 +1,10 @@
+(*
+ * Copyright (c) 2018 - 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.
+ *)
+(** Keep track of whether the current execution is in a child process *)
+let in_child = ref false

infer/src/base/ProcessPoolState.mli

@@ -0,0 +1,10 @@
+(*
+ * Copyright (c) 2018 - 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.
+ *)
+val in_child : bool ref
+(** Keep track of whether the current execution is in a child process *)

infer/src/base/Utils.ml

@@ -391,3 +391,7 @@ let yield () =
 
 
 let better_hash x = Marshal.to_string x [Marshal.No_sharing] |> Caml.Digest.string
+
+let unlink_file_on_exit temp_file =
+  "Cleaning temporary file " ^ temp_file
+  |> Epilogues.register ~f:(fun () -> try Unix.unlink temp_file with _ -> ())

infer/src/base/Utils.mli

@@ -113,3 +113,6 @@ val yield : unit -> unit
 
 val better_hash : 'a -> Caml.Digest.t
 (** Hashtbl.hash only hashes the first 10 meaningful values, [better_hash] uses everything. *)
+
+val unlink_file_on_exit : string -> unit
+(** delete [temporary] file on exit *)

infer/src/integration/ClangQuotes.ml

@@ -37,4 +37,5 @@ let mk_arg_file prefix style args =
   in
   Utils.with_file_out file ~f:write_args |> ignore ;
   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