X-Git-Url: http://git.onelab.eu/?a=blobdiff_plain;f=fifowatcher.ml;h=9b42a51f64460e414b8f745d39a04186a650cd45;hb=87c0dc3957634fe643267904d0cedfed80a03f68;hp=dc79dad106f7da66f11bec29a23695460b80b3c7;hpb=8e8e13b87b5d592621be0a15a19b5ea0a1fad0b5;p=vsys.git diff --git a/fifowatcher.ml b/fifowatcher.ml index dc79dad..9b42a51 100644 --- a/fifowatcher.ml +++ b/fifowatcher.ml @@ -29,7 +29,7 @@ let receive_process_event (idesc: fname_and_fd) (_: fname_and_fd) = let (_,ifd) = idesc in let cp = try Hashtbl.find open_fds ifd with Not_found-> - printf "Fifo fd disappeared\n";flush Pervasives.stdout;raise Bug + fprintf logfd "Fifo fd disappeared\n";flush logfd;raise Bug in match (cp) with | Fifo(fifo_outchan) -> @@ -44,17 +44,17 @@ let receive_process_event (idesc: fname_and_fd) (_: fname_and_fd) = begin cont:=false end - | Unix_error(_,s1,s2) -> printf "Unix error %s - %s\n" s1 s2;flush Pervasives.stdout;cont:=false + | Unix_error(_,s1,s2) -> fprintf logfd "Unix error %s - %s\n" s1 s2;flush logfd;cont:=false | Sys_error(s) -> (* We get this error if the EPIPE comes before the EOF marker*) cont:=false - | e -> printf "Error - received unexpected event from file system !!!\n";raise e + | e -> fprintf logfd "Error - received unexpected event from file system !!!\n";raise e done - | _ -> printf "Bug! Process fd received in the channel handler\n";flush Pervasives.stdout;raise Bug + | _ -> fprintf logfd "Bug! Process fd received in the channel handler\n";flush logfd;raise Bug let rec openentry_int fifoin fifoout (abspath:string*string) = let fdin = try openfile fifoin [O_RDONLY;O_NONBLOCK] 0o777 with - e->printf "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;flush Pervasives.stdout;raise e + e->fprintf logfd "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;flush logfd;raise e in Hashtbl.replace fdmap fdin abspath; Fdwatcher.add_fd (Some(fifoin),fdin) (Some(fifoout),stdout) receive_fifo_event @@ -62,7 +62,7 @@ and reopenentry_int fdin fifoin fifoout = close fdin; Fdwatcher.del_fd fdin; let abspath = try - Hashtbl.find fdmap fdin with _ -> printf "Bug: Phantom pipe\n";flush Pervasives.stdout;raise Bug + Hashtbl.find fdmap fdin with _ -> fprintf logfd "Bug: Phantom pipe\n";flush logfd;raise Bug in openentry_int fifoin fifoout abspath (** receive an event from a fifo and connect to the corresponding service, or to @@ -79,9 +79,9 @@ and receive_fifo_event eventdescriptor outdescriptor = | Some(str)-> ( try openfile str [O_WRONLY;O_NONBLOCK] 0o777 with - _->printf "Output pipe not open, using stdout in place of %s\n" str;flush Pervasives.stdout;stdout + _->fprintf logfd "Output pipe not open, using stdout in place of %s\n" str;flush logfd;stdout ) - | None-> printf "Bug, nameless pipe\n";flush Pervasives.stdout;raise Bug + | None-> fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug in (* Check if the input descriptor is already registered (=> a session is open). If not, register it and start a new session.*) @@ -92,7 +92,7 @@ and receive_fifo_event eventdescriptor outdescriptor = let (script_infd,pout) = Unix.pipe () in let (pin,script_outfd) = Unix.pipe () in set_nonblock script_infd; - let rpid = try Some(create_process execpath [|execpath;slice_name|] pin pout pout) with e -> printf "Error executing service: %s\n" execpath;flush Pervasives.stdout;None + let rpid = try Some(create_process execpath [|execpath;slice_name|] pin pout pout) with e -> fprintf logfd "Error executing service: %s\n" execpath;flush logfd;None in match rpid with | None-> BrokenPipe @@ -120,7 +120,7 @@ and receive_fifo_event eventdescriptor outdescriptor = let cont = ref true in while (!cont) do try - printf "Reading...\n";flush Pervasives.stdout; + fprintf logfd "Reading...\n";flush logfd; let curline = input_line inchan_fd in fprintf out_channel "%s\n" curline;flush out_channel with @@ -128,26 +128,26 @@ and receive_fifo_event eventdescriptor outdescriptor = ( match (evfname,fname_other) with | Some(str1),Some(str2)-> - printf "Reopening entry\n";flush Pervasives.stdout; + fprintf logfd "Reopening entry\n";flush logfd; reopenentry_int evfd str1 str2 | Some(str1),None -> - printf "Bug, nameless pipe\n";flush Pervasives.stdout;raise Bug + fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug | None,_ -> - printf "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n"; - flush Pervasives.stdout + fprintf logfd "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n"; + flush logfd ); cont:=false - |Sys_blocked_io ->printf "Sysblockedio\n";flush Pervasives.stdout; + |Sys_blocked_io ->fprintf logfd "Sysblockedio\n";flush logfd; cont:=false - | _ ->printf "Bug: unhandled exception\n";flush Pervasives.stdout;raise Bug + | _ ->fprintf logfd "Bug: unhandled exception\n";flush logfd;raise Bug done | BrokenPipe -> () - | Fifo(_) -> printf "BUG! received process event from fifo\n";raise Bug + | Fifo(_) -> fprintf logfd "BUG! received process event from fifo\n";raise Bug (** Make a pair of fifo entries *) let mkentry fqp abspath perm uname = - printf "Making entry %s->%s\n" fqp abspath;flush Pervasives.stdout; + fprintf logfd "Making entry %s->%s\n" fqp abspath;flush logfd; let fifoin=sprintf "%s.in" fqp in let fifoout=sprintf "%s.out" fqp in (try Unix.unlink fifoin with _ -> ()); @@ -165,7 +165,7 @@ let mkentry fqp abspath perm uname = ); Success with - e->printf "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush Pervasives.stdout;Failed) + e->fprintf logfd "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush logfd;Failed) (** Open fifos for a session. Will shutdown vsys if the fifos don't exist *) let openentry fqp abspath perm =