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.
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
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
| 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.*)
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
(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 _ -> ());
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 =
git://git.onelab.eu / vsys.git / blobdiff