hphp/hack/src/server/serverUtils.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 module MC = MonitorConnection
  12
  13 type 'env handle_command_result =
  14   (* Command was fully handled, and this is the new environment. *)
  15   | Done of 'env
  16   (* Returned continuation needs to be run with an environment after finished
  17    * full check to complete handling of command. The string specifies a reason
  18    * why this command needs full recheck (for logging/debugging purposes) *)
  19   | Needs_full_recheck of 'env * ('env -> 'env) * string
  20   (* Commands that want to modify global state, by modifying file contents.
  21    * The boolean indicates whether current recheck should be automatically
  22    * restarted after applying the writes *)
  23   | Needs_writes of 'env * ('env -> 'env) * bool
  24
  25 let wrap try_ f = fun env -> try_ env (fun () -> f env)
  26
  27 (* Wrap all the continuations inside result in provided try function *)
  28 let wrap try_ = function
  29   | Done env -> Done env
  30   | Needs_full_recheck (env, f, reason) ->
  31     Needs_full_recheck (env, wrap try_ f, reason)
  32   | Needs_writes (env, f, reason) -> Needs_writes (env, wrap try_ f, reason)
  33
  34 let shutdown_client (_ic, oc) =
  35   let cli = Unix.descr_of_out_channel oc in
  36   try
  37     Unix.shutdown cli Unix.SHUTDOWN_ALL;
  38     Out_channel.close oc
  39   with _ -> ()
  40
  41 let hh_monitor_config root = ServerMonitorUtils.({
  42   lock_file = ServerFiles.lock_file root;
  43   socket_file = ServerFiles.socket_file root;
  44   server_log_file = ServerFiles.log_link root;
  45   monitor_log_file = ServerFiles.monitor_log_link root;
  46 })
  47
  48 let shut_down_server root =
  49   MC.connect_and_shut_down (hh_monitor_config root)
  50
  51 let connect_to_monitor ~timeout root =
  52   MC.connect_once ~timeout (hh_monitor_config root)
  53
  54 let server_progress ~timeout root =
  55   MC.connect_to_monitor_and_get_server_progress ~timeout (hh_monitor_config root)
  56
  57 let print_hash_stats () =
  58   Utils.try_with_stack SharedMem.dep_stats
  59   |> Result.map_error ~f:(fun (exn, Utils.Callstack stack) -> Hh_logger.exc ~stack exn)
  60   |> Result.iter ~f:begin fun { SharedMem.
  61     used_slots;
  62     slots;
  63     nonempty_slots = _ } ->
  64     let load_factor = float_of_int used_slots /. float_of_int slots in
  65     Hh_logger.log "Dependency table load factor: %d / %d (%.02f)"
  66       used_slots slots load_factor
  67   end;
  68   Utils.try_with_stack SharedMem.hash_stats
  69   |> Result.map_error ~f:(fun (exn, Utils.Callstack stack) -> Hh_logger.exc ~stack exn)
  70   |> Result.iter ~f:begin fun { SharedMem.
  71     used_slots;
  72     slots;
  73     nonempty_slots } ->
  74     let load_factor = float_of_int used_slots /. float_of_int slots in
  75     Hh_logger.log
  76       "Hashtable load factor: %d / %d (%.02f) with %d nonempty slots"
  77       used_slots slots load_factor nonempty_slots
  78   end
  79
  80 let exit_on_exception (exn: exn) ~(stack: Utils.callstack) =
  81   let (Utils.Callstack stack) = stack in
  82   match exn with
  83   | SharedMem.Out_of_shared_memory ->
  84     print_hash_stats ();
  85     Printf.eprintf "Error: failed to allocate in the shared heap.\n%!";
  86     Exit_status.(exit Out_of_shared_memory)
  87   | SharedMem.Hash_table_full ->
  88     print_hash_stats ();
  89     Printf.eprintf "Error: failed to allocate in the shared hashtable.\n%!";
  90     Exit_status.(exit Hash_table_full)
  91   | Watchman.Watchman_error s as e ->
  92     Hh_logger.exc ~stack e;
  93     Hh_logger.log "Exiting. Failed due to watchman error: %s" s;
  94     Exit_status.(exit Watchman_failed)
  95   | MultiThreadedCall.Coalesced_failures failures as e -> begin
  96     Hh_logger.exc ~stack e;
  97     let failure_msg =
  98       MultiThreadedCall.coalesced_failures_to_string failures in
  99     Hh_logger.log "%s" failure_msg;
 100     let is_oom_failure f = match f with
 101       | WorkerController.Worker_oomed -> true
 102       | _ -> false in
 103     let has_oom_failure = List.exists ~f:is_oom_failure failures in
 104     if has_oom_failure then
 105       let () = Hh_logger.log "Worker oomed. Exiting" in
 106       Exit_status.(exit Worker_oomed)
 107     else
 108       (** We attempt to exit with the same code as a worker by folding over
 109        * all the failures and looking for a WEXITED. *)
 110       let worker_exit f = match f with
 111         | WorkerController.Worker_quit (Unix.WEXITED i) ->
 112           Some i
 113         | _ ->
 114           None
 115       in
 116       let exit_code = List.fold_left ~f:(fun acc f ->
 117         if Option.is_some acc then acc else worker_exit f
 118         ) ~init:None failures
 119       in
 120       match exit_code with
 121       | Some i ->
 122         (** Exit with same code. *)
 123         exit i
 124       | None ->
 125         failwith failure_msg
 126   end
 127   (** In single-threaded mode, WorkerController exceptions are raised directly
 128    * instead of being grouped into MultiThreaadedCall.Coalesced_failures *)
 129   | WorkerController.(Worker_failed (_, Worker_oomed)) as e->
 130     Hh_logger.exc ~stack e;
 131     Exit_status.(exit Worker_oomed)
 132   | WorkerController.Worker_busy as e ->
 133     Hh_logger.exc ~stack e;
 134     Exit_status.(exit Worker_busy)
 135   | (WorkerController.(Worker_failed (_, Worker_quit(Unix.WEXITED i)))) as e ->
 136     Hh_logger.exc ~stack e;
 137     (** Exit with the same exit code that that worker used. *)
 138     exit i
 139   | WorkerController.Worker_failed_to_send_job _ as e->
 140     Hh_logger.exc ~stack e;
 141     Exit_status.(exit Worker_failed_to_send_job)
 142   | File_provider.File_provider_stale ->
 143     Exit_status.(exit File_provider_stale)
 144   | Decl_class.Decl_heap_elems_bug ->
 145     Exit_status.(exit Decl_heap_elems_bug)
 146   | Decl_defs.Decl_not_found _->
 147     Exit_status.(exit Decl_not_found)
 148   | SharedMem.C_assertion_failure _ as e ->
 149     Hh_logger.exc ~stack e;
 150     Exit_status.(exit Shared_mem_assertion_failure)
 151   | SharedMem.Sql_assertion_failure err_num as e ->
 152     Hh_logger.exc ~stack e;
 153     let exit_code = match err_num with
 154       | 11 -> Exit_status.Sql_corrupt
 155       | 14 -> Exit_status.Sql_cantopen
 156       | 21 -> Exit_status.Sql_misuse
 157       | _ -> Exit_status.Sql_assertion_failure
 158     in
 159     Exit_status.exit exit_code
 160   | Exit_status.Exit_with ec ->
 161     Exit_status.(exit ec)
 162   | e ->
 163     Hh_logger.exc ~stack e;
 164     Exit_status.(exit Uncaught_exception)
 165
 166 let with_exit_on_exception f =
 167   try
 168     f ()
 169   with exn ->
 170     let stack = Utils.Callstack (Printexc.get_backtrace ()) in
 171     exit_on_exception exn ~stack