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