X-Git-Url: http://git.onelab.eu/?a=blobdiff_plain;f=fifowatcher.ml;h=58113a138ce3ec35e2eab0f81ba551f12cc042bc;hb=755411474ed0a694766fc6f3a916afaee1da7ebd;hp=061d86bee08797c929e0b2616aa860c53cd31635;hpb=e8c4b9ece4508acb51bf6184f04e66a6a97324d4;p=vsys.git diff --git a/fifowatcher.ml b/fifowatcher.ml index 061d86b..58113a1 100644 --- a/fifowatcher.ml +++ b/fifowatcher.ml @@ -22,7 +22,6 @@ let pidmap: (int,signed_fd list) Hashtbl.t = Hashtbl.create 1024 let backend_prefix = ref "" let open_fds: (Unix.file_descr,channel_pipe) Hashtbl.t = Hashtbl.create 1024 - (** Receive an event from a running script. This event must be relayed to the slice that invoked it. @@ -32,25 +31,31 @@ 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-> - fprintf logfd "Fifo fd disappeared\n";flush logfd;raise Bug + logprint "Fifo fd disappeared\n";raise Bug in match (cp) with | Fifo(fifo_outfd) -> begin - try - printf "Received process event\n";flush Pervasives.stdout; - let tr0,tr1 = Unix.pipe () in - ignore(splice ifd tr1 4096); - ignore(splice tr0 fifo_outfd 4096) - with - Failure(s)->fprintf logfd "Transfer failure: %s\n" s;flush logfd + try + printf "Received process event\n";flush Pervasives.stdout; + (* transferred = 4096 => there were at least 4096 bytes in the + * stream, so we should try again. + * transferred < 4096 => EAGAIN => either this is all the data we + * have (move on) + * OR XXX the receiver is blocking (supposedly this can't happen) *) + let transferred = ref 4096 in + while (!transferred == 4096) do + transferred:=tee ifd fifo_outfd 4096 + done; + with + Failure(s)->logprint "Transfer failure: %s\n" s end - | _ -> fprintf logfd "Bug! Process fd received in the channel handler\n";flush logfd;raise Bug + | _ -> logprint "Bug! Process fd received in the channel handler\n";raise Bug let rec openentry_int fifoin fifoout (abspath:string*string) = let fdin = try openfile fifoin [O_RDONLY;O_NONBLOCK] 0o777 with - e->fprintf logfd "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;flush logfd;raise e + e->logprint "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;raise e in Hashtbl.replace fdmap fdin abspath; Fdwatcher.add_fd (Some(fifoin),fdin) (Some(fifoout),stdout) receive_fifo_event @@ -58,7 +63,7 @@ and reopenentry_int fdin fifoin fifoout = close fdin; Fdwatcher.del_fd fdin; let abspath = try - Hashtbl.find fdmap fdin with _ -> fprintf logfd "Bug: Phantom pipe\n";flush logfd;raise Bug + Hashtbl.find fdmap fdin with _ -> logprint "Bug: Phantom pipe\n";raise Bug in openentry_int fifoin fifoout abspath @@ -76,9 +81,9 @@ and receive_fifo_event eventdescriptor outdescriptor = | Some(str)-> ( try openfile str [O_WRONLY;O_NONBLOCK] 0o777 with - _->fprintf logfd "Output pipe not open, using stdout in place of %s\n" str;flush logfd;stdout + _->logprint "Output pipe not open, using stdout in place of %s\n" str;stdout ) - | None-> fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug + | None-> logprint "Bug, nameless pipe\n";raise Bug in (* Check if the input descriptor is already registered (=> a session is open). If not, register it and start a new session.*) @@ -90,7 +95,7 @@ and receive_fifo_event eventdescriptor outdescriptor = let (pin,script_outfd) = Unix.pipe () in set_nonblock script_infd; ignore(sigprocmask SIG_BLOCK [Sys.sigchld]); - 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 + let rpid = try Some(create_process execpath [|execpath;slice_name|] pin pout pout) with e -> logprint "Error executing service: %s\n" execpath;None in match rpid with | None-> BrokenPipe @@ -110,30 +115,34 @@ and receive_fifo_event eventdescriptor outdescriptor = (Process(script_outfd)) in - (* We have the connection to the process - because it was open, or because it - just got established *) + (* We have the connection to the process - because it was open, or because it + just got established *) match (pipe) with | Process(fifo_outfd) -> begin - try - printf "Received fifo event\n";flush Pervasives.stdout; - let tr0,tr1 = Unix.pipe() in - ignore(splice evfd tr1 4096); - ignore(splice tr0 fifo_outfd 4096) - with Failure(str) -> - begin - fprintf logfd "Error connecting user to service: %s\n" str; - flush logfd - end; - ignore(sigprocmask SIG_UNBLOCK [Sys.sigchld]) + try + let transferred = ref 4096 in + while (!transferred == 4096) do + begin + transferred:=tee evfd fifo_outfd 4096; + printf "Transferred: %d\n" !transferred;flush Pervasives.stdout + end + done; + with Failure(str) -> + begin + logprint "Error connecting user to service: %s\n" str + end; + ignore(sigprocmask SIG_UNBLOCK [Sys.sigchld]); + printf "Out of the loop\n";flush Pervasives.stdout + end | BrokenPipe -> () - | Fifo(_) -> fprintf logfd "BUG! received process event from fifo\n";raise Bug + | Fifo(_) -> logprint "BUG! received process event from fifo\n";raise Bug (** Make a pair of fifo entries *) let mkentry fqp abspath perm uname = - fprintf logfd "Making entry %s->%s\n" fqp abspath;flush logfd; + logprint "Making entry %s->%s\n" fqp abspath; let fifoin=sprintf "%s.in" fqp in let fifoout=sprintf "%s.out" fqp in (try Unix.unlink fifoin with _ -> ()); @@ -144,14 +153,14 @@ let mkentry fqp abspath perm uname = Unix.mkfifo infname 0o666; Unix.mkfifo outfname 0o666; ( (* Make the user the owner of the pipes in a non-chroot environment *) - if (!Globals.nochroot) then - let pwentry = Unix.getpwnam uname in - Unix.chown infname pwentry.pw_uid pwentry.pw_gid; - Unix.chown outfname pwentry.pw_uid pwentry.pw_gid + if (!Globals.nochroot) then + let pwentry = Unix.getpwnam uname in + Unix.chown infname pwentry.pw_uid pwentry.pw_gid; + Unix.chown outfname pwentry.pw_uid pwentry.pw_gid ); Success with - e->fprintf logfd "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush logfd;Failed) + e->logprint "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;Failed) (** Open fifos for a session. Will shutdown vsys if the fifos don't exist *) let openentry fqp abspath perm =