X-Git-Url: http://git.onelab.eu/?a=blobdiff_plain;f=dirwatcher.ml;h=a50416fb72097235219dc513e54b5c7279ce137b;hb=7ae75ecaa4e7772450202515acf892685ee6179e;hp=f01cb3324dacab4f22848dd019d5b19cb14b9363;hpb=892d26d4e05de55ae94d21a586e6a0bfa724e327;p=vsys.git

diff --git a/dirwatcher.ml b/dirwatcher.ml
index f01cb33..a50416f 100644
--- a/dirwatcher.ml
+++ b/dirwatcher.ml
@@ -1,3 +1,5 @@
+(** Watches directories for events. Agnostic to vsys semantics of backends and
+  frontends *)
 open Inotify
 open Fdwatcher
 open Printf
@@ -6,51 +8,90 @@ open Globals
 (* I don't know if a wd corresponding to a deleted directory is evicted or just
  * leaks - fix implementation of rmdir accordingly
  *)
-
 let wdmap = Hashtbl.create 1024
+let masks = Hashtbl.create 1024
 
 let fd = Inotify.init ()
 
+let rec list_check lst elt =
+  match lst with
+    | [] -> false
+    | car::cdr -> if (car==elt) then true else list_check cdr elt
+
 let handle_dir_event dirname evlist str = 
-    let fname = String.concat "/" [dirname;str] in
-        printf "File: %s. " fname;List.iter 
-                  (fun e -> 
-                     printf "Event: %s\n" (string_of_event e)) 
-                  evlist;
-        flush Pervasives.stdout
+  let fname = String.concat "/" [dirname;str] in
+    logprint "File: %s. " fname;
+    List.iter 
+      (fun e -> 
+         logprint "Event: %s\n" (string_of_event e)) 
+      evlist
 
 let add_watch dir events handler =
-  printf "Adding watch for %s\n" dir;flush Pervasives.stdout;
   let wd = Inotify.add_watch fd dir events in
-      Hashtbl.add wdmap wd (dir,handler)
+    Hashtbl.add wdmap wd (dir,Some(handler))
+      (* Ignore the possibility that the whole directory can disappear and come
+       * back while it is masked *)
+
+let mask_watch fqp =
+  try 
+    Hashtbl.replace masks fqp true
+  with _ ->
+    ()
 
+let unmask_watch fqp =
+  if (Hashtbl.mem masks fqp) then
+    begin
+      Hashtbl.remove masks fqp
+    end
+  else
+    logprint "WARNING: %s -- Unpaired unmask\n" fqp
+  
 let asciiz s =
   let rec findfirstnul str idx len =
     if ((idx==len) || 
-      (str.[idx]==(char_of_int 0))) then idx
-      else
-        findfirstnul str (idx+1) len
+        (str.[idx]==(char_of_int 0))) then idx
+    else
+      findfirstnul str (idx+1) len
   in
   let nulterm = findfirstnul s 0 (String.length s) in
     String.sub s 0 nulterm
 
 let receive_event (eventdescriptor:fname_and_fd) (bla:fname_and_fd) =
   let (_,fd) = eventdescriptor in
-      let evs = Inotify.read fd in
-        List.iter (fun x->
-                match x with
-                  | (wd,evlist,_,Some(str)) ->
-                      let purestr = asciiz(str) in
-                      let (dirname,handler) = 
-                        try Hashtbl.find wdmap wd with Not_found->printf "Unknown watch descriptor\n";raise Not_found
-                      in
-                        (
-                        match handler with
-                          | None->handle_dir_event dirname evlist purestr
-                          | Some(handler)->handler dirname evlist purestr
-                        )
-                  | _ -> ()) 
-          evs
+  let evs = Inotify.read fd in
+    List.iter (fun x->
+                 match x with
+                   | (wd,evlist,_,Some(str)) ->
+                       begin
+                               let purestr = asciiz(str) in
+                               let (dirname,handler) = 
+                                 try Hashtbl.find wdmap wd with Not_found->("",None)
+                               in
+                                   match handler with
+                                     | None->logprint "Unhandled watch descriptor\n"
+                                     | Some(handler)->
+                                         let fqp = String.concat "/" [dirname;purestr] in
+                                           logprint "Received event from %s\n" fqp;
+                                         let mask_filter = Hashtbl.mem masks fqp in
+                                           begin
+                                           if ((not mask_filter)) then
+                                             begin
+                                               (*
+                                                logprint "Received event for - %s\n"
+                                                        fqp;*)
+                                                handler wd dirname evlist
+                                                 purestr
+                                             end
+                                           else
+                                             begin
+                                                (*logprint "Unmasking %s\n"
+                                                 * fqp;*)
+                                                unmask_watch fqp
+                                             end
+                                           end
+                       end
+                   | _ -> ()) 
+      evs
 
 let initialize () =
   Fdwatcher.add_fd (None,fd) (None,fd) receive_event