unison

Fork of Unison, a bi-directional file synchronization tool
git clone git://git.laack.co/unison.git
Log | Files | Refs | README | LICENSE

lwt_inotify.ml (1570B)


      1 (* Unison file synchronizer: src/monitoring-linux/lwt_inotify.ml *)
      2 (* Copyright 1999-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 let (>>=) = Lwt.bind
     19 
     20 type t =
     21   { fd : Unix.file_descr;
     22     lwt_fd : Lwt_unix.file_descr;
     23     q : Inotify.event Queue.t }
     24 
     25 let init () =
     26   let fd = Inotify.init () in
     27   { fd = fd;
     28     lwt_fd =
     29       Lwt_unix.of_unix_file_descr (*~blocking:false ~set_flags:true*) fd;
     30     q = Queue.create () }
     31 
     32 let add_watch st path sel =
     33 (*  Lwt_unix.check_descriptor st.lwt_fd;*)
     34   Inotify.add_watch st.fd path sel
     35 
     36 let rm_watch st wd =
     37 (*  Lwt_unix.check_descriptor st.lwt_fd;*)
     38   Inotify.rm_watch st.fd wd
     39 
     40 let rec read st =
     41   try
     42     Lwt.return (Queue.take st.q)
     43   with Queue.Empty ->
     44     Lwt_unix.wait_read st.lwt_fd >>= fun () ->
     45     let l = try Inotify.read st.fd with Unix.Unix_error (EAGAIN, _, _) -> [] in
     46     List.iter (fun ev -> Queue.push ev st.q) l;
     47     read st
     48 
     49 let close st = Lwt_unix.close st.lwt_fd