hphp/hack/src/server/serverInit.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 Hh_prelude
  11 open Result.Export
  12 open ServerEnv
  13 module SLC = ServerLocalConfig
  14 include ServerInitTypes
  15
  16 let save_state
  17     (genv : ServerEnv.genv) (env : ServerEnv.env) (output_filename : string) :
  18     SaveStateServiceTypes.save_state_result option =
  19   let ignore_errors =
  20     ServerArgs.gen_saved_ignore_type_errors genv.ServerEnv.options
  21   in
  22   let has_errors = not (Errors.is_empty env.errorl) in
  23   let do_save_state =
  24     if ignore_errors then (
  25       if has_errors then
  26         Printf.eprintf
  27           "WARNING: BROKEN SAVED STATE! Generating saved state. Ignoring type errors.\n%!"
  28       else
  29         Printf.eprintf
  30           "Generating saved state and ignoring type errors, but there were none.\n%!";
  31       true
  32     ) else if has_errors then (
  33       Printf.eprintf
  34         "Refusing to generate saved state. There are type errors\n%!";
  35       Printf.eprintf "and --gen-saved-ignore-type-errors was not provided.\n%!";
  36       false
  37     ) else
  38       true
  39   in
  40   if not do_save_state then
  41     None
  42   else
  43     let result = SaveStateService.save_state env output_filename in
  44     Some result
  45
  46 let post_init genv (env, _t) =
  47   ignore genv;
  48   SharedMem.SMTelemetry.init_done ();
  49   env
  50
  51 let full_init genv env profiling =
  52   ( ServerLazyInit.full_init genv env profiling |> post_init genv,
  53     Load_state_declined "No saved-state requested (for lazy init)" )
  54
  55 let parse_only_init genv env profiling =
  56   ( ServerLazyInit.parse_only_init genv env profiling |> fst,
  57     Load_state_declined "No saved-state requested (for lazy parse-only init)" )
  58
  59 let saved_state_init_error env genv ~do_indexing err =
  60   let ServerInitTypes.{ message; auto_retry; telemetry } =
  61     load_state_error_to_verbose_string err
  62   in
  63   let (next_step_descr, next_step, user_instructions) =
  64     if do_indexing then
  65       (* ServerInit.Write_symbol_info_with_state will never fallback upon saved-state problems *)
  66       ("fatal", Exit_status.Failed_to_load_should_abort, None)
  67     else if not genv.local_config.SLC.require_saved_state then
  68       (* without "--config require_saved_state=true", we're happy to fallback to full init *)
  69       ("fallback", Exit_status.No_error, None)
  70     else if auto_retry then
  71       (* The auto-retry means we'll exit in such a way that find_hh.sh will rerun us *)
  72       ("retry", Exit_status.Failed_to_load_should_retry, None)
  73     else
  74       (* No fallbacks, no retries, no recourse! Let's explain this clearly to the user. *)
  75       ( "fatal",
  76         Exit_status.Failed_to_load_should_abort,
  77         Some ServerInitMessages.messageSavedStateFailedFullInitDisabled )
  78   in
  79   let user_message = Printf.sprintf "%s [%s]" message next_step_descr in
  80   let user_message =
  81     match user_instructions with
  82     | None -> user_message
  83     | Some user_instructions ->
  84       Printf.sprintf "%s\n\n%s" user_message user_instructions
  85   in
  86   HackEventLogger.load_state_exn telemetry;
  87   Hh_logger.log "LOAD_STATE_EXN %s" (Telemetry.to_string telemetry);
  88   match next_step with
  89   | Exit_status.No_error ->
  90     let fall_back_to_full_init profiling =
  91       ServerLazyInit.full_init genv env profiling |> post_init genv
  92     in
  93     ( CgroupProfiler.step_group "full_init" ~log:true @@ fall_back_to_full_init,
  94       Load_state_failed (user_message, telemetry) )
  95   | _ -> Exit.exit ~msg:user_message ~telemetry next_step
  96
  97 let saved_state_init
  98     ~do_indexing
  99     genv
 100     env
 101     root
 102     (load_state_approach : load_state_approach)
 103     profiling =
 104   let result =
 105     ServerLazyInit.saved_state_init
 106       ~do_indexing
 107       ~load_state_approach
 108       genv
 109       env
 110       root
 111       profiling
 112   in
 113   match result with
 114   | Ok ((env, t), ({ saved_state_revs_info; _ }, _)) ->
 115     let env = post_init genv (env, t) in
 116     (env, Load_state_succeeded saved_state_revs_info)
 117   | Error err -> saved_state_init_error env genv ~do_indexing err
 118
 119 (** Write symbol info for Glean *)
 120 let write_symbol_info_init genv env root (load_state : _ option) profiling =
 121   match load_state with
 122   | None ->
 123     ( ServerLazyInit.write_symbol_info_full_init genv env profiling
 124       |> post_init genv,
 125       Load_state_declined "Write Symobl info state" )
 126   | Some load_state_approach ->
 127     saved_state_init
 128       ~do_indexing:true
 129       genv
 130       env
 131       root
 132       load_state_approach
 133       profiling
 134
 135 let possibly_set_rust_provider_backend env genv : unit =
 136   if genv.local_config.ServerLocalConfig.rust_provider_backend then (
 137     Hh_logger.log "ServerInit: using rust backend";
 138     let backend =
 139       Hh_server_provider_backend.make
 140         (DeclFoldOptions.from_global_options env.tcopt)
 141         (DeclParserOptions.from_parser_options env.tcopt.GlobalOptions.po)
 142     in
 143     Provider_backend.set_rust_backend backend
 144   )
 145
 146 let init
 147     ~(init_approach : init_approach)
 148     (genv : ServerEnv.genv)
 149     (env : ServerEnv.env) : ServerEnv.env * init_result =
 150   possibly_set_rust_provider_backend env genv;
 151   Hh_logger.log
 152     "ServerInit: init_approach=%s"
 153     (show_init_approach init_approach);
 154   let (init_method, init_method_name) =
 155     let root = ServerArgs.root genv.options in
 156     match init_approach with
 157     | Full_init -> (full_init genv env, "full_init")
 158     | Saved_state_init load_state_approach ->
 159       ( saved_state_init ~do_indexing:false genv env root load_state_approach,
 160         "saved_state_init" )
 161     | Parse_only_init -> (parse_only_init genv env, "parse_only_init")
 162     | Write_symbol_info ->
 163       (write_symbol_info_init genv env root None, "write_symbol_info_init")
 164     | Write_symbol_info_with_state load_state_approach ->
 165       ( write_symbol_info_init genv env root (Some load_state_approach),
 166         "write_symbol_info_with_state" )
 167   in
 168   CgroupProfiler.step_group init_method_name ~log:true init_method