X-Git-Url: http://git.onelab.eu/?a=blobdiff_plain;f=dirwatcher.ml;h=667eba7f2f740417ac97cd55e1c07522a64ba57d;hb=542f2c4d52a5a1113ba9017cb0ee70304393fac4;hp=918a06a352e2c0f72c70d43db4eec7d07b5b297e;hpb=1a489047481c761be639e342c38326aeaca600f9;p=vsys.git diff --git a/dirwatcher.ml b/dirwatcher.ml index 918a06a..667eba7 100644 --- a/dirwatcher.ml +++ b/dirwatcher.ml @@ -28,27 +28,25 @@ let handle_dir_event dirname evlist str = let add_watch dir events handler = let evcheck = list_check events in - let oneshot = if (evcheck S_Oneshot) then true else false - in let wd = Inotify.add_watch fd dir events in - Hashtbl.add masks dir (wd,handler); - Hashtbl.add wdmap wd (dir,Some(handler),oneshot) + 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 dir = +let mask_watch fqp = try - let wd,_ = Hashtbl.find masks dir in - Inotify.rm_watch fd wd; - Hashtbl.remove wdmap wd + Hashtbl.replace masks fqp true with _ -> () -let unmask_watch dir events = - let _,handler = Hashtbl.find masks dir in - try - Hashtbl.remove masks dir; - add_watch dir events handler - with Not_found -> () - +let unmask_watch fqp = + if (Hashtbl.mem masks fqp) then + begin + Hashtbl.remove masks fqp + end + else + fprintf logfd "WARNING: %s -- Unpaired unmask\n" fqp;flush logfd + let asciiz s = let rec findfirstnul str idx len = if ((idx==len) || @@ -65,18 +63,21 @@ let receive_event (eventdescriptor:fname_and_fd) (bla:fname_and_fd) = List.iter (fun x-> match x with | (wd,evlist,_,Some(str)) -> - let purestr = asciiz(str) in - let (dirname,handler,oneshot) = - try Hashtbl.find wdmap wd with Not_found->("",None,false) - in - List.iter (fun l->printf "%s " (string_of_event l)) evlist; - printf "\n";flush Pervasives.stdout; - if (oneshot) then Hashtbl.remove wdmap wd; - ( - match handler with - | None->fprintf logfd "Unhandled watch descriptor\n";flush logfd - | Some(handler)->handler wd dirname evlist purestr - ) + begin + let purestr = asciiz(str) in + let (dirname,handler) = + try Hashtbl.find wdmap wd with Not_found->("",None) + in + match handler with + | None->fprintf logfd "Unhandled watch descriptor\n";flush logfd + | Some(handler)-> + let fqp = String.concat "/" [dirname;purestr] in + let mask_filter = Hashtbl.mem masks fqp in + if (not mask_filter) then + begin + handler wd dirname evlist purestr + end + end | _ -> ()) evs