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