hphp/hack/src/server/serverIdle.ml

   1 (**
   2  * Copyright (c) 2014, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the BSD-style license found in the
   6  * LICENSE file in the "hack" directory of this source tree. An additional grant
   7  * of patent rights can be found in the PATENTS file in the same directory.
   8  *
   9  *)
  10
  11 open Core
  12
  13 (*****************************************************************************)
  14 (* Periodically called by the daemon *)
  15 (*****************************************************************************)
  16
  17 type callback =
  18   | Periodic of (float ref * float * (unit -> unit))
  19   | Once of (float ref * (unit -> unit))
  20
  21 module Periodical: sig
  22   val always : float
  23   val one_day: float
  24   val one_week: float
  25
  26   val check: unit -> unit
  27
  28   (* register_callback X Y
  29    * Registers a new callback Y called every X seconds.
  30    * The time is an approximation, don't expect it to be supper accurate.
  31    * More or less 1 sec is a more or less what you can expect.
  32    * More or less 30 secs if the server is busy.
  33    *)
  34   val register_callback: callback -> unit
  35
  36 end = struct
  37   let always = 0.0
  38   let one_day = 86400.0
  39   let one_week = 604800.0
  40
  41   let callback_list = ref []
  42   let last_call = ref (Unix.time())
  43
  44   let check () =
  45     let current = Unix.time() in
  46     let delta = current -. !last_call in
  47     last_call := current;
  48     callback_list := List.filter !callback_list begin fun callback ->
  49       (match callback with
  50       | Periodic (seconds_left, _, job)
  51       | Once (seconds_left, job) ->
  52           seconds_left := !seconds_left -. delta;
  53           if !seconds_left < 0.0 then job ());
  54       (match callback with
  55       | Periodic (seconds_left, period, _) ->
  56           if !seconds_left < 0.0 then seconds_left := period;
  57           true
  58       | Once _ -> false);
  59     end
  60
  61   let register_callback cb =
  62     callback_list := cb :: !callback_list
  63 end
  64
  65 let go = Periodical.check
  66
  67 let async f = Periodical.register_callback (Once (ref 0.0, f))
  68
  69 (*****************************************************************************)
  70 (*
  71  * kill the server every 24h. We do this to save resources and
  72  * make sure everyone is +/- running the same version.
  73  *
  74  * TODO: improve this check so the server only restarts
  75  *       if there hasn't been any activity for x hours/days.
  76  *)
  77 (*****************************************************************************)
  78
  79 (* We want to keep track of when the server was last used. Every few hours, we'll
  80  * check this variable. If the server hasn't been used for a few days, we exit.
  81  *)
  82 let last_client_connect: float ref = ref (Unix.time())
  83
  84 let stamp_connection() =
  85   last_client_connect := Unix.time();
  86   ()
  87
  88 let exit_if_unused() =
  89   let delta: float = Unix.time() -. !last_client_connect in
  90   if delta > Periodical.one_week
  91   then begin
  92     Printf.eprintf "Exiting server. Last used >7 days ago\n";
  93     Exit_status.(exit Unused_server)
  94   end
  95
  96 (*****************************************************************************)
  97 (* The registered jobs *)
  98 (*****************************************************************************)
  99 let init (root : Path.t) =
 100   let jobs = [
 101     (* I'm not sure explicitly invoking the Gc here is necessary, but
 102      * major_slice takes something like ~0.0001s to run, so why not *)
 103     Periodical.always   , (fun () -> ignore @@ Gc.major_slice 0);
 104     Periodical.always   , (fun () -> SharedMem.collect `aggressive);
 105     Periodical.always   , EventLogger.flush;
 106     Periodical.one_day  , exit_if_unused;
 107     Periodical.one_day  , Hhi.touch;
 108     (* try_touch wraps Unix.utimes, which doesn't open/close any fds, so we
 109      * won't lose our lock by doing this. *)
 110     Periodical.one_day  , (fun () ->
 111       Sys_utils.try_touch (ServerFiles.lock_file root)
 112     );
 113     Periodical.one_day  , (fun () ->
 114       Sys_utils.try_touch (Socket.get_path (ServerFiles.socket_file root))
 115     );
 116   ] in
 117   List.iter jobs begin fun (period, cb) ->
 118     Periodical.register_callback (Periodic (ref period, period, cb))
 119   end