hphp/hack/src/server/serverLazyInit.ml

   1 (*
   2  * Copyright (c) 2018, 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 (* Lazy Initialization:
  11
  12    During Lazy initialization, hh_server tries to do as little work as possible.
  13    The init_from_saved_state behavior is this:
  14
  15      Load from saved state -> Parse dirty files -> Naming -> Dirty Typecheck
  16
  17    The full_init behavior is this: (similar to eager init, but with lazy decl)
  18
  19      Full Parsing -> Naming -> Full Typecheck (with lazy decl)
  20 *)
  21
  22 (* module Hack_bucket = Bucket *)
  23 open Hh_prelude
  24
  25 (* module Bucket = Hack_bucket *)
  26 open GlobalOptions
  27 open Result.Export
  28 open Reordered_argument_collections
  29 open SearchServiceRunner
  30 open ServerCheckUtils
  31 open ServerEnv
  32 open ServerInitCommon
  33 open ServerInitTypes
  34 open String_utils
  35 module SLC = ServerLocalConfig
  36
  37 type deptable =
  38   | SQLiteDeptable of string
  39   | CustomDeptable of string
  40
  41 let deptable_with_filename ~(is_64bit : bool) (fn : string) : deptable =
  42   if is_64bit then
  43     CustomDeptable fn
  44   else
  45     SQLiteDeptable fn
  46
  47 let lock_and_load_deptable
  48     (deptable : deptable) ~(ignore_hh_version : bool) ~(fail_if_missing : bool)
  49     : unit =
  50   match deptable with
  51   | SQLiteDeptable fn ->
  52     if String.length fn = 0 && not fail_if_missing then
  53       Hh_logger.log "The dependency file was not specified - ignoring"
  54     else begin
  55       (* The SQLite deptable must be loaded in the master process *)
  56
  57       (* Take a lock on the info file for the SQLite *)
  58       try
  59         LoadScriptUtils.lock_saved_state fn;
  60         let start_t = Unix.gettimeofday () in
  61         SharedMem.load_dep_table_sqlite fn ignore_hh_version;
  62         let (_t : float) =
  63           Hh_logger.log_duration "Did read the dependency file (sec)" start_t
  64         in
  65         HackEventLogger.load_deptable_end start_t
  66       with
  67       | (SharedMem.Sql_assertion_failure 11 | SharedMem.Sql_assertion_failure 14)
  68         as e ->
  69         (* SQL_corrupt *)
  70         let stack = Caml.Printexc.get_raw_backtrace () in
  71         LoadScriptUtils.delete_corrupted_saved_state fn;
  72         Caml.Printexc.raise_with_backtrace e stack
  73     end
  74   | CustomDeptable fn ->
  75     (* The new dependency graph is threaded through function calls
  76      * instead of stored in a global *)
  77     Hh_logger.log "Custom dependency graph will be loaded lazily from %s" fn
  78
  79 let merge_saved_state_futures
  80     (genv : genv)
  81     (ctx : Provider_context.t)
  82     (dependency_table_saved_state_future :
  83       (State_loader.native_load_result, State_loader.error) result Future.t)
  84     (naming_table_saved_state_future :
  85       ( Saved_state_loader.Naming_table_info.t Saved_state_loader.load_result
  86         option,
  87         string )
  88       result
  89       Future.t) : (loaded_info, load_state_error) result =
  90   let t = Unix.gettimeofday () in
  91
  92   let merge dependency_table_saved_state_result naming_table_saved_state_result
  93       =
  94     match dependency_table_saved_state_result with
  95     | Error error ->
  96       Hh_logger.log
  97         "Unhandled error from State_loader: %s"
  98         (Future.error_to_string error);
  99       let e = Exception.wrap_unraised (Future.error_to_exn error) in
 100       let exn = Exception.to_exn e in
 101       let stack = Utils.Callstack (Exception.get_backtrace_string e) in
 102       Error (Load_state_unhandled_exception { exn; stack })
 103     | Ok (Error error) -> Error (Load_state_loader_failure error)
 104     | Ok (Ok result) ->
 105       let ( downloaded_naming_table_path,
 106             naming_table_manifold_path,
 107             dirty_naming_files ) =
 108         match naming_table_saved_state_result with
 109         | Ok (Ok None) -> (None, None, [])
 110         | Ok
 111             (Ok
 112               (Some
 113                 {
 114                   Saved_state_loader.saved_state_info;
 115                   changed_files;
 116                   manifold_path;
 117                 })) ->
 118           let (_ : float) =
 119             Hh_logger.log_duration "Finished downloading naming table." t
 120           in
 121           let path =
 122             saved_state_info
 123               .Saved_state_loader.Naming_table_info.naming_table_path
 124           in
 125           (Some (Path.to_string path), Some manifold_path, changed_files)
 126         | Ok (Error err) ->
 127           Hh_logger.warn "Failed to download naming table saved state: %s" err;
 128           (None, None, [])
 129         | Error error ->
 130           Hh_logger.warn
 131             "Failed to download the naming table saved state: %s"
 132             (Future.error_to_string error);
 133           (None, None, [])
 134       in
 135       let ignore_hh_version =
 136         ServerArgs.ignore_hh_version genv.ServerEnv.options
 137       in
 138       let fail_if_missing = not genv.local_config.SLC.can_skip_deptable in
 139       let deptable =
 140         deptable_with_filename
 141           ~is_64bit:result.State_loader.deptable_is_64bit
 142           result.State_loader.deptable_fn
 143       in
 144       lock_and_load_deptable deptable ~ignore_hh_version ~fail_if_missing;
 145       let load_decls = genv.local_config.SLC.load_decls_from_saved_state in
 146       let shallow_decls = genv.local_config.SLC.shallow_class_decl in
 147       let naming_table_fallback_path =
 148         get_naming_table_fallback_path genv downloaded_naming_table_path
 149       in
 150       let (old_naming_table, old_errors) =
 151         SaveStateService.load_saved_state
 152           ctx
 153           ~naming_table_path:result.State_loader.naming_table_path
 154           ~naming_table_fallback_path
 155           ~load_decls
 156           ~shallow_decls
 157           ~hot_decls_paths:result.State_loader.hot_decls_paths
 158           ~errors_path:result.State_loader.errors_path
 159       in
 160       let t = Unix.time () in
 161       (match result.State_loader.dirty_files |> Future.get ~timeout:200 with
 162       | Error error -> Error (Load_state_dirty_files_failure error)
 163       | Ok
 164           {
 165             State_loader.master_changes = dirty_master_files;
 166             local_changes = dirty_local_files;
 167           } ->
 168         let () = HackEventLogger.state_loader_dirty_files t in
 169         let dirty_naming_files = Relative_path.Set.of_list dirty_naming_files in
 170         let dirty_master_files = Relative_path.Set.of_list dirty_master_files in
 171         let dirty_local_files = Relative_path.Set.of_list dirty_local_files in
 172         Ok
 173           {
 174             naming_table_fn = result.State_loader.naming_table_path;
 175             deptable_fn = result.State_loader.deptable_fn;
 176             deptable_is_64bit = result.State_loader.deptable_is_64bit;
 177             naming_table_fallback_fn = naming_table_fallback_path;
 178             corresponding_rev = result.State_loader.corresponding_rev;
 179             mergebase_rev = result.State_loader.mergebase_rev;
 180             mergebase = result.State_loader.mergebase;
 181             dirty_naming_files;
 182             dirty_master_files;
 183             dirty_local_files;
 184             old_naming_table;
 185             old_errors;
 186             state_distance = Some result.State_loader.state_distance;
 187             naming_table_manifold_path;
 188           })
 189   in
 190   let merge left right = Ok (merge left right) in
 191   let future =
 192     Future.merge
 193       dependency_table_saved_state_future
 194       naming_table_saved_state_future
 195       merge
 196   in
 197   (* We don't call Future.get on the merged future until it's ready because
 198       the implementation of Future.get blocks on the first future until it's
 199       ready, then moves on to the second future, but the second future, since
 200       it's composed of bound continuations, will not be making as much progress
 201       on its own in this case. *)
 202   let rec wait_until_ready future =
 203     if not (Future.is_ready future) then begin
 204       Sys_utils.sleep ~seconds:0.04;
 205       wait_until_ready future
 206     end else
 207       match Future.get future ~timeout:0 with
 208       | Ok result -> result
 209       | Error error -> failwith (Future.error_to_string error)
 210   in
 211   wait_until_ready future
 212
 213 let download_and_load_state_exn
 214     ~(target : ServerMonitorUtils.target_saved_state option)
 215     ~(genv : ServerEnv.genv)
 216     ~(ctx : Provider_context.t)
 217     ~(root : Path.t) : (loaded_info, load_state_error) result =
 218   let open ServerMonitorUtils in
 219   let saved_state_handle =
 220     match target with
 221     | None -> None
 222     | Some
 223         { saved_state_everstore_handle; target_global_rev; watchman_mergebase }
 224       ->
 225       Some
 226         {
 227           State_loader.saved_state_everstore_handle;
 228           saved_state_for_rev = Hg.Global_rev target_global_rev;
 229           watchman_mergebase;
 230         }
 231   in
 232   let ignore_hh_version = ServerArgs.ignore_hh_version genv.options in
 233   let ignore_hhconfig = ServerArgs.saved_state_ignore_hhconfig genv.options in
 234   let use_prechecked_files =
 235     ServerPrecheckedFiles.should_use genv.options genv.local_config
 236   in
 237   let naming_table_saved_state_future =
 238     if genv.local_config.ServerLocalConfig.enable_naming_table_fallback then begin
 239       Hh_logger.log "Starting naming table download.";
 240       let loader_future =
 241         State_loader_futures.load
 242           ~watchman_opts:
 243             Saved_state_loader.Watchman_options.{ root; sockname = None }
 244           ~ignore_hh_version
 245           ~saved_state_type:Saved_state_loader.Naming_table
 246         |> Future.with_timeout ~timeout:60
 247       in
 248       Future.continue_and_map_err loader_future @@ fun result ->
 249       match result with
 250       | Ok (Ok load_state) -> Ok (Some load_state)
 251       | Ok (Error e) -> Error (Saved_state_loader.long_user_message_of_error e)
 252       | Error e -> Error (Future.error_to_string e)
 253     end else
 254       Future.of_value (Ok None)
 255   in
 256   let dependency_table_saved_state_future :
 257       (State_loader.native_load_result, State_loader.error) result Future.t =
 258     State_loader.mk_state_future
 259       ~config:genv.local_config.SLC.state_loader_timeouts
 260       ~load_64bit:genv.local_config.SLC.load_state_natively_64bit
 261       ?saved_state_handle
 262       ~config_hash:(ServerConfig.config_hash genv.config)
 263       root
 264       ~ignore_hh_version
 265       ~ignore_hhconfig
 266       ~use_prechecked_files
 267   in
 268   merge_saved_state_futures
 269     genv
 270     ctx
 271     dependency_table_saved_state_future
 272     naming_table_saved_state_future
 273
 274 let use_precomputed_state_exn
 275     (genv : ServerEnv.genv)
 276     (ctx : Provider_context.t)
 277     (info : ServerArgs.saved_state_target_info)
 278     (profiling : CgroupProfiler.Profiling.t) : loaded_info =
 279   let {
 280     ServerArgs.naming_table_path;
 281     corresponding_base_revision;
 282     deptable_fn;
 283     deptable_is_64bit;
 284     changes;
 285     naming_changes;
 286     prechecked_changes;
 287   } =
 288     info
 289   in
 290   let ignore_hh_version = ServerArgs.ignore_hh_version genv.ServerEnv.options in
 291   let fail_if_missing = not genv.local_config.SLC.can_skip_deptable in
 292   let deptable =
 293     deptable_with_filename ~is_64bit:deptable_is_64bit deptable_fn
 294   in
 295   CgroupProfiler.collect_cgroup_stats ~profiling ~stage:"load deptable"
 296   @@ fun () ->
 297   lock_and_load_deptable deptable ~ignore_hh_version ~fail_if_missing;
 298   let changes = Relative_path.set_of_list changes in
 299   let naming_changes = Relative_path.set_of_list naming_changes in
 300   let prechecked_changes = Relative_path.set_of_list prechecked_changes in
 301   let load_decls = genv.local_config.SLC.load_decls_from_saved_state in
 302   let shallow_decls = genv.local_config.SLC.shallow_class_decl in
 303   let naming_table_fallback_path = get_naming_table_fallback_path genv None in
 304   let hot_decls_paths =
 305     State_loader.
 306       {
 307         legacy_hot_decls_path =
 308           ServerArgs.legacy_hot_decls_path_for_target_info info;
 309         shallow_hot_decls_path =
 310           ServerArgs.shallow_hot_decls_path_for_target_info info;
 311       }
 312   in
 313   let errors_path = ServerArgs.errors_path_for_target_info info in
 314   let (old_naming_table, old_errors) =
 315     CgroupProfiler.collect_cgroup_stats ~profiling ~stage:"load saved state"
 316     @@ fun () ->
 317     SaveStateService.load_saved_state
 318       ctx
 319       ~naming_table_path
 320       ~naming_table_fallback_path
 321       ~load_decls
 322       ~shallow_decls
 323       ~hot_decls_paths
 324       ~errors_path
 325   in
 326   {
 327     naming_table_fn = naming_table_path;
 328     deptable_fn;
 329     deptable_is_64bit;
 330     naming_table_fallback_fn = naming_table_fallback_path;
 331     corresponding_rev =
 332       Hg.Global_rev (int_of_string corresponding_base_revision);
 333     mergebase_rev = None;
 334     mergebase = Future.of_value None;
 335     dirty_naming_files = naming_changes;
 336     dirty_master_files = prechecked_changes;
 337     dirty_local_files = changes;
 338     old_naming_table;
 339     old_errors;
 340     state_distance = None;
 341     naming_table_manifold_path = None;
 342   }
 343
 344 (* Run naming from a fast generated from saved state.
 345  * No errors are generated because we assume the fast is directly from
 346  * a clean state.
 347  *)
 348 let naming_with_fast
 349     (ctx : Provider_context.t)
 350     (fast : FileInfo.names Relative_path.Map.t)
 351     (t : float) : float =
 352   Relative_path.Map.iter fast ~f:(fun k info ->
 353       let {
 354         FileInfo.n_classes = classes;
 355         n_record_defs = record_defs;
 356         n_types = typedefs;
 357         n_funs = funs;
 358         n_consts = consts;
 359       } =
 360         info
 361       in
 362       Naming_global.ndecl_file_fast
 363         ctx
 364         k
 365         ~funs
 366         ~classes
 367         ~record_defs
 368         ~typedefs
 369         ~consts);
 370   HackEventLogger.fast_naming_end t;
 371   hh_log_heap ();
 372   Hh_logger.log_duration "Naming fast" t
 373
 374 let naming_from_saved_state
 375     (ctx : Provider_context.t)
 376     (old_naming_table : Naming_table.t)
 377     (parsing_files : Relative_path.Set.t)
 378     (naming_table_fallback_fn : string option)
 379     (t : float)
 380     ~(profiling : CgroupProfiler.Profiling.t) : float =
 381   CgroupProfiler.collect_cgroup_stats
 382     ~profiling
 383     ~stage:"naming from saved state"
 384   @@ fun () ->
 385   (* If we're falling back to SQLite we don't need to explicitly do a naming
 386      pass, but if we're not then we do. *)
 387   match naming_table_fallback_fn with
 388   | Some _ ->
 389     (* Set the SQLite fallback path for the reverse naming table, then block out all entries in
 390       any dirty files to make sure we properly handle file deletes. *)
 391     Relative_path.Set.iter parsing_files (fun k ->
 392         match Naming_table.get_file_info old_naming_table k with
 393         | None ->
 394           (* If we can't find the file in [old_naming_table] we don't consider that an error, since
 395            * it could be a new file that was added. *)
 396           ()
 397         | Some v ->
 398           let backend = Provider_context.get_backend ctx in
 399           Naming_provider.remove_type_batch
 400             backend
 401             (v.FileInfo.classes |> List.map ~f:snd |> SSet.of_list);
 402           Naming_provider.remove_type_batch
 403             backend
 404             (v.FileInfo.typedefs |> List.map ~f:snd |> SSet.of_list);
 405           Naming_provider.remove_type_batch
 406             backend
 407             (v.FileInfo.record_defs |> List.map ~f:snd |> SSet.of_list);
 408           Naming_provider.remove_fun_batch
 409             backend
 410             (v.FileInfo.funs |> List.map ~f:snd |> SSet.of_list);
 411           Naming_provider.remove_const_batch
 412             backend
 413             (v.FileInfo.consts |> List.map ~f:snd |> SSet.of_list));
 414     Unix.gettimeofday ()
 415   | None ->
 416     (* Name all the files from the old fast (except the new ones we parsed) *)
 417     let old_hack_names =
 418       Naming_table.filter old_naming_table (fun k _v ->
 419           not (Relative_path.Set.mem parsing_files k))
 420     in
 421     naming_with_fast ctx (Naming_table.to_fast old_hack_names) t
 422
 423 (* Prechecked files are gated with a flag and not supported in AI/check/saving
 424  * of saved state modes. *)
 425 let use_prechecked_files (genv : ServerEnv.genv) : bool =
 426   ServerPrecheckedFiles.should_use genv.options genv.local_config
 427   && Option.is_none (ServerArgs.ai_mode genv.options)
 428   && (not (ServerArgs.check_mode genv.options))
 429   && Option.is_none (ServerArgs.save_filename genv.options)
 430   && Option.is_none (ServerArgs.save_with_spec genv.options)
 431
 432 let get_dirty_fast
 433     (old_naming_table : Naming_table.t)
 434     (fast : FileInfo.names Relative_path.Map.t)
 435     (dirty : Relative_path.Set.t) : FileInfo.names Relative_path.Map.t =
 436   Relative_path.Set.fold
 437     dirty
 438     ~f:
 439       begin
 440         fun fn acc ->
 441         let dirty_fast = Relative_path.Map.find_opt fast fn in
 442         let dirty_old_fast =
 443           Naming_table.get_file_info old_naming_table fn
 444           |> Option.map ~f:FileInfo.simplify
 445         in
 446         let fast =
 447           Option.merge dirty_old_fast dirty_fast FileInfo.merge_names
 448         in
 449         match fast with
 450         | Some fast -> Relative_path.Map.add acc ~key:fn ~data:fast
 451         | None -> acc
 452       end
 453     ~init:Relative_path.Map.empty
 454
 455 let names_to_deps (deps_mode : Typing_deps_mode.t) (names : FileInfo.names) :
 456     Typing_deps.DepSet.t =
 457   let open Typing_deps in
 458   let { FileInfo.n_funs; n_classes; n_record_defs; n_types; n_consts } =
 459     names
 460   in
 461   let add_deps_of_sset dep_ctor sset depset =
 462     SSet.fold sset ~init:depset ~f:(fun n acc ->
 463         DepSet.add acc (Dep.make (hash_mode deps_mode) (dep_ctor n)))
 464   in
 465   let deps =
 466     add_deps_of_sset (fun n -> Dep.Fun n) n_funs (DepSet.make deps_mode)
 467   in
 468   let deps = add_deps_of_sset (fun n -> Dep.FunName n) n_funs deps in
 469   let deps = add_deps_of_sset (fun n -> Dep.Class n) n_classes deps in
 470   let deps = add_deps_of_sset (fun n -> Dep.RecordDef n) n_record_defs deps in
 471   let deps = add_deps_of_sset (fun n -> Dep.Class n) n_types deps in
 472   let deps = add_deps_of_sset (fun n -> Dep.GConst n) n_consts deps in
 473   let deps = add_deps_of_sset (fun n -> Dep.GConstName n) n_consts deps in
 474   deps
 475
 476 (** Compare declarations loaded from the saved state to declarations based on
 477     the current versions of dirty files. This lets us check a smaller set of
 478     files than the set we'd check if old declarations were not available.
 479     To be used only when load_decls_from_saved_state is enabled. *)
 480 let get_files_to_undecl_and_recheck
 481     (genv : ServerEnv.genv)
 482     (env : ServerEnv.env)
 483     (old_naming_table : Naming_table.t)
 484     (new_fast : FileInfo.names Relative_path.Map.t)
 485     (dirty_fast : FileInfo.names Relative_path.Map.t)
 486     (files_to_redeclare : Relative_path.Set.t) :
 487     Relative_path.Set.t * Relative_path.Set.t =
 488   let bucket_size = genv.local_config.SLC.type_decl_bucket_size in
 489   let fast =
 490     Relative_path.Set.fold
 491       files_to_redeclare
 492       ~init:Relative_path.Map.empty
 493       ~f:(fun path acc ->
 494         match Relative_path.Map.find_opt dirty_fast path with
 495         | Some info -> Relative_path.Map.add acc path info
 496         | None -> acc)
 497   in
 498   let get_classes path =
 499     let old_names =
 500       Naming_table.get_file_info old_naming_table path
 501       |> Option.map ~f:FileInfo.simplify
 502     in
 503     let new_names = Relative_path.Map.find_opt new_fast path in
 504     let classes_from_names x = x.FileInfo.n_classes in
 505     let old_classes = Option.map old_names classes_from_names in
 506     let new_classes = Option.map new_names classes_from_names in
 507     Option.merge old_classes new_classes SSet.union
 508     |> Option.value ~default:SSet.empty
 509   in
 510   let dirty_names =
 511     Relative_path.Map.fold dirty_fast ~init:FileInfo.empty_names ~f:(fun _ ->
 512         FileInfo.merge_names)
 513   in
 514   let ctx = Provider_utils.ctx_from_server_env env in
 515   Decl_redecl_service.oldify_type_decl
 516     ctx
 517     ~bucket_size
 518     genv.workers
 519     get_classes
 520     ~previously_oldified_defs:FileInfo.empty_names
 521     ~defs:dirty_names;
 522   let { Decl_redecl_service.to_redecl; to_recheck; _ } =
 523     Decl_redecl_service.redo_type_decl
 524       ~conservative_redecl:false
 525       ~bucket_size
 526       ctx
 527       genv.workers
 528       get_classes
 529       ~previously_oldified_defs:dirty_names
 530       ~defs:fast
 531   in
 532   Decl_redecl_service.remove_old_defs ctx ~bucket_size genv.workers dirty_names;
 533   let deps = Typing_deps.add_all_deps env.deps_mode to_redecl in
 534   let deps = Typing_deps.DepSet.union deps to_recheck in
 535   let files_to_undecl = Typing_deps.Files.get_files to_redecl in
 536   let files_to_recheck = Typing_deps.Files.get_files deps in
 537   (files_to_undecl, files_to_recheck)
 538
 539 (* We start off with a list of files that have changed since the state was
 540  * saved (dirty_files), and two maps of the class / function declarations
 541  * -- one made when the state was saved (old_fast) and one made for the
 542  * current files in the repository (new_fast). We grab the declarations from
 543  * both, to account for both the declaratons that were deleted and those that
 544  * are newly created. Then we use the deptable to figure out the files that
 545  * referred to them. Finally we recheck the lot.
 546  *
 547  * Args:
 548  *
 549  * genv, env : environments
 550  * old_fast: old file-ast from saved state
 551  * new_fast: newly parsed file ast
 552  * dirty_master_files and dirty_local_files: we need to typecheck these and,
 553  *    since their decl have changed, also all of their dependencies
 554  * similar_files: we only need to typecheck these,
 555  *    not their dependencies since their decl are unchanged
 556  * *)
 557 let type_check_dirty
 558     (genv : ServerEnv.genv)
 559     (env : ServerEnv.env)
 560     (old_naming_table : Naming_table.t)
 561     (new_fast : FileInfo.names Relative_path.Map.t)
 562     ~(dirty_master_files_unchanged_hash : Relative_path.Set.t)
 563     ~(dirty_master_files_changed_hash : Relative_path.Set.t)
 564     ~(dirty_local_files_unchanged_hash : Relative_path.Set.t)
 565     ~(dirty_local_files_changed_hash : Relative_path.Set.t)
 566     (t : float)
 567     (profiling : CgroupProfiler.Profiling.t) : ServerEnv.env * float =
 568   let start_t = Unix.gettimeofday () in
 569   let telemetry =
 570     Telemetry.create ()
 571     |> Telemetry.float_ ~key:"start_time" ~value:start_t
 572     |> Telemetry.string_ ~key:"reason" ~value:"lazy_dirty_init"
 573   in
 574   let dirty_files_unchanged_hash =
 575     Relative_path.Set.union
 576       dirty_master_files_unchanged_hash
 577       dirty_local_files_unchanged_hash
 578   in
 579   let dirty_files_changed_hash =
 580     Relative_path.Set.union
 581       dirty_master_files_changed_hash
 582       dirty_local_files_changed_hash
 583   in
 584   let dirty_changed_fast =
 585     get_dirty_fast old_naming_table new_fast dirty_files_changed_hash
 586   in
 587   let names s =
 588     Relative_path.Map.fold
 589       dirty_changed_fast
 590       ~f:
 591         begin
 592           fun k v acc ->
 593           if Relative_path.Set.mem s k then
 594             FileInfo.merge_names v acc
 595           else
 596             acc
 597         end
 598       ~init:FileInfo.empty_names
 599   in
 600   let ctx = Provider_utils.ctx_from_server_env env in
 601   let deps_mode = Provider_context.get_deps_mode ctx in
 602   let master_deps =
 603     names dirty_master_files_changed_hash |> names_to_deps deps_mode
 604   in
 605   let local_deps =
 606     names dirty_local_files_changed_hash |> names_to_deps deps_mode
 607   in
 608   (* Include similar_files in the dirty_fast used to determine which loaded
 609      declarations to oldify. This is necessary because the positions of
 610      declarations may have changed, which affects error messages and FIXMEs. *)
 611   let get_files_to_undecl_and_recheck =
 612     get_files_to_undecl_and_recheck genv env old_naming_table new_fast
 613     @@ extend_fast
 614          genv
 615          dirty_changed_fast
 616          env.naming_table
 617          dirty_files_unchanged_hash
 618   in
 619   let (env, to_undecl, to_recheck) =
 620     if use_prechecked_files genv then
 621       (* Start with dirty files and fan-out of local changes only *)
 622       let (to_undecl, to_recheck) =
 623         if genv.local_config.SLC.load_decls_from_saved_state then
 624           get_files_to_undecl_and_recheck dirty_local_files_changed_hash
 625         else
 626           let deps = Typing_deps.add_all_deps env.deps_mode local_deps in
 627           (Relative_path.Set.empty, Typing_deps.Files.get_files deps)
 628       in
 629       ( ServerPrecheckedFiles.set
 630           env
 631           (Initial_typechecking
 632              {
 633                rechecked_files = Relative_path.Set.empty;
 634                dirty_local_deps = local_deps;
 635                dirty_master_deps = master_deps;
 636                clean_local_deps = Typing_deps.(DepSet.make deps_mode);
 637              }),
 638         to_undecl,
 639         to_recheck )
 640     else
 641       (* Start with full fan-out immediately *)
 642       let (to_undecl, to_recheck) =
 643         if genv.local_config.SLC.load_decls_from_saved_state then
 644           get_files_to_undecl_and_recheck dirty_files_changed_hash
 645         else
 646           let deps = Typing_deps.DepSet.union master_deps local_deps in
 647           let deps = Typing_deps.add_all_deps env.deps_mode deps in
 648           (Relative_path.Set.empty, Typing_deps.Files.get_files deps)
 649       in
 650       (env, to_undecl, to_recheck)
 651   in
 652   (* We still need to typecheck files whose declarations did not change *)
 653   let to_recheck =
 654     Relative_path.Set.union to_recheck dirty_files_unchanged_hash
 655   in
 656   let fast = extend_fast genv dirty_changed_fast env.naming_table to_recheck in
 657   let files_to_check = Relative_path.Map.keys fast in
 658
 659   (* HACK: dump the fanout that we calculated and exit. This is for
 660   `hh_fanout`'s regression testing vs. `hh_server`. This can be deleted once
 661   we no longer worry about `hh_fanout` regressing vs. `hh_server`. Deletion
 662   is tracked at T65464119. *)
 663   if ServerArgs.dump_fanout genv.options then (
 664     Hh_json.json_to_multiline_output
 665       stdout
 666       (Hh_json.JSON_Object
 667          [
 668            ( "recheck_files",
 669              Hh_json.JSON_Array
 670                ( files_to_check
 671                |> List.map ~f:Relative_path.to_absolute
 672                |> List.map ~f:Hh_json.string_ ) );
 673          ]);
 674     exit 0
 675   ) else
 676     (* In case we saw that any hot decls had become invalid, we have to remove them.
 677   Note: we don't need to do a full "redecl" of them since their fanout has
 678   already been encompassed by to_recheck. *)
 679     let names_to_undecl =
 680       Relative_path.Set.fold
 681         to_undecl
 682         ~init:FileInfo.empty_names
 683         ~f:(fun file acc ->
 684           match Naming_table.get_file_info old_naming_table file with
 685           | None -> acc
 686           | Some info ->
 687             let names = FileInfo.simplify info in
 688             FileInfo.merge_names acc names)
 689     in
 690     let ctx = Provider_utils.ctx_from_server_env env in
 691     Decl_redecl_service.remove_defs
 692       ctx
 693       names_to_undecl
 694       SMap.empty
 695       ~collect_garbage:false;
 696
 697     let env = { env with changed_files = dirty_files_changed_hash } in
 698     let init_telemetry =
 699       telemetry
 700       |> Telemetry.int_
 701            ~key:"dirty_master_files_unchanged_hash"
 702            ~value:(Relative_path.Set.cardinal dirty_master_files_unchanged_hash)
 703       |> Telemetry.int_
 704            ~key:"dirty_master_files_changed_hash"
 705            ~value:(Relative_path.Set.cardinal dirty_master_files_changed_hash)
 706       |> Telemetry.int_
 707            ~key:"dirty_local_files_unchanged_hash"
 708            ~value:(Relative_path.Set.cardinal dirty_local_files_unchanged_hash)
 709       |> Telemetry.int_
 710            ~key:"dirty_local_files_changed_hash"
 711            ~value:(Relative_path.Set.cardinal dirty_local_files_changed_hash)
 712       |> Telemetry.int_
 713            ~key:"dirty_files_unchanged_hash"
 714            ~value:(Relative_path.Set.cardinal dirty_files_unchanged_hash)
 715       |> Telemetry.int_
 716            ~key:"dirty_files_changed_hash"
 717            ~value:(Relative_path.Set.cardinal dirty_files_changed_hash)
 718       |> Telemetry.int_
 719            ~key:"to_recheck"
 720            ~value:(Relative_path.Set.cardinal to_recheck)
 721     in
 722     let result =
 723       type_check
 724         genv
 725         env
 726         files_to_check
 727         init_telemetry
 728         t
 729         ~profile_label:"type check dirty files"
 730         ~profiling
 731     in
 732     HackEventLogger.type_check_dirty
 733       ~start_t
 734       ~dirty_count:(Relative_path.Set.cardinal dirty_files_changed_hash)
 735       ~recheck_count:(Relative_path.Set.cardinal to_recheck);
 736     Hh_logger.log
 737       "ServerInit type_check_dirty count: %d. recheck count: %d"
 738       (Relative_path.Set.cardinal dirty_files_changed_hash)
 739       (Relative_path.Set.cardinal to_recheck);
 740     result
 741
 742 let get_updates_exn ~(genv : ServerEnv.genv) ~(root : Path.t) :
 743     Relative_path.Set.t =
 744   let start_t = Unix.gettimeofday () in
 745   Hh_logger.log "Getting files changed while parsing...";
 746   let files_changed_while_parsing =
 747     ServerNotifierTypes.(
 748       genv.wait_until_ready ();
 749       match genv.notifier_async () with
 750       | Notifier_state_enter _
 751       | Notifier_state_leave _
 752       | Notifier_unavailable ->
 753         Relative_path.Set.empty
 754       | Notifier_synchronous_changes updates
 755       | Notifier_async_changes updates ->
 756         let root = Path.to_string root in
 757         let filter p = string_starts_with p root && FindUtils.file_filter p in
 758         SSet.filter updates ~f:filter
 759         |> Relative_path.relativize_set Relative_path.Root)
 760   in
 761   ignore
 762     ( Hh_logger.log_duration
 763         "Finished getting files changed while parsing"
 764         start_t
 765       : float );
 766   HackEventLogger.changed_while_parsing_end start_t;
 767   files_changed_while_parsing
 768
 769 let initialize_naming_table
 770     (progress_message : string)
 771     ?(fnl : Relative_path.t list option = None)
 772     ?(do_naming : bool = false)
 773     (genv : ServerEnv.genv)
 774     (env : ServerEnv.env)
 775     (profiling : CgroupProfiler.Profiling.t) : ServerEnv.env * float =
 776   SharedMem.cleanup_sqlite ();
 777   ServerProgress.send_progress_to_monitor "%s" progress_message;
 778   let (get_next, count, t) =
 779     match fnl with
 780     | Some fnl ->
 781       ( MultiWorker.next genv.workers fnl,
 782         Some (List.length fnl),
 783         Unix.gettimeofday () )
 784     | None ->
 785       let (get_next, t) = indexing genv in
 786       (get_next, None, t)
 787   in
 788   (* The full_fidelity_parser currently works better in both memory and time
 789      with a full parse rather than parsing decl asts and then parsing full ones *)
 790   let lazy_parse = not genv.local_config.SLC.use_full_fidelity_parser in
 791   (* full init - too many files to trace all of them *)
 792   let trace = false in
 793   let (env, t) =
 794     parsing
 795       ~lazy_parse
 796       genv
 797       env
 798       ~get_next
 799       ?count
 800       t
 801       ~trace
 802       ~profile_label:"parsing"
 803       ~profiling
 804   in
 805   if not do_naming then
 806     (env, t)
 807   else
 808     let ctx = Provider_utils.ctx_from_server_env env in
 809     let t =
 810       update_files
 811         genv
 812         env.naming_table
 813         ctx
 814         t
 815         ~profile_label:"update file deps"
 816         ~profiling
 817     in
 818     naming env t ~profile_label:"naming" ~profiling
 819
 820 let write_symbol_info_init
 821     (genv : ServerEnv.genv)
 822     (env : ServerEnv.env)
 823     (profiling : CgroupProfiler.Profiling.t) : ServerEnv.env * float =
 824   let out_dir =
 825     match ServerArgs.write_symbol_info genv.options with
 826     | None -> failwith "No write directory specified for --write-symbol-info"
 827     | Some s -> s
 828   in
 829   let (env, t) =
 830     initialize_naming_table
 831       "write symbol info initialization"
 832       genv
 833       env
 834       profiling
 835   in
 836   let ctx = Provider_utils.ctx_from_server_env env in
 837   let t =
 838     update_files
 839       genv
 840       env.naming_table
 841       ctx
 842       t
 843       ~profile_label:"update file deps"
 844       ~profiling
 845   in
 846   let (env, t) = naming env t ~profile_label:"naming" ~profiling in
 847   let index_paths = env.swriteopt.symbol_write_index_paths in
 848   let files =
 849     if List.length index_paths > 0 then
 850       List.fold index_paths ~init:[] ~f:(fun acc path ->
 851           if Sys.file_exists path then
 852             Relative_path.from_root ~suffix:path :: acc
 853           else
 854             acc)
 855     else
 856       let fast = Naming_table.to_fast env.naming_table in
 857       let failed_parsing = Errors.get_failed_files env.errorl Errors.Parsing in
 858       let fast =
 859         Relative_path.Set.fold
 860           failed_parsing
 861           ~f:(fun x m -> Relative_path.Map.remove m x)
 862           ~init:fast
 863       in
 864       let exclude_hhi = not env.swriteopt.symbol_write_include_hhi in
 865       let ignore_paths = env.swriteopt.symbol_write_ignore_paths in
 866       Relative_path.Map.fold fast ~init:[] ~f:(fun path _ acc ->
 867           match Naming_table.get_file_info env.naming_table path with
 868           | None -> acc
 869           | Some _ ->
 870             if
 871               (exclude_hhi && Relative_path.is_hhi (Relative_path.prefix path))
 872               || List.exists ignore_paths (fun ignore ->
 873                      String.equal (Relative_path.S.to_string path) ignore)
 874             then
 875               acc
 876             else
 877               path :: acc)
 878   in
 879   (* Ensure we are writing to fresh files *)
 880   let is_invalid =
 881     try
 882       if not (Sys.is_directory out_dir) then
 883         true
 884       else
 885         Array.length (Sys.readdir out_dir) > 0
 886     with _ ->
 887       Sys_utils.mkdir_p out_dir;
 888       false
 889   in
 890   if is_invalid then failwith "JSON write directory is invalid or non-empty";
 891
 892   Hh_logger.log "Writing JSON to: %s" out_dir;
 893
 894   let ctx = Provider_utils.ctx_from_server_env env in
 895   let root_path = env.swriteopt.symbol_write_root_path in
 896   let hhi_path = env.swriteopt.symbol_write_hhi_path in
 897   (* TODO(milliechen): log memory for this step *)
 898   Symbol_info_writer.go genv.workers ctx out_dir root_path hhi_path files;
 899
 900   (env, t)
 901
 902 (* If we fail to load a saved state, fall back to typechecking everything *)
 903 let full_init
 904     (genv : ServerEnv.genv)
 905     (env : ServerEnv.env)
 906     (profiling : CgroupProfiler.Profiling.t) : ServerEnv.env * float =
 907   let init_telemetry =
 908     Telemetry.create ()
 909     |> Telemetry.float_ ~key:"start_time" ~value:(Unix.gettimeofday ())
 910     |> Telemetry.string_ ~key:"reason" ~value:"lazy_full_init"
 911   in
 912   let is_check_mode = ServerArgs.check_mode genv.options in
 913   let run () =
 914     let (env, t) =
 915       initialize_naming_table
 916         ~do_naming:true
 917         "full initialization"
 918         genv
 919         env
 920         profiling
 921     in
 922     if not is_check_mode then
 923       SearchServiceRunner.update_fileinfo_map env.naming_table SearchUtils.Init;
 924     let fast = Naming_table.to_fast env.naming_table in
 925     let failed_parsing = Errors.get_failed_files env.errorl Errors.Parsing in
 926     let fast =
 927       Relative_path.Set.fold
 928         failed_parsing
 929         ~f:(fun x m -> Relative_path.Map.remove m x)
 930         ~init:fast
 931     in
 932     let fnl = Relative_path.Map.keys fast in
 933     let env =
 934       if is_check_mode then
 935         start_delegate_if_needed env genv (List.length fnl) env.errorl
 936       else
 937         env
 938     in
 939     type_check
 940       genv
 941       env
 942       fnl
 943       init_telemetry
 944       t
 945       ~profile_label:"type check"
 946       ~profiling
 947   in
 948   let run_experiment () =
 949     let ctx = Provider_utils.ctx_from_server_env env in
 950     let t_full_init = Unix.gettimeofday () in
 951     let fast = Direct_decl_service.go ctx genv.workers (fst (indexing genv)) in
 952     let t = Hh_logger.log_duration "parsing decl" t_full_init in
 953     let naming_table = Naming_table.update_many env.naming_table fast in
 954     let t = Hh_logger.log_duration "updating naming table" t in
 955     let env = { env with naming_table } in
 956     let t =
 957       update_files
 958         genv
 959         env.naming_table
 960         ctx
 961         t
 962         ~profile_label:"update files"
 963         ~profiling
 964     in
 965     let (env, t) = naming env t ~profile_label:"naming" ~profiling in
 966     let fnl = Relative_path.Map.keys fast in
 967     if not is_check_mode then
 968       SearchServiceRunner.update_fileinfo_map env.naming_table SearchUtils.Init;
 969     let type_check_result =
 970       type_check
 971         genv
 972         env
 973         fnl
 974         init_telemetry
 975         t
 976         ~profile_label:"type check"
 977         ~profiling
 978     in
 979     Hh_logger.log_duration "full init" t_full_init |> ignore;
 980     type_check_result
 981   in
 982   if
 983     GlobalOptions.tco_use_direct_decl_parser
 984       (ServerConfig.parser_options genv.config)
 985   then (
 986     Hh_logger.log "full init experiment";
 987     run_experiment ()
 988   ) else (
 989     Hh_logger.log "full init";
 990     run ()
 991   )
 992
 993 let parse_only_init
 994     (genv : ServerEnv.genv)
 995     (env : ServerEnv.env)
 996     (profiling : CgroupProfiler.Profiling.t) : ServerEnv.env * float =
 997   initialize_naming_table "parse-only initialization" genv env profiling
 998
 999 let get_mergebase (mergebase_future : Hg.hg_rev option Future.t) :
1000     Hg.hg_rev option =
1001   match Future.get mergebase_future with
1002   | Ok mergebase ->
1003     let () =
1004       match mergebase with
1005       | Some mergebase -> Hh_logger.log "Got mergebase hash: %s" mergebase
1006       | None -> Hh_logger.log "No mergebase hash"
1007     in
1008     mergebase
1009   | Error error ->
1010     Hh_logger.log
1011       "Getting mergebase hash failed: %s"
1012       (Future.error_to_string error);
1013     None
1014
1015 let post_saved_state_initialization
1016     ~(genv : ServerEnv.genv)
1017     ~(env : ServerEnv.env)
1018     ~(state_result : loaded_info * Relative_path.Set.t)
1019     (profiling : CgroupProfiler.Profiling.t) : ServerEnv.env * float =
1020   let ((loaded_info : ServerInitTypes.loaded_info), changed_while_parsing) =
1021     state_result
1022   in
1023   let trace = genv.local_config.SLC.trace_parsing in
1024   let hg_aware = genv.local_config.SLC.hg_aware in
1025   let {
1026     naming_table_fallback_fn;
1027     dirty_naming_files;
1028     dirty_local_files;
1029     dirty_master_files;
1030     old_naming_table;
1031     mergebase_rev;
1032     mergebase;
1033     old_errors;
1034     deptable_fn;
1035     deptable_is_64bit;
1036     naming_table_fn = _;
1037     corresponding_rev = _;
1038     state_distance = _;
1039     naming_table_manifold_path;
1040   } =
1041     loaded_info
1042   in
1043   if hg_aware then Option.iter mergebase_rev ~f:ServerRevisionTracker.initialize;
1044   let env =
1045     {
1046       env with
1047       init_env =
1048         {
1049           env.init_env with
1050           mergebase = get_mergebase mergebase;
1051           naming_table_manifold_path;
1052         };
1053       deps_mode =
1054         ( if deptable_is_64bit then
1055           match ServerArgs.save_64bit genv.options with
1056           | Some new_edges_dir ->
1057             Typing_deps_mode.SaveCustomMode
1058               { graph = Some deptable_fn; new_edges_dir }
1059           | None -> Typing_deps_mode.CustomMode (Some deptable_fn)
1060         else
1061           Typing_deps_mode.SQLiteMode );
1062     }
1063   in
1064
1065   let (decl_and_typing_error_files, naming_and_parsing_error_files) =
1066     SaveStateService.partition_error_files_tf
1067       old_errors
1068       [Errors.Decl; Errors.Typing]
1069   in
1070   let (_old_parsing_phase, old_parsing_error_files) =
1071     match
1072       List.find old_errors ~f:(fun (phase, _files) ->
1073           match phase with
1074           | Errors.Parsing -> true
1075           | _ -> false)
1076     with
1077     | Some (a, b) -> (a, b)
1078     | None -> (Errors.Parsing, Relative_path.Set.empty)
1079   in
1080   Hh_logger.log
1081     "Number of files with Decl and Typing errors: %d"
1082     (Relative_path.Set.cardinal decl_and_typing_error_files);
1083
1084   Hh_logger.log
1085     "Number of files with Naming and Parsing errors: %d"
1086     (Relative_path.Set.cardinal naming_and_parsing_error_files);
1087
1088   let (decl_and_typing_error_files, naming_and_parsing_error_files) =
1089     SaveStateService.partition_error_files_tf
1090       old_errors
1091       [Errors.Decl; Errors.Typing]
1092   in
1093   (* Parse and name all dirty files uniformly *)
1094   let dirty_files =
1095     List.fold
1096       ~init:Relative_path.Set.empty
1097       ~f:Relative_path.Set.union
1098       [
1099         naming_and_parsing_error_files;
1100         dirty_naming_files;
1101         dirty_master_files;
1102         dirty_local_files;
1103       ]
1104   in
1105   let t = Unix.gettimeofday () in
1106   let dirty_files = Relative_path.Set.union dirty_files changed_while_parsing in
1107   let parsing_files =
1108     Relative_path.Set.filter dirty_files ~f:FindUtils.path_filter
1109   in
1110   ( CgroupProfiler.collect_cgroup_stats ~stage:"remove fixmes" ~profiling
1111   @@ fun () -> Fixme_provider.remove_batch parsing_files );
1112   let parsing_files_list = Relative_path.Set.elements parsing_files in
1113   (* Parse dirty files only *)
1114   let next = MultiWorker.next genv.workers parsing_files_list in
1115   let (env, t) =
1116     parsing
1117       genv
1118       env
1119       ~lazy_parse:true
1120       ~get_next:next
1121       ~count:(List.length parsing_files_list)
1122       t
1123       ~trace
1124       ~profile_label:"parse dirty files"
1125       ~profiling
1126   in
1127   SearchServiceRunner.update_fileinfo_map
1128     env.naming_table
1129     SearchUtils.TypeChecker;
1130   let ctx = Provider_utils.ctx_from_server_env env in
1131   let t =
1132     update_files
1133       genv
1134       env.naming_table
1135       ctx
1136       t
1137       ~profile_label:"update file deps"
1138       ~profiling
1139   in
1140   let t =
1141     naming_from_saved_state
1142       ctx
1143       old_naming_table
1144       parsing_files
1145       naming_table_fallback_fn
1146       t
1147       ~profiling
1148   in
1149   (* Do global naming on all dirty files *)
1150   let (env, t) = naming env t ~profile_label:"naming dirty files" ~profiling in
1151
1152   (* Add all files from fast to the files_info object *)
1153   let fast = Naming_table.to_fast env.naming_table in
1154   let failed_parsing = Errors.get_failed_files env.errorl Errors.Parsing in
1155   let fast =
1156     Relative_path.Set.fold
1157       failed_parsing
1158       ~f:(fun x m -> Relative_path.Map.remove m x)
1159       ~init:fast
1160   in
1161   let env =
1162     {
1163       env with
1164       disk_needs_parsing =
1165         Relative_path.Set.union env.disk_needs_parsing changed_while_parsing;
1166     }
1167   in
1168   (* Separate the dirty files from the files whose decl only changed *)
1169   (* Here, for each dirty file, we compare its hash to the one saved
1170      in the saved state. If the hashes are the same, then the declarations
1171      on the file have not changed and we only need to retypecheck that file,
1172      not all of its dependencies.
1173      We call these files "similar" to their previous versions. *)
1174   let partition_similar dirty_files =
1175     Relative_path.Set.partition
1176       (fun f ->
1177         let info1 = Naming_table.get_file_info old_naming_table f in
1178         let info2 = Naming_table.get_file_info env.naming_table f in
1179         match (info1, info2) with
1180         | (Some x, Some y) ->
1181           (match (x.FileInfo.hash, y.FileInfo.hash) with
1182           | (Some x, Some y) -> Int64.equal x y
1183           | _ -> false)
1184         | _ -> false)
1185       dirty_files
1186   in
1187   let (dirty_master_files_unchanged_hash, dirty_master_files_changed_hash) =
1188     partition_similar dirty_master_files
1189   in
1190   let (dirty_local_files_unchanged_hash, dirty_local_files_changed_hash) =
1191     partition_similar dirty_local_files
1192   in
1193   let env =
1194     {
1195       env with
1196       naming_table = Naming_table.combine old_naming_table env.naming_table;
1197       (* The only reason old_parsing_error_files are added to disk_needs_parsing
1198                  here is because of an issue that seems to be already tracked in T30786759 *)
1199       disk_needs_parsing = old_parsing_error_files;
1200       needs_recheck =
1201         Relative_path.Set.union env.needs_recheck decl_and_typing_error_files;
1202     }
1203   in
1204   (* Update the fileinfo object's dependencies now that we have full fast *)
1205   let t =
1206     update_files
1207       genv
1208       env.naming_table
1209       ctx
1210       t
1211       ~profile_label:"update files again"
1212       ~profiling
1213   in
1214   type_check_dirty
1215     genv
1216     env
1217     old_naming_table
1218     fast
1219     ~dirty_master_files_unchanged_hash
1220     ~dirty_master_files_changed_hash
1221     ~dirty_local_files_unchanged_hash
1222     ~dirty_local_files_changed_hash
1223     t
1224     profiling
1225
1226 let saved_state_init
1227     ~(load_state_approach : load_state_approach)
1228     (genv : ServerEnv.genv)
1229     (env : ServerEnv.env)
1230     (root : Path.t)
1231     (profiling : CgroupProfiler.Profiling.t) :
1232     ( (ServerEnv.env * float) * (loaded_info * Relative_path.Set.t),
1233       load_state_error )
1234     result =
1235   let t = Unix.gettimeofday () in
1236   let attempt_fix = genv.local_config.SLC.attempt_fix_credentials in
1237   let () =
1238     match Security.check_credentials ~attempt_fix with
1239     | Ok success ->
1240       HackEventLogger.credentials_check_end
1241         (Printf.sprintf "saved_state_init: %s" (Security.show_success success))
1242         t
1243     | Error error ->
1244       let kind = Security.to_error_kind_string error in
1245       let message = Security.to_error_message_string error in
1246       Hh_logger.log "Error kind: %s\nError message: %s" kind message;
1247       HackEventLogger.credentials_check_failure
1248         (Printf.sprintf "saved_state_init: [%s]" kind)
1249         t
1250   in
1251
1252   ServerProgress.send_progress_to_monitor "loading saved state";
1253
1254   let ctx = Provider_utils.ctx_from_server_env env in
1255   (* A historical quirk: we allowed the timeout once while downloading+loading *)
1256   (* saved-state, and then once again while waiting to get dirty files from hg *)
1257   let timeout = 2 * genv.local_config.SLC.load_state_script_timeout in
1258   (* following function will be run under the timeout *)
1259   let do_ (_id : Timeout.t) : (loaded_info, load_state_error) result =
1260     let state_result =
1261       CgroupProfiler.collect_cgroup_stats ~profiling ~stage:"load saved state"
1262       @@ fun () ->
1263       match load_state_approach with
1264       | Precomputed info ->
1265         Ok (use_precomputed_state_exn genv ctx info profiling)
1266       | Load_state_natively ->
1267         download_and_load_state_exn ~target:None ~genv ~ctx ~root
1268       | Load_state_natively_with_target target ->
1269         download_and_load_state_exn ~target:(Some target) ~genv ~ctx ~root
1270     in
1271     state_result
1272   in
1273   let state_result =
1274     try
1275       match
1276         Timeout.with_timeout
1277           ~timeout
1278           ~do_
1279           ~on_timeout:(fun (_ : Timeout.timings) -> Error Load_state_timeout)
1280       with
1281       | Error error -> Error error
1282       | Ok loaded_info ->
1283         let changed_while_parsing = get_updates_exn genv root in
1284         Ok (loaded_info, changed_while_parsing)
1285     with exn ->
1286       let stack = Utils.Callstack (Printexc.get_backtrace ()) in
1287       Error (Load_state_unhandled_exception { exn; stack })
1288   in
1289   match state_result with
1290   | Error err -> Error err
1291   | Ok state_result ->
1292     ServerProgress.send_progress_to_monitor "loading saved state succeeded";
1293     let (env, t) =
1294       post_saved_state_initialization ~state_result ~env ~genv profiling
1295     in
1296     Ok ((env, t), state_result)