1 (** fifowatcher.ml: Routines for creating and managing fifos *)
9 (** A connected process, FIFO *)
10 type channel_pipe = Process of out_channel | Fifo of out_channel | BrokenPipe
11 (** Signed file descriptors. Usually, we'll make sure that they're not
13 type signed_fd = Infd of Unix.file_descr | Outfd of Unix.file_descr | Eventfd of Unix.file_descr
15 let fdmap: (Unix.file_descr,string*string) Hashtbl.t = Hashtbl.create 1024
16 (** Maps pids to slice connections. Needed to clean up fds when a script dies
18 let pidmap: (int,signed_fd list) Hashtbl.t = Hashtbl.create 1024
19 let backend_prefix = ref ""
20 let open_fds: (Unix.file_descr,channel_pipe) Hashtbl.t = Hashtbl.create 1024
23 (** Receive an event from a running script. This event must be relayed to the
24 slice that invoked it.
26 @param idesc fd/fname identifier for process
28 let receive_process_event (idesc: fname_and_fd) (_: fname_and_fd) =
29 let (_,ifd) = idesc in
30 let cp = try Hashtbl.find open_fds ifd with
32 fprintf logfd "Fifo fd disappeared\n";flush logfd;raise Bug
35 | Fifo(fifo_outchan) ->
36 let process_inchan = in_channel_of_descr ifd in
37 let cont = ref true in
40 let curline = input_line process_inchan in
41 fprintf fifo_outchan "%s\n" curline;flush fifo_outchan
43 | End_of_file|Sys_blocked_io|Unix_error(EPIPE,_,_)|Unix_error(EBADF,_,_) ->
47 | Unix_error(_,s1,s2) -> fprintf logfd "Unix error %s - %s\n" s1 s2;flush logfd;cont:=false
48 | Sys_error(s) -> (* We get this error if the EPIPE comes before the EOF marker*) cont:=false
49 | e -> fprintf logfd "Error - received unexpected event from file system !!!\n";raise e
51 | _ -> fprintf logfd "Bug! Process fd received in the channel handler\n";flush logfd;raise Bug
53 let rec openentry_int fifoin fifoout (abspath:string*string) =
55 try openfile fifoin [O_RDONLY;O_NONBLOCK] 0o777 with
56 e->fprintf logfd "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;flush logfd;raise e
58 Hashtbl.replace fdmap fdin abspath;
59 Fdwatcher.add_fd (Some(fifoin),fdin) (Some(fifoout),stdout) receive_fifo_event
60 and reopenentry_int fdin fifoin fifoout =
62 Fdwatcher.del_fd fdin;
64 Hashtbl.find fdmap fdin with _ -> fprintf logfd "Bug: Phantom pipe\n";flush logfd;raise Bug
66 openentry_int fifoin fifoout abspath
67 (** receive an event from a fifo and connect to the corresponding service, or to
68 create it if it doesn't exit
69 @param eventdescriptor Name of input pipe,in descriptor
70 @param outdescriptor Name of output pipe, out descriptor
72 and receive_fifo_event eventdescriptor outdescriptor =
73 printf "received fifo event\n";flush Pervasives.stdout;
74 let (evfname,evfd) = eventdescriptor in
75 let (fname_other,fd_other) = outdescriptor in
76 (* Open the output pipe, or use stdout instead *)
78 match (fname_other) with
81 try openfile str [O_WRONLY;O_NONBLOCK] 0o777 with
82 _->fprintf logfd "Output pipe not open, using stdout in place of %s\n" str;flush logfd;stdout
84 | None-> fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug
86 (* Check if the input descriptor is already registered (=> a session is open).
87 If not, register it and start a new session.*)
88 let pipe = try Hashtbl.find open_fds evfd with
90 printf "fd not found!\n";flush Pervasives.stdout;
91 (* Ok, need to launch script *)
92 let execpath,slice_name = Hashtbl.find fdmap evfd in
93 let (script_infd,pout) = Unix.pipe () in
94 let (pin,script_outfd) = Unix.pipe () in
95 set_nonblock script_infd;
96 ignore(sigprocmask SIG_BLOCK [Sys.sigchld]);
97 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
102 (* Register fds associated with pid so that they can be cleaned up
104 Hashtbl.add pidmap pid [Infd(script_infd);Outfd(script_outfd);Eventfd(evfd)];
106 (* Connect pipe to running script *)
107 Hashtbl.add open_fds evfd (Process(out_channel_of_descr script_outfd));
109 (* Connect the running script to the pipe *)
110 Hashtbl.add open_fds script_infd (Fifo(out_channel_of_descr outfd));
112 (* Activate running script *)
113 Fdwatcher.add_fd (None,script_infd) (None,script_infd) receive_process_event;
115 (Process(out_channel_of_descr script_outfd))
117 (* We have the connection to the process - because it was open, or because it
118 just got established *)
119 let inchan_fd = in_channel_of_descr evfd in
121 | Process(out_channel) ->
122 let cont = ref true in
125 fprintf logfd "Reading...\n";flush logfd;
126 let curline = input_line inchan_fd in
127 fprintf out_channel "%s\n" curline;flush out_channel
131 match (evfname,fname_other) with
132 | Some(str1),Some(str2)->
133 fprintf logfd "Reopening entry\n";flush logfd;
134 reopenentry_int evfd str1 str2
136 fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug
138 fprintf logfd "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n";
142 |Sys_blocked_io ->fprintf logfd "Sysblockedio\n";flush logfd;
144 | Unix_error(_,s1,s2) -> fprintf logfd "Unix error %s - %s\n" s1 s2;flush logfd;cont:=false
145 (*| _ ->fprintf logfd "Bug: unhandled exception\n";flush
148 ignore(sigprocmask SIG_UNBLOCK [Sys.sigchld])
150 | Fifo(_) -> fprintf logfd "BUG! received process event from fifo\n";raise Bug
153 (** Make a pair of fifo entries *)
154 let mkentry fqp abspath perm uname =
155 fprintf logfd "Making entry %s->%s\n" fqp abspath;flush logfd;
156 let fifoin=sprintf "%s.in" fqp in
157 let fifoout=sprintf "%s.out" fqp in
158 (try Unix.unlink fifoin with _ -> ());
159 (try Unix.unlink fifoout with _ -> ());
161 let infname =(sprintf "%s.in" fqp) in
162 let outfname =(sprintf "%s.out" fqp) in
163 Unix.mkfifo infname 0o666;
164 Unix.mkfifo outfname 0o666;
165 ( (* Make the user the owner of the pipes in a non-chroot environment *)
166 if (!Globals.nochroot) then
167 let pwentry = Unix.getpwnam uname in
168 Unix.chown infname pwentry.pw_uid pwentry.pw_gid;
169 Unix.chown outfname pwentry.pw_uid pwentry.pw_gid
173 e->fprintf logfd "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush logfd;Failed)
175 (** Open fifos for a session. Will shutdown vsys if the fifos don't exist *)
176 let openentry fqp abspath perm =
177 let fifoin = String.concat "." [fqp;"in"] in
178 let fifoout = String.concat "." [fqp;"out"] in
179 openentry_int fifoin fifoout abspath
181 let sigchld_handle s =
182 let pid,_=Unix.waitpid [Unix.WNOHANG] 0 in
184 let sfd_list = Hashtbl.find pidmap pid in
193 Hashtbl.remove open_fds fd (* Disconnect pipe *)
195 List.iter handle_sfd sfd_list;
196 Hashtbl.remove pidmap pid
198 Not_found-> (* Do nothing, probably a grandchild *)
202 Sys.set_signal Sys.sigchld (Sys.Signal_handle sigchld_handle)