dirwatcher.ml

   1 (** Watches directories for events. Agnostic to vsys semantics of backends and
   2   frontends *)
   3 open Inotify
   4 open Fdwatcher
   5 open Printf
   6 open Globals
   7
   8 (* I don't know if a wd corresponding to a deleted directory is evicted or just
   9  * leaks - fix implementation of rmdir accordingly
  10  *)
  11 let wdmap = Hashtbl.create 1024
  12 let masks = Hashtbl.create 1024
  13
  14 let fd = Inotify.init ()
  15
  16 let rec list_check lst elt =
  17   match lst with
  18     | [] -> false
  19     | car::cdr -> if (car==elt) then true else list_check cdr elt
  20
  21 let handle_dir_event dirname evlist str =
  22   let fname = String.concat "/" [dirname;str] in
  23     fprintf logfd "File: %s. " fname;List.iter
  24                                        (fun e ->
  25                                           fprintf logfd "Event: %s\n" (string_of_event e))
  26                                        evlist;
  27     flush logfd
  28
  29 let add_watch dir events handler =
  30   let evcheck = list_check events in
  31   let wd = Inotify.add_watch fd dir events in
  32     Hashtbl.add wdmap wd (dir,Some(handler))
  33       (* Ignore the possibility that the whole directory can disappear and come
  34        * back while it is masked *)
  35
  36 let mask_watch fqp =
  37   try
  38     Hashtbl.replace masks fqp true
  39   with _ ->
  40     ()
  41
  42 let unmask_watch fqp =
  43   if (Hashtbl.mem masks fqp) then
  44     begin
  45       Hashtbl.remove masks fqp
  46     end
  47   else
  48     fprintf logfd "WARNING: %s -- Unpaired unmask\n" fqp;flush logfd
  49
  50 let asciiz s =
  51   let rec findfirstnul str idx len =
  52     if ((idx==len) ||
  53         (str.[idx]==(char_of_int 0))) then idx
  54     else
  55       findfirstnul str (idx+1) len
  56   in
  57   let nulterm = findfirstnul s 0 (String.length s) in
  58     String.sub s 0 nulterm
  59
  60 let receive_event (eventdescriptor:fname_and_fd) (bla:fname_and_fd) =
  61   let (_,fd) = eventdescriptor in
  62   let evs = Inotify.read fd in
  63     List.iter (fun x->
  64                  match x with
  65                    | (wd,evlist,_,Some(str)) ->
  66                        begin
  67                                let purestr = asciiz(str) in
  68                                let (dirname,handler) =
  69                                  try Hashtbl.find wdmap wd with Not_found->("",None)
  70                                in
  71                                    match handler with
  72                                      | None->fprintf logfd "Unhandled watch descriptor\n";flush logfd
  73                                      | Some(handler)->
  74                                          let fqp = String.concat "/" [dirname;purestr] in
  75                                          let mask_filter = Hashtbl.mem masks fqp in
  76                                            if (not mask_filter) then
  77                                              begin
  78                                                 handler wd dirname evlist purestr
  79                                              end
  80                        end
  81                    | _ -> ())
  82       evs
  83
  84 let initialize () =
  85   Fdwatcher.add_fd (None,fd) (None,fd) receive_event