watcher.ml (7378B)
1 (* Unison file synchronizer: src/fsmonitoring/linux/watcher.ml *) 2 (* Copyright 2012, Benjamin C. Pierce 3 4 This program is free software: you can redistribute it and/or modify 5 it under the terms of the GNU General Public License as published by 6 the Free Software Foundation, either version 3 of the License, or 7 (at your option) any later version. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 GNU General Public License for more details. 13 14 You should have received a copy of the GNU General Public License 15 along with this program. If not, see <http://www.gnu.org/licenses/>. 16 *) 17 18 (* 19 LIMITATIONS 20 - we do not detect when a directory below a path is moved; 21 - same limitation for the directories containing symlinked files; 22 - do not watch chains of symlinks (only the first symlink and the 23 final target are watched) 24 - we do not watch non-existent roots 25 26 POSSIBLE IMPROVEMENTS 27 - there could be a special case for directory attribute changes 28 29 Maybe we should ignore Unison temporary files 30 *) 31 32 let (>>=) = Lwt.bind 33 34 module M = Watchercommon.F(struct type watch = Inotify.wd end) 35 include M 36 37 (****) 38 39 module Linux = struct 40 41 let print_opt_path f p = 42 match p with 43 Some p -> Format.fprintf f " \"%s\"" p 44 | None -> () 45 46 let print_event path_of_id (wd, evl, id, p) = 47 Format.eprintf "%02d %s%a" 48 (Inotify.int_of_wd wd) (path_of_id wd) print_opt_path p; 49 List.iter (fun ev -> Format.eprintf " %s" (Inotify.string_of_event ev)) evl; 50 if id <> 0l then Format.eprintf " %08lx" id; 51 Format.eprintf "@." 52 53 let action_kind ev = 54 Inotify. 55 (match ev with 56 | Access -> `OTHER 57 | Attrib -> `MODIF 58 | Close_write -> `OTHER 59 | Close_nowrite -> `OTHER 60 | Create -> `CREAT 61 | Delete -> `DEL 62 | Delete_self -> `DEL 63 | Modify -> `MODIF 64 | Move_self -> `DEL 65 | Moved_from -> `DEL 66 | Moved_to -> `MODIF 67 | Open -> `OTHER 68 | Ignored -> `OTHER 69 | Isdir -> `OTHER 70 | Q_overflow -> `OTHER 71 | Unmount -> `DEL) 72 73 let event_kind (_, evl, _, _) = 74 List.fold_left (fun k act -> if k = `OTHER then action_kind act else k) 75 `OTHER evl 76 77 let is_change ev = 78 Inotify. 79 (match ev with 80 | Access -> false 81 | Attrib -> true 82 | Close_write -> false 83 | Close_nowrite -> false 84 | Create -> true 85 | Delete -> true 86 | Delete_self -> true 87 | Modify -> true 88 | Move_self -> true 89 | Moved_from -> true 90 | Moved_to -> true 91 | Open -> false 92 | Ignored -> false 93 | Isdir -> false 94 | Q_overflow -> false 95 | Unmount -> true) 96 97 let is_creation ev = ev = Inotify.Create 98 99 let is_deletion ev = 100 Inotify. 101 (match ev with 102 | Access -> false 103 | Attrib -> false 104 | Close_write -> false 105 | Close_nowrite -> false 106 | Create -> false 107 | Delete -> true 108 | Delete_self -> true 109 | Modify -> false 110 | Move_self -> true 111 | Moved_from -> true 112 | Moved_to -> false 113 | Open -> false 114 | Ignored -> false 115 | Isdir -> false 116 | Q_overflow -> false 117 | Unmount -> true) 118 119 let event_is_change (_, evl, _, _) = List.exists is_change evl 120 let event_is_creation (_, evl, _, _) = List.exists is_creation evl 121 let event_is_deletion (_, evl, _, _) = List.exists is_deletion evl 122 123 let st = 124 try Lwt_inotify.init () with 125 | Unix.Unix_error ((EMFILE | EBADF), _, _) -> 126 Watchercommon.error "unable to start inotify: system limit reached \ 127 (you can do a web search for \"inotify max_user_instances\" \ 128 to understand the reasons and mitigations for this error)" 129 130 module IntSet = 131 Set.Make 132 (struct type t = int let compare (x : int) (y : int) = compare x y end) 133 134 let watcher_by_id = Hashtbl.create 16 135 136 let path_of_id id = 137 try 138 dir_path 139 (Hashtbl.find file_by_id (IntSet.choose (Hashtbl.find watcher_by_id id))) 140 "" 141 with Not_found -> 142 Format.sprintf "????" 143 144 let previous_event = ref None 145 146 let clear_event_memory () = previous_event := None 147 148 let rec watch_rec () = 149 Lwt_inotify.read st >>= fun ((wd, evl, _, nm_opt) as ev) -> 150 let time = Unix.gettimeofday () in 151 if !previous_event <> Some ev then begin 152 previous_event := Some ev; 153 if !Watchercommon.debug then print_event path_of_id ev; 154 let kind = event_kind ev in 155 if kind <> `OTHER then begin 156 try 157 let files = Hashtbl.find watcher_by_id wd in 158 IntSet.iter 159 (fun file -> 160 signal_change 161 time (Hashtbl.find file_by_id file) nm_opt kind) 162 files 163 with Not_found -> 164 () 165 end else if List.mem Inotify.Q_overflow evl then begin 166 if !Watchercommon.debug then Format.eprintf "OVERFLOW@."; 167 signal_overflow () 168 end 169 end; 170 watch_rec () 171 172 let watch () = 173 ignore 174 (Lwt.catch (fun () -> watch_rec ()) 175 (fun e -> 176 Watchercommon.error 177 ("error while handling events: " ^ Watchercommon.format_exc e))) 178 179 let i = ref 0 180 181 let release_watch file = 182 match get_watch file with 183 None -> 184 () 185 | Some id -> 186 set_watch file None; 187 let s = IntSet.remove (get_id file) (Hashtbl.find watcher_by_id id) in 188 if IntSet.is_empty s then begin 189 incr i; if !i mod 32 = 0 then Lwt_unix.run (Lwt_unix.yield ()); 190 begin try 191 Lwt_inotify.rm_watch st id 192 (* Will fail with EINVAL if the file has been deleted... *) 193 with Unix.Unix_error _ -> 194 () 195 end; 196 Hashtbl.remove watcher_by_id id 197 end else 198 Hashtbl.replace watcher_by_id id s 199 200 let selected_events = 201 Inotify.S_Excl_unlink :: 202 Inotify.([S_Attrib; S_Modify; S_Delete_self; S_Move_self; 203 S_Create; S_Delete; S_Modify; S_Moved_from; S_Moved_to]) 204 let selected_events_nofollow = Inotify.S_Dont_follow :: selected_events 205 206 let add_watch path file follow = 207 try 208 let selected_events = 209 if follow then selected_events 210 else selected_events_nofollow in 211 let id = Lwt_inotify.add_watch st path selected_events in 212 begin match get_watch file with 213 Some id' when id = id' -> 214 () 215 | _ -> 216 release_watch file; 217 let s = 218 try Hashtbl.find watcher_by_id id with Not_found -> IntSet.empty in 219 Hashtbl.replace watcher_by_id id (IntSet.add (get_id file) s); 220 set_watch file (Some id) 221 end 222 with Unix.Unix_error (errno, _, _) -> 223 release_watch file; 224 match errno with 225 | ENOENT -> 226 raise Watchercommon.Already_lost 227 | ENOSPC -> 228 Watchercommon.error ("cannot add a watcher: system limit reached" 229 ^ " (you can do a web search for \"inotify max_user_watches\"" 230 ^ " to understand the reasons and mitigations for this error)") 231 | EACCES | ENOTDIR | ELOOP -> 232 (* These errors should be well handled by Unison (they will 233 result in errors during update detection *) 234 () 235 | _ -> 236 Watchercommon.error 237 (Format.sprintf "unexpected error while adding a watcher: %s" 238 (Unix.error_message errno)) 239 240 end 241 242 (****) 243 244 include F(Linux)