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
103
104
105
106
107
108
109
110
111
112
113
114
115
# 1 "src/backend.inotify.ml"
open Lwt.Infix
let src = Logs.Src.create "irw-inotify" ~doc:"Irmin watcher using Inotify"
module Log = (val Logs.src_log src : Logs.LOG)
let rec mkdir d =
let perm = 0o0700 in
try Unix.mkdir d perm with
| Unix.Unix_error (Unix.EEXIST, "mkdir", _) -> ()
| Unix.Unix_error (Unix.ENOENT, "mkdir", _) ->
mkdir (Filename.dirname d);
Unix.mkdir d perm
let start_watch dir =
Log.debug (fun l -> l "start_watch %s" dir);
if not (Sys.file_exists dir) then mkdir dir;
Lwt_inotify.create () >>= fun i ->
Lwt_inotify.add_watch i dir
[ Inotify.S_Create; Inotify.S_Modify; Inotify.S_Move; Inotify.S_Delete ]
>|= fun u ->
let stop () = Lwt_inotify.rm_watch i u >>= fun () -> Lwt_inotify.close i in
(i, stop)
let listen dir i fn =
let event_kinds (_, es, _, _) = es in
let pp_kind = Fmt.of_to_string Inotify.string_of_event_kind in
let path_of_event (_, _, _, p) =
match p with None -> dir | Some p -> Filename.concat dir p
in
let rec iter i =
Lwt.try_bind
(fun () ->
Lwt_inotify.read i >>= fun e ->
let path = path_of_event e in
let es = event_kinds e in
Log.debug (fun l -> l "inotify: %s %a" path Fmt.(Dump.list pp_kind) es);
fn path;
Lwt.return_unit)
(fun () -> iter i)
(function
| Unix.Unix_error (Unix.EBADF, _, _) ->
Lwt.return_unit
| e -> Lwt.fail e)
in
Core.stoppable (fun () -> iter i)
let v =
let listen dir f =
Log.info (fun l -> l "Inotify mode");
let events = ref [] in
let cond = Lwt_condition.create () in
start_watch dir >>= fun (i, stop_watch) ->
let rec wait_for_changes () =
match List.rev !events with
| [] -> Lwt_condition.wait cond >>= wait_for_changes
| h :: t ->
events := List.rev t;
Lwt.return (`File h)
in
let unlisten =
listen dir i (fun path ->
events := path :: !events;
Lwt_condition.signal cond ())
in
Hook.v ~wait_for_changes ~dir f >|= fun unpoll () ->
stop_watch () >>= fun () ->
unlisten () >>= fun () -> unpoll ()
in
lazy (Core.create listen)
let mode = `Inotify
let uname () =
try
let ic = Unix.open_process_in "uname" in
let uname = input_line ic in
let () = close_in ic in
Some uname
with Unix.Unix_error _ -> None
let is_linux () = Sys.os_type = "Unix" && uname () = Some "Linux"
type mode = [ `Polling | `Inotify ]
let mode, v =
if is_linux () then ((mode :> mode), v) else Polling.((mode :> mode), v)