hphp/hack/src/client/clientStop.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 module SMUtils = ServerMonitorUtils
  13
  14 exception FailedToKill
  15
  16 type env = {
  17   root: Path.t;
  18   from: string;
  19 }
  20
  21 let wait_for_death root secs =
  22   let i = ref 0 in
  23   try
  24     while MC.server_exists (ServerFiles.lock_file root) do
  25       incr i;
  26       if !i < secs then
  27         ignore @@ Unix.sleep 1
  28       else
  29         raise Exit
  30     done;
  31     true
  32   with Exit -> false
  33
  34 let nice_kill env =
  35   let root_s = Path.to_string env.root in
  36   Printf.eprintf "Attempting to nicely kill server for %s\n%!" root_s;
  37   try
  38     match ServerUtils.shut_down_server env.root with
  39     | Ok shutdown_result ->
  40       begin
  41         match shutdown_result with
  42         | SMUtils.SHUTDOWN_VERIFIED ->
  43           Printf.eprintf "Successfully killed server for %s\n%!" root_s
  44         | SMUtils.SHUTDOWN_UNVERIFIED ->
  45           Printf.eprintf
  46             "Failed to kill server nicely for %s (Shutdown not verified)\n%!"
  47             root_s;
  48           raise FailedToKill
  49       end
  50     | Error (SMUtils.Build_id_mismatched _) ->
  51       Printf.eprintf "Successfully killed server for %s\n%!" root_s
  52     | Error SMUtils.Server_missing ->
  53       Printf.eprintf "No server to kill for %s\n%!" root_s
  54     | Error _ ->
  55       Printf.eprintf "Failed to kill server nicely for %s\n%!" root_s;
  56       raise FailedToKill
  57   with _ ->
  58     Printf.eprintf "Failed to kill server nicely for %s\n%!" root_s;
  59     raise FailedToKill
  60
  61 let mean_kill env =
  62   let root_s = Path.to_string env.root in
  63   Printf.eprintf "Attempting to meanly kill server for %s\n%!" root_s;
  64   let pids =
  65     try PidLog.get_pids (ServerFiles.pids_file env.root)
  66     with PidLog.FailedToGetPids ->
  67       Printf.eprintf
  68         "Unable to figure out pids of running Hack server. Try manually killing it with `pkill hh_server`\n%!";
  69       raise FailedToKill
  70   in
  71   let success =
  72     try
  73       List.iter pids ~f:(fun (pid, _reason) ->
  74           try Sys_utils.terminate_process pid
  75           with Unix.Unix_error (Unix.ESRCH, "kill", _) ->
  76             (* no such process *)
  77             ());
  78       wait_for_death env.root 3
  79     with e ->
  80       print_endline (Exn.to_string e);
  81       false
  82   in
  83   if not success then (
  84     Printf.eprintf
  85       "Failed to kill server meanly for %s. Try manually killing it with `pkill hh_server`\n%!"
  86       root_s;
  87     raise FailedToKill
  88   ) else
  89     Printf.eprintf "Successfully killed server for %s\n%!" root_s
  90
  91 let do_kill env =
  92   try nice_kill env
  93   with FailedToKill ->
  94     (try mean_kill env
  95      with FailedToKill -> raise Exit_status.(Exit_with Kill_error))
  96
  97 let main (env : env) : Exit_status.t Lwt.t =
  98   HackEventLogger.set_from env.from;
  99   HackEventLogger.client_stop ();
 100   do_kill env;
 101   Lwt.return Exit_status.No_error
 102
 103 let kill_server root from = do_kill { root; from }