fifowatcher.ml

   1 (** fifowatcher.ml: Routines for creating and managing fifos *)
   2
   3 open Inotify
   4 open Unix
   5 open Globals
   6 open Dirwatcher
   7 open Printf
   8 open Splice
   9
  10 (** A connected process, FIFO *)
  11 type channel_pipe = Process of Unix.file_descr | Fifo of Unix.file_descr | BrokenPipe
  12
  13 (** Signed file descriptors. *)
  14 type signed_fd = Infd of Unix.file_descr | Outfd of Unix.file_descr | Eventfd of Unix.file_descr
  15
  16 (** XXX This will get deprecated when we switch to inotify *)
  17 let fdmap: (Unix.file_descr,string*string) Hashtbl.t = Hashtbl.create 1024
  18
  19 (** Maps pids to slice connections. Needed to clean up fds when a script dies
  20   with EPIPE *)
  21 let pidmap: (int,signed_fd list) Hashtbl.t = Hashtbl.create 1024
  22 let backend_prefix = ref ""
  23 let open_fds: (Unix.file_descr,channel_pipe) Hashtbl.t = Hashtbl.create 1024
  24
  25
  26 (** Receive an event from a running script. This event must be relayed to the
  27   slice that invoked it.
  28
  29   @param idesc fd/fname identifier for process
  30   *)
  31 let receive_process_event (idesc: fname_and_fd) (_: fname_and_fd) =
  32   let (_,ifd) = idesc in
  33   let cp = try Hashtbl.find open_fds ifd with
  34       Not_found->
  35         fprintf logfd "Fifo fd disappeared\n";flush logfd;raise Bug
  36   in
  37     match (cp) with
  38       | Fifo(fifo_outfd) ->
  39           begin
  40           try
  41             printf "Received process event\n";flush Pervasives.stdout;
  42             let tr0,tr1 = Unix.pipe () in
  43                 ignore(splice ifd tr1 4096);
  44                 ignore(splice tr0 fifo_outfd 4096)
  45           with
  46               Failure(s)->fprintf logfd "Transfer failure: %s\n" s;flush logfd
  47           end
  48       | _ -> fprintf logfd "Bug! Process fd received in the channel handler\n";flush logfd;raise Bug
  49
  50 let rec openentry_int fifoin fifoout (abspath:string*string) =
  51   let fdin =
  52     try openfile fifoin [O_RDONLY;O_NONBLOCK] 0o777 with
  53         e->fprintf logfd "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;flush logfd;raise e
  54   in
  55     Hashtbl.replace fdmap fdin abspath;
  56     Fdwatcher.add_fd (Some(fifoin),fdin) (Some(fifoout),stdout) receive_fifo_event
  57 and reopenentry_int fdin fifoin fifoout =
  58   close fdin;
  59     Fdwatcher.del_fd fdin;
  60     let abspath = try
  61       Hashtbl.find fdmap fdin with _ -> fprintf logfd "Bug: Phantom pipe\n";flush logfd;raise Bug
  62     in
  63       openentry_int fifoin fifoout abspath
  64
  65 (** receive an event from a fifo and connect to the corresponding service, or to
  66   create it if it doesn't exit
  67   @param eventdescriptor Name of input pipe,in descriptor
  68   @param outdescriptor Name of output pipe, out descriptor
  69   *)
  70 and receive_fifo_event eventdescriptor outdescriptor =
  71   let (evfname,evfd) = eventdescriptor in
  72   let (fname_other,fd_other) = outdescriptor in
  73   (* Open the output pipe, or use stdout instead *)
  74   let outfd =
  75     match (fname_other) with
  76       | Some(str)->
  77           (
  78             try openfile str [O_WRONLY;O_NONBLOCK] 0o777 with
  79                 _->fprintf logfd "Output pipe not open, using stdout in place of %s\n" str;flush logfd;stdout
  80           )
  81       | None-> fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug
  82   in
  83   (* Check if the input descriptor is already registered (=> a session is open).
  84    If not, register it and start a new session.*)
  85   let pipe = try Hashtbl.find open_fds evfd with
  86     | Not_found ->
  87         (* Ok, need to launch script *)
  88         let execpath,slice_name = Hashtbl.find fdmap evfd in
  89         let (script_infd,pout) = Unix.pipe () in
  90         let (pin,script_outfd) = Unix.pipe () in
  91           set_nonblock script_infd;
  92           ignore(sigprocmask SIG_BLOCK [Sys.sigchld]);
  93           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
  94           in
  95             match rpid with
  96               | None-> BrokenPipe
  97               | Some(pid)->
  98                   (* Register fds associated with pid so that they can be cleaned up
  99                    * when it dies *)
 100                   Hashtbl.add pidmap pid [Infd(script_infd);Outfd(script_outfd);Eventfd(evfd)];
 101
 102                   (* Connect pipe to running script *)
 103                   Hashtbl.add open_fds evfd (Process(script_outfd));
 104
 105                   (* Connect the running script to the pipe *)
 106                   Hashtbl.add open_fds script_infd (Fifo(outfd));
 107
 108                   (* Activate running script *)
 109                   Fdwatcher.add_fd (None,script_infd) (None,script_infd) receive_process_event;
 110
 111                   (Process(script_outfd))
 112   in
 113   (* We have the connection to the process - because it was open, or because it
 114    just got established *)
 115     match (pipe) with
 116       | Process(fifo_outfd) ->
 117           begin
 118           try
 119             printf "Received fifo event\n";flush Pervasives.stdout;
 120             let tr0,tr1 = Unix.pipe() in
 121           ignore(splice evfd tr1 4096);
 122           ignore(splice tr0 fifo_outfd 4096)
 123           with Failure(str) ->
 124             begin
 125             fprintf logfd "Error connecting user to service: %s\n" str;
 126             flush logfd
 127             end;
 128             ignore(sigprocmask SIG_UNBLOCK [Sys.sigchld])
 129           end
 130       | BrokenPipe -> ()
 131       | Fifo(_) -> fprintf logfd "BUG! received process event from fifo\n";raise Bug
 132
 133
 134 (** Make a pair of fifo entries *)
 135 let mkentry fqp abspath perm uname =
 136   fprintf logfd "Making entry %s->%s\n" fqp abspath;flush logfd;
 137   let fifoin=sprintf "%s.in" fqp in
 138   let fifoout=sprintf "%s.out" fqp in
 139     (try Unix.unlink fifoin with _ -> ());
 140     (try Unix.unlink fifoout with _ -> ());
 141     (try
 142        let infname =(sprintf "%s.in" fqp) in
 143        let outfname =(sprintf "%s.out" fqp) in
 144          Unix.mkfifo infname 0o666;
 145          Unix.mkfifo outfname 0o666;
 146          ( (* Make the user the owner of the pipes in a non-chroot environment *)
 147          if (!Globals.nochroot) then
 148            let pwentry = Unix.getpwnam uname in
 149              Unix.chown infname pwentry.pw_uid pwentry.pw_gid;
 150              Unix.chown outfname pwentry.pw_uid pwentry.pw_gid
 151          );
 152          Success
 153      with
 154          e->fprintf logfd "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush logfd;Failed)
 155
 156 (** Open fifos for a session. Will shutdown vsys if the fifos don't exist *)
 157 let openentry fqp abspath perm =
 158   let fifoin = String.concat "." [fqp;"in"] in
 159   let fifoout = String.concat "." [fqp;"out"] in
 160     openentry_int fifoin fifoout abspath
 161
 162 let sigchld_handle s =
 163   let pid,_=Unix.waitpid [Unix.WNOHANG] 0 in
 164     try
 165       let sfd_list = Hashtbl.find pidmap pid in
 166       let handle_sfd sfd =
 167         match sfd with
 168           | Infd(fd) ->
 169               close fd;
 170               Fdwatcher.del_fd fd
 171           | Outfd(fd)->
 172               close fd
 173           | Eventfd(fd)->
 174               Hashtbl.remove open_fds fd (* Disconnect pipe *)
 175       in
 176         List.iter handle_sfd sfd_list;
 177         Hashtbl.remove pidmap pid
 178     with
 179         Not_found-> (* Do nothing, probably a grandchild *)
 180           ()
 181
 182 let initialize () =
 183   Sys.set_signal Sys.sigchld (Sys.Signal_handle sigchld_handle)