fswatchold.ml (7163B)
1 (* Unison file synchronizer: src/fswatcherold.ml *) 2 (* Copyright 1999-2020, 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 (* FIX: the names of the paths being watched should get included 19 in the name of the watcher's state file *) 20 21 let debug = Util.debug "fswatch" 22 23 let watchinterval = 5 24 25 let watcherTemp archHash n = Util.fileInUnisonDir (n ^ archHash) 26 27 let watchercmd archHash root = 28 let fsmonfile = 29 Filename.concat (Filename.dirname Sys.executable_name) "fsmonitor.py" in 30 if not (Sys.file_exists fsmonfile) then 31 None 32 else begin 33 (* FIX: is the quoting of --follow parameters going to work on Win32? 34 (2/2012: tried adding Uutil.quotes -- maybe this is OK now?) *) 35 (* FIX -- need to find the program using watcherosx preference *) 36 let changefile = watcherTemp archHash "changes" in 37 let statefile = watcherTemp archHash "state" in 38 let paths = Safelist.map Path.toString (Prefs.read Globals.paths) in 39 let followpaths = Pred.extern Path.followPred in 40 let follow = Safelist.map 41 (fun s -> "--follow '" ^ Uutil.quotes s ^ "'") 42 followpaths in 43 (* BCP (per Josh Berdine, 5/2012): changed startup command from this... 44 let cmd = Printf.sprintf "fsmonitor.py %s --outfile %s --statefile %s %s %s\n" 45 ... to this: *) 46 let cmd = Printf.sprintf "python \"%s\" \"%s\" --outfile \"%s\" --statefile \"%s\" %s %s\n" 47 fsmonfile 48 root 49 changefile 50 statefile 51 (String.concat " " follow) 52 (String.concat " " paths) in 53 debug (fun() -> Util.msg "watchercmd = %s\n" cmd); 54 Some (changefile,cmd) 55 end 56 57 module StringSet= Set.Make (String) 58 module RootMap = Map.Make (String) 59 type watcherinfo = {file: string; 60 mutable ch:in_channel option; 61 proc: out_channel; 62 chars: Buffer.t; 63 mutable lines: string list} 64 let watchers : watcherinfo RootMap.t ref = ref RootMap.empty 65 let newWatchers = ref StringSet.empty 66 67 let trim_duplicates l = 68 let rec loop l = match l with 69 [] -> l 70 | [s] -> l 71 | s1::s2::rest -> 72 if Util.startswith s1 s2 || Util.startswith s2 s1 then 73 loop (s2::rest) 74 else 75 s1 :: (loop (s2::rest)) in 76 loop (Safelist.sort String.compare l) 77 78 let readAvailableLinesFromWatcher wi = 79 let ch = match wi.ch with Some(c) -> c | None -> assert false in 80 let rec loop () = 81 match try Some(input_char ch) with End_of_file -> None with 82 None -> 83 () 84 | Some(c) -> 85 if c = '\n' then begin 86 wi.lines <- Buffer.contents wi.chars :: wi.lines; 87 Buffer.clear wi.chars; 88 loop () 89 end else begin 90 Buffer.add_char wi.chars c; 91 loop () 92 end in 93 loop () 94 95 let readChanges wi = 96 if wi.ch = None then 97 (* Watcher channel not built yet *) 98 if System.file_exists wi.file then begin 99 (* Build it and go *) 100 let c = System.open_in_bin wi.file in 101 wi.ch <- Some c; 102 readAvailableLinesFromWatcher wi; 103 end else begin 104 (* Wait for change file to be built *) 105 debug (fun() -> Util.msg 106 "Waiting for change file %s\n" 107 wi.file) 108 end 109 else 110 (* Watcher running and channel built: go ahead and read *) 111 readAvailableLinesFromWatcher wi 112 113 let watcherRunning archHash = 114 RootMap.mem archHash !watchers && 115 let wi = RootMap.find archHash !watchers in 116 match Unix.waitpid [Unix.WNOHANG] (System.process_out_pid wi.proc) with 117 | (0, _) -> true 118 | _ | exception Unix.Unix_error (ECHILD, _, _) -> 119 watchers := RootMap.remove archHash !watchers; 120 begin 121 try ignore (System.close_process_out wi.proc) 122 with Unix.Unix_error _ -> () 123 end; 124 begin match wi.ch with 125 | Some ch -> close_in_noerr ch 126 | None -> () 127 end; 128 false 129 130 let getChanges archHash = 131 if StringSet.mem archHash !newWatchers then 132 Fswatch.getChanges archHash 133 else begin 134 let wi = RootMap.find archHash !watchers in 135 readChanges wi; 136 let res = wi.lines in 137 wi.lines <- []; 138 ignore (watcherRunning archHash); (* Clean up if necessary *) 139 List.map Path.fromString (trim_duplicates res) 140 end 141 142 let start archHash fspath = 143 if not (Prefs.read Fswatch.useWatcher) then 144 false 145 else if Fswatch.start archHash then begin 146 newWatchers := StringSet.add archHash !newWatchers; 147 true 148 end else if not (watcherRunning archHash) then begin 149 (* Watcher process not running *) 150 match watchercmd archHash (Fspath.toString fspath) with 151 Some (changefile,cmd) -> 152 debug (fun() -> Util.msg 153 "Starting watcher on fspath %s\n" 154 (Fspath.toDebugString fspath)); 155 let proc = System.open_process_out cmd in 156 let wi = {file = changefile; ch = None; proc; 157 lines = []; chars = Buffer.create 80} in 158 watchers := RootMap.add archHash wi !watchers; 159 true 160 | None -> 161 false 162 end else begin 163 (* If already running, discard all pending changes *) 164 ignore (getChanges archHash); 165 true 166 end 167 168 let running archHash = 169 if StringSet.mem archHash !newWatchers then begin 170 if Fswatch.running archHash then true 171 else begin 172 newWatchers := StringSet.remove archHash !newWatchers; 173 false 174 end 175 end else false 176 || 177 watcherRunning archHash 178 179 let wait archHash = 180 if StringSet.mem archHash !newWatchers then 181 Fswatch.wait archHash 182 else if not (RootMap.mem archHash !watchers) then 183 raise (Util.Fatal "No file monitoring helper program found") 184 else if not (watcherRunning archHash) then 185 raise (Util.Fatal "File monitoring helper program not running") 186 else begin 187 let wi = RootMap.find archHash !watchers in 188 let rec loop () = 189 readChanges wi; 190 if wi.lines = [] then begin 191 debug (fun() -> Util.msg "Sleeping for %d seconds...\n" watchinterval); 192 Lwt.bind (Lwt_unix.sleep (float watchinterval)) (fun () -> 193 if watcherRunning archHash then 194 loop () 195 else 196 (* Instead of immediately restarting the watcher, the only sensible 197 thing to do is to do a full scan (which will happen automatically 198 if the update scanner notices that watcher is not running). We 199 don't know if any updates have been missed and can no longer rely 200 on the watcher only. *) 201 Lwt.return ()) 202 end else 203 Lwt.return () 204 in 205 loop () 206 end