bug fix
[vsys.git] / fdwatcher.ml
1 (** Fdwatcher - The main event loop. Agnostic to the type of file descriptors
2   involved.*)
3
4 open Printf
5 open Globals
6 open Printexc
7
8 let fdset = ref []
9 let cbtable = Hashtbl.create 1024
10
11 let add_fd (evpair:fname_and_fd) (fd_other:fname_and_fd) (callback:fname_and_fd->fname_and_fd->unit) = 
12   let (fname,fd) = evpair in
13     fdset := (fd::!fdset);
14     Hashtbl.replace cbtable fd (callback,(evpair,fd_other))
15
16 let del_fd fd =
17   fdset:=List.filter (fun l->l<>fd) !fdset;
18   flush logfd
19
20 let start_watch () =
21   while (true)
22   do
23     let (fds,_,_) = try Unix.select !fdset [] [] (-1.) 
24     with e->
25       ([],[],[])
26     in
27       List.iter (fun elt->
28                    let (func,(evd,fd_other)) = Hashtbl.find cbtable elt in
29                      try (* Never fail *)
30                        func evd fd_other
31                      with e->
32                        let wtf = Printexc.to_string e in
33                          logprint "%s\n" wtf
34                 ) fds
35   done