hphp/hack/src/server/saveStateService.ml

   1 (**
   2  * Copyright (c) 2015, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11 open SaveStateServiceTypes
  12
  13 let get_errors_filename (filename: string) : string = filename ^ ".err"
  14
  15 let get_decls_filename (filename: string) : string = filename ^ ".decls"
  16
  17 (* Gets a set of file paths out of saved state errors *)
  18 let fold_error_files (errors_in_phases: saved_state_errors) : Relative_path.Set.t =
  19   List.fold
  20     ~init:Relative_path.Set.empty
  21     ~f:(fun acc (_phase, error_files) -> Relative_path.Set.union acc error_files)
  22     errors_in_phases
  23
  24 (* Given saved state errors, produces 2 sets of file paths: one for those that
  25     occurred in the given list of phases, and another one for all the rest.
  26     The 'tf' prefix is in keeping with partition_tf, where it's supposed to
  27     remind you which list matches the predicate (not actually a predicate in this case),
  28     and which doesn't. *)
  29 let partition_error_files_tf
  30   (errors_in_phases: saved_state_errors)
  31   (phases: Errors.phase list): (Relative_path.Set.t * Relative_path.Set.t) =
  32
  33   let (errors_in_phases_t, errors_in_phases_f) =
  34     List.partition_tf
  35       errors_in_phases
  36       ~f:(fun (phase, _error_files) -> List.mem ~equal:(=) phases phase) in
  37
  38   ((fold_error_files errors_in_phases_t), (fold_error_files errors_in_phases_f))
  39
  40 let load_contents_exn (input_filename: string) : 'a =
  41   let ic = Pervasives.open_in_bin input_filename in
  42   let contents = Marshal.from_channel ic in
  43   Pervasives.close_in ic;
  44   contents
  45
  46 let load_class_decls (input_filename: string) : unit =
  47   let start_t = Unix.gettimeofday () in
  48   Hh_logger.log "Begin loading class declarations";
  49   try
  50     Hh_logger.log "Unmarshalling class declarations from %s" input_filename;
  51     let decls = load_contents_exn input_filename in
  52     Hh_logger.log "Importing class declarations...";
  53     let classes = Decl_export.import_class_decls decls in
  54     let num_classes = SSet.cardinal classes in
  55     let msg = Printf.sprintf "Loaded %d class declarations" num_classes in
  56     ignore @@ Hh_logger.log_duration msg start_t
  57   with exn ->
  58     let stack = Printexc.get_backtrace () in
  59     HackEventLogger.load_decls_failure exn stack;
  60     Hh_logger.exc exn ~stack ~prefix:"Failed to load class declarations: "
  61
  62 (* Loads the file info and the errors, if any. *)
  63 let load_saved_state
  64     ~(load_decls: bool)
  65     ~(naming_table_fallback_path: string option)
  66     (saved_state_filename: string)
  67   : Naming_table.t * saved_state_errors =
  68   let old_naming_table = match naming_table_fallback_path with
  69     | Some nt_path ->
  70       Naming_table.load_from_sqlite ~update_reverse_entries:true nt_path
  71     | None ->
  72       let chan = In_channel.create ~binary:true saved_state_filename in
  73       let (old_saved: Naming_table.saved_state_info) =
  74         Marshal.from_channel chan in
  75       Sys_utils.close_in_no_fail saved_state_filename chan;
  76       Naming_table.from_saved old_saved
  77   in
  78
  79   let errors_filename = get_errors_filename saved_state_filename in
  80   let (old_errors: saved_state_errors) = if not (Sys.file_exists errors_filename) then [] else
  81     Marshal.from_channel (In_channel.create ~binary:true errors_filename) in
  82
  83   if load_decls then load_class_decls (get_decls_filename saved_state_filename);
  84
  85   (old_naming_table, old_errors)
  86
  87 (* Writes some OCaml object to a file with the given filename. *)
  88 let dump_contents
  89     (output_filename: string)
  90     (contents: 'a) : unit =
  91   let chan = Pervasives.open_out_bin output_filename in
  92   Marshal.to_channel chan contents [];
  93   Pervasives.close_out chan
  94
  95 let get_hot_classes_filename () =
  96   let prefix = Relative_path.(path_of_prefix Root) in
  97   let (/) = Filename.concat in
  98   prefix / "hack" / "hh_hot_classes.json"
  99
 100 let get_hot_classes (filename: string) : SSet.t =
 101   if not (Disk.file_exists filename)
 102   then begin
 103     Hh_logger.log "Hot classes file '%s' was not found" filename;
 104     SSet.empty
 105   end
 106   else begin
 107     Disk.cat filename
 108     |> Hh_json.json_of_string
 109     |> Hh_json.get_object_exn
 110     |> List.find_exn ~f:(fun (k, _) -> k = "classes")
 111     |> snd
 112     |> Hh_json.get_array_exn
 113     |> List.map ~f:Hh_json.get_string_exn
 114     |> SSet.of_list
 115   end
 116
 117 let dump_class_decls filename =
 118   let start_t = Unix.gettimeofday () in
 119   Hh_logger.log "Begin saving class declarations";
 120   try
 121     let hot_classes_filename = get_hot_classes_filename () in
 122     Hh_logger.log "Reading hot class names from %s" hot_classes_filename;
 123     let classes = get_hot_classes hot_classes_filename in
 124     Hh_logger.log "Exporting %d class declarations..." @@ SSet.cardinal classes;
 125     let decls = Decl_export.export_class_decls classes in
 126     Hh_logger.log "Marshalling class declarations...";
 127     dump_contents filename decls;
 128     ignore @@ Hh_logger.log_duration "Saved class declarations" start_t
 129   with exn ->
 130     let stack = Printexc.get_backtrace () in
 131     HackEventLogger.save_decls_failure exn stack;
 132     Hh_logger.exc exn ~stack ~prefix:"Failed to save class declarations: "
 133
 134 (* Dumps the file info and the errors, if any. *)
 135 let dump_saved_state
 136     ~(save_decls: bool)
 137     (output_filename: string)
 138     (naming_table: Naming_table.t)
 139     (errors: Errors.t) : unit =
 140   Hh_logger.log "Marshalling the naming table...";
 141   let (naming_table_saved: Naming_table.saved_state_info) =
 142     Naming_table.to_saved naming_table
 143   in
 144   dump_contents output_filename naming_table_saved;
 145
 146   if not (Sys.file_exists output_filename) then
 147     failwith (Printf.sprintf "Did not find file infos file '%s'" output_filename)
 148   else
 149     Hh_logger.log "Saved file infos to '%s'" output_filename;
 150
 151   (* Let's not write empty error files. *)
 152   if Errors.is_empty errors then () else begin
 153     let errors_in_phases =
 154       List.map
 155         ~f:(fun phase -> (phase, Errors.get_failed_files errors phase))
 156         [ Errors.Parsing; Errors.Decl; Errors.Naming; Errors.Typing ] in
 157     dump_contents (get_errors_filename output_filename) errors_in_phases
 158   end;
 159
 160   if save_decls then
 161     dump_class_decls (get_decls_filename output_filename)
 162
 163 let update_save_state
 164     ~(enable_naming_table_fallback: bool)
 165     ~(save_decls: bool)
 166     (env: ServerEnv.env)
 167     (output_filename: string)
 168     (replace_state_after_saving: bool) : ServerEnv.env * save_state_result =
 169   let t = Unix.gettimeofday () in
 170   let db_name = output_filename ^ ".sql" in
 171   if not (RealDisk.file_exists db_name) then
 172     failwith "Given existing save state SQL file missing";
 173   let naming_table = env.ServerEnv.naming_table in
 174   let errors = env.ServerEnv.errorl in
 175   dump_saved_state ~save_decls output_filename naming_table errors;
 176   let naming_table_rows_changed = if enable_naming_table_fallback then begin
 177     Hh_logger.log "Updating naming table in place...";
 178     Naming_table.save_incremental naming_table db_name;
 179     1 (* But it's a doozy! *)
 180   end else begin
 181     Hh_logger.log "skip writing file info to sqlite table";
 182     0
 183   end in
 184   let dep_table_edges_added = SharedMem.update_dep_table_sqlite
 185     db_name
 186     Build_id.build_revision
 187     replace_state_after_saving in
 188   ignore @@ Hh_logger.log_duration "Updating saved state took" t;
 189   let result = { naming_table_rows_changed; dep_table_edges_added } in
 190
 191   (* To support incremental generation we have to switch to a backed naming
 192    * table. *)
 193   if enable_naming_table_fallback && replace_state_after_saving
 194   then
 195     let naming_table = Naming_table.load_from_sqlite
 196       ~update_reverse_entries:false
 197       db_name
 198     in
 199     { env with ServerEnv.naming_table; }, result
 200   else env, result
 201
 202 (** Saves the saved state to the given path. Returns number of dependency
 203 * edges dumped into the database. *)
 204 let save_state
 205     ~(enable_naming_table_fallback: bool)
 206     ~(dep_table_as_blob: bool)
 207     ~(save_decls: bool)
 208     (env: ServerEnv.env)
 209     (output_filename: string)
 210     ~(replace_state_after_saving: bool): ServerEnv.env * save_state_result =
 211   let () = Sys_utils.mkdir_p (Filename.dirname output_filename) in
 212   let db_name = output_filename ^ ".sql" in
 213   let () = if Sys.file_exists output_filename then
 214              failwith (Printf.sprintf "Cowardly refusing to overwrite '%s'." output_filename)
 215            else () in
 216   let () = if Sys.file_exists db_name then
 217              failwith (Printf.sprintf "Cowardly refusing to overwrite '%s'." db_name)
 218            else () in
 219   match SharedMem.loaded_dep_table_filename () with
 220   | None ->
 221     let naming_table = env.ServerEnv.naming_table in
 222     let errors = env.ServerEnv.errorl in
 223     let t = Unix.gettimeofday () in
 224     dump_saved_state ~save_decls output_filename naming_table errors;
 225
 226     let naming_table_rows_changed =
 227       if enable_naming_table_fallback then
 228       begin
 229         Hh_logger.log "Saving file info (naming table) into a SQLite table.\n";
 230         Naming_table.save naming_table db_name
 231       end
 232       else 0
 233     in
 234
 235     let dep_table_saver =
 236       if dep_table_as_blob then
 237         SharedMem.save_dep_table_blob
 238       else
 239         SharedMem.save_dep_table_sqlite in
 240
 241     let dep_table_edges_added =
 242       dep_table_saver
 243         db_name
 244         Build_id.build_revision
 245         replace_state_after_saving in
 246     let _ : float = Hh_logger.log_duration "Saving saved state took" t in
 247     let result = { naming_table_rows_changed; dep_table_edges_added } in
 248     if replace_state_after_saving && enable_naming_table_fallback
 249     then begin
 250       let naming_table = Naming_table.load_from_sqlite ~update_reverse_entries:false db_name in
 251       { env with ServerEnv.naming_table; }, result
 252     end else env, result
 253   | Some old_table_filename ->
 254     (** If server is running from a loaded saved state, it's in-memory
 255      * tracked depdnencies are incomplete - most of the actual dependencies
 256      * are in the SQL table. We need to copy that file and update it with
 257      * the in-memory edges. *)
 258     let t = Unix.gettimeofday () in
 259     let content = RealDisk.cat old_table_filename in
 260     let () = RealDisk.mkdir_p (Filename.dirname output_filename) in
 261     let () = RealDisk.write_file ~file:db_name ~contents:content in
 262     let _ : float = Hh_logger.log_duration "Made disk copy of loaded saved state. Took" t in
 263     update_save_state
 264       ~enable_naming_table_fallback
 265       ~save_decls
 266       env
 267       output_filename
 268       replace_state_after_saving
 269
 270 let get_in_memory_dep_table_entry_count () : (int, string) result =
 271   Utils.try_with_stack (fun () ->
 272     SharedMem.get_in_memory_dep_table_entry_count ())
 273   |> Result.map_error ~f:(fun (exn, _stack) -> Exn.to_string exn)
 274
 275 (* If successful, returns the # of edges from the dependency table that were written. *)
 276 (* TODO: write some other stats, e.g., the number of names, the number of errors, etc. *)
 277 let go
 278     ~(enable_naming_table_fallback: bool)
 279     ~(dep_table_as_blob: bool)
 280     ~(save_decls: bool)
 281     (env: ServerEnv.env)
 282     (output_filename: string)
 283     ~(replace_state_after_saving: bool): ServerEnv.env * (save_state_result, string) result =
 284   Utils.try_with_stack
 285   begin
 286     fun () -> save_state
 287       ~enable_naming_table_fallback
 288       ~dep_table_as_blob
 289       ~save_decls
 290       env
 291       output_filename
 292       ~replace_state_after_saving
 293   end
 294   |> fun result -> match result with
 295     | Ok (env, result) -> env, Ok result
 296     | Error (exn, _stack) -> env, Error (Exn.to_string exn)