hphp/hack/src/utils/lock.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 Utils
  12
  13 let lock_fds = ref SMap.empty
  14
  15 (**
  16  * Basic lock operations.
  17  *
  18  * We use these for two reasons:
  19  * 1. making sure we are only running one instance of hh_server per person on a given dev box
  20  * 2. giving a way to hh_client to check if a server is running.
  21  *)
  22
  23 let register_lock lock_file =
  24   Sys_utils.with_umask 0o111 begin fun () ->
  25     let fd = Unix.descr_of_out_channel (open_out lock_file) in
  26     let st = Unix.fstat fd in
  27     lock_fds := SMap.add lock_file (fd, st) !lock_fds;
  28     fd
  29   end
  30
  31 (**
  32  * Grab or check if a file lock is available.
  33  *
  34  * Returns true if the lock is/was available, false otherwise.
  35  *)
  36 let _operations lock_file op : bool =
  37   try
  38     let fd = match SMap.get lock_file !lock_fds with
  39       | None -> register_lock lock_file
  40       | Some (fd, st) ->
  41           let identical_file =
  42             try
  43               (* Note: I'm carefully avoiding opening another fd to the
  44                * lock_file when doing this check, because closing any file
  45                * descriptor to a given file will release the locks on *all*
  46                * file descriptors that point to that file. Fortunately, stat()
  47                * gets us our information without opening a fd *)
  48               let current_st = Unix.stat lock_file in
  49               Unix.(st.st_dev = current_st.st_dev &&
  50                 st.st_ino = current_st.st_ino)
  51             with _ ->
  52               false
  53           in
  54           if not (Sys.win32 || identical_file) then
  55             (* Looks like someone (tmpwatch?) deleted the lock file; don't
  56              * create another one, because our socket is probably gone too.
  57              * We are dead in the water. *)
  58             raise Exit
  59           else
  60             fd
  61     in
  62     let _ =
  63       try Unix.lockf fd op 1
  64       with _ when Sys.win32 && (op = Unix.F_TLOCK || op = Unix.F_TEST) ->
  65           (* On Windows, F_TLOCK and F_TEST fail if we have the lock ourself *)
  66           (* However, we then are the only one to be able to write there. *)
  67           ignore (Unix.lseek fd 0 Unix.SEEK_SET : int);
  68           (* If we don't have the lock, the following 'write' will
  69              throw an exception. *)
  70           let wb = Unix.write fd " " 0 1 in
  71           (* When not throwing an exception, the current
  72              implementation of `Unix.write` always return `1`. But let's
  73              be protective against semantic changes, and better fails
  74              than wrongly assume that we own a lock. *)
  75           assert (wb = 1) in
  76     true
  77   with _ ->
  78     false
  79
  80 (**
  81  * Grabs the file lock and returns true if it the lock was grabbed
  82  *)
  83 let grab lock_file : bool = _operations lock_file Unix.F_TLOCK
  84
  85 (**
  86  * Releases a file lock.
  87  *)
  88 let release lock_file : bool = _operations lock_file Unix.F_ULOCK
  89
  90 (**
  91  * Gets the server instance-unique integral fd for a given lock file.
  92  *)
  93 let fd_of lock_file : int =
  94   match SMap.get lock_file !lock_fds with
  95     | None -> -1
  96     | Some fd -> Obj.magic fd
  97
  98 (**
  99  * Check if the file lock is available without grabbing it.
 100  * Returns true if the lock is free.
 101  *)
 102 let check lock_file : bool = _operations lock_file Unix.F_TEST