Serialization: lock files before writing

Summary:
For writes of serialized data, write directly to the file instead of using a temporary one, and lock the file before writing.
Also added an `update` function to the API, to update an existing version of the data file instead of just replacing it with a new value.

Reviewed By: jberdine

Differential Revision: D4619958

fbshipit-source-id: 9642408

infer/src/IR/AttributesTable.re

@@ -63,7 +63,7 @@ let load_attr defined_only::defined_only proc_name => {
 let write_and_delete proc_name (proc_attributes: ProcAttributes.t) => {
   let attributes_file defined => res_dir_attr_filename defined::defined proc_name;
   Serialization.write_to_file
-    serializer (attributes_file proc_attributes.is_defined) proc_attributes;
+    serializer (attributes_file proc_attributes.is_defined) data::proc_attributes;
   if proc_attributes.is_defined {
     let fname_declared = DB.filename_to_string (attributes_file false);
     if (Sys.file_exists fname_declared == `Yes) {

infer/src/IR/Cfg.re

@@ -336,7 +336,7 @@ let store_cfg_to_file source_file::source_file (filename: DB.filename) (cfg: cfg
      OndemandCapture module relies on it - it uses existance of .cfg file as a barrier to make
      sure that all attributes were written to disk (but not necessarily flushed) */
   save_attributes source_file cfg;
-  Serialization.write_to_file cfg_serializer filename cfg
+  Serialization.write_to_file cfg_serializer filename data::cfg
 };
 
 

infer/src/IR/Cg.re

@@ -375,7 +375,7 @@ let load_from_file (filename: DB.filename) :option t =>
 /** Save a call graph into a file */
 let store_to_file (filename: DB.filename) (call_graph: t) =>
   Serialization.write_to_file
-    callgraph_serializer filename (call_graph.source, get_nodes_and_edges call_graph);
+    callgraph_serializer filename data::(call_graph.source, get_nodes_and_edges call_graph);
 
 let pp_graph_dotty get_specs (g: t) fmt => {
   let nodes_with_calls = get_all_nodes g;

infer/src/IR/LintIssues.ml

@@ -27,7 +27,7 @@ let lint_issues_serializer : (Errlog.t Procname.Map.t) Serialization.serializer
 
 (** Save issues to a file *)
 let store_issues filename errLogMap =
-  Serialization.write_to_file lint_issues_serializer filename errLogMap
+  Serialization.write_to_file lint_issues_serializer filename ~data:errLogMap
 
 (** Load issues from the given file *)
 let load_issues issues_file =

infer/src/IR/Tenv.re

@@ -139,7 +139,7 @@ let store_to_file (filename: DB.filename) (tenv: t) => {
   if (DB.equal_filename filename DB.global_tenv_fname) {
     global_tenv := Some tenv
   };
-  Serialization.write_to_file tenv_serializer filename tenv;
+  Serialization.write_to_file tenv_serializer filename data::tenv;
   if Config.debug_mode {
     let debug_filename = DB.filename_to_string (DB.filename_add_suffix filename ".debug");
     let out_channel = open_out debug_filename;

infer/src/backend/InferPrint.re

@@ -1233,7 +1233,7 @@ let module AnalysisResults = {
 
   /** Save analysis_results into a file */
   let store_analysis_results_to_file (filename: DB.filename) (analysis_results: t) =>
-    Serialization.write_to_file analysis_results_serializer filename analysis_results;
+    Serialization.write_to_file analysis_results_serializer filename data::analysis_results;
 
   /** Return an iterator over all the summaries.
       If options - load_results or - save_results are used,

infer/src/backend/cluster.ml

@@ -29,8 +29,8 @@ let load_from_file (filename : DB.filename) : serializer_t option =
   Serialization.read_from_file serializer filename
 
 (** Save a cluster into a file *)
-let store_to_file (filename : DB.filename) (serializer_t: serializer_t) =
+let store_to_file (filename : DB.filename) (data: serializer_t) =
-  Serialization.write_to_file serializer filename serializer_t
+  Serialization.write_to_file serializer filename ~data
 
 let cl_name n = "cl" ^ string_of_int n
 let cl_file n = "x" ^ (cl_name n) ^ ".cluster"

infer/src/backend/specs.ml

@@ -557,7 +557,7 @@ let store_summary pname (summ1: summary) =
         stats = { summ1.stats with stats_time = 0.0} } in
   let final_summary = { summ3 with status = Analyzed } in
   add_summary pname summ3 (* Make sure the summary in memory is identical to the saved one *);
-  Serialization.write_to_file summary_serializer (res_dir_specs_filename pname) final_summary
+  Serialization.write_to_file summary_serializer (res_dir_specs_filename pname) ~data:final_summary
 
 (** Load procedure summary from the given file *)
 let load_summary specs_file =

infer/src/base/Serialization.ml

@@ -16,9 +16,10 @@ module F = Format
 (** Generic serializer *)
 type 'a serializer =
   {
-    read_from_string: (string -> 'a option);
+    read_from_string: string -> 'a option;
-    read_from_file: (DB.filename -> 'a option);
+    read_from_file: DB.filename -> 'a option;
-    write_to_file: (DB.filename -> 'a -> unit);
+    update_file : f:('a option -> 'a) -> DB.filename -> unit;
+    write_to_file: data:'a -> DB.filename -> unit;
   }
 
 module Key = struct
@@ -49,6 +50,9 @@ let retry_exception ~timeout ~catch_exn ~f x =
         retry () in
   retry ()
 
+type 'a write_command =
+  | Replace of 'a
+  | Update of ('a option -> 'a)
 
 let create_serializer (key : Key.t) : 'a serializer =
   let read_data ((key': Key.t), (version': int), (value: 'a)) source_msg =
@@ -88,17 +92,31 @@ let create_serializer (key : Key.t) : 'a serializer =
         SymOp.try_finally
           (fun () -> retry_exception ~timeout:1.0 ~catch_exn ~f:read ())
           (fun () -> In_channel.close inc) in
-  let write_to_file (fname : DB.filename) (value : 'a) =
+  let execute_write_command (fname : DB.filename) (cmd : 'a write_command) =
     let fname_str = DB.filename_to_string fname in
-    (* support nonblocking reads and writes in parallel: *)
+    let file_descr = Unix.openfile ~mode:[Unix.O_WRONLY; Unix.O_CREAT] fname_str in
-    (* write to a tmp file and use rename which is atomic *)
+    if (Unix.flock file_descr Unix.Flock_command.lock_exclusive)
-    let fname_tmp = Filename.temp_file
+    then begin
-        ~in_dir:(Filename.dirname fname_str) (Filename.basename fname_str) ".tmp" in
+      let (value_to_write : 'a) = match cmd with
-    let outc = open_out_bin fname_tmp in
+        | Replace value ->
-    Marshal.to_channel outc (key, version, value) [];
+            value
-    Out_channel.close outc;
+        | Update upd ->
-    Unix.rename ~src:fname_tmp ~dst:fname_str in
+            let old_value_opt =
-  {read_from_string; read_from_file; write_to_file}
+              let st_size = (Unix.fstat file_descr).st_size in
+              if st_size > 0L
+              then read_from_file fname
+              else None in
+            upd old_value_opt in
+      let outc = Unix.out_channel_of_descr file_descr in
+      Marshal.to_channel outc (key, version, value_to_write) [];
+      ignore (Unix.flock file_descr Unix.Flock_command.unlock);
+      Out_channel.close outc
+    end in
+  let write_to_file ~(data : 'a) (fname : DB.filename) =
+    execute_write_command fname (Replace data) in
+  let update_file ~f (fname : DB.filename) =
+    execute_write_command fname (Update f) in
+  {read_from_string; read_from_file; update_file; write_to_file; }
 
 
 let read_from_string s =
@@ -107,6 +125,9 @@ let read_from_string s =
 let read_from_file s =
   s.read_from_file
 
+let update_file s =
+  s.update_file
+
 let write_to_file s =
   s.write_to_file
 

infer/src/base/Serialization.mli

@@ -59,5 +59,9 @@ val read_from_file : 'a serializer -> DB.filename -> 'a option
 (** Deserialize a string and check the keys *)
 val read_from_string : 'a serializer -> string -> 'a option
 
-(** Serialize into a file *)
+(** Serialize into a file.
-val write_to_file : 'a serializer -> DB.filename -> 'a -> unit
+    The upd function takes the old value, if any, and returns the value to write *)
+val update_file : 'a serializer -> f:('a option -> 'a) -> DB.filename -> unit
+
+(** Serialize into a file writing value *)
+val write_to_file : 'a serializer -> data:'a -> DB.filename -> unit