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
   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
  12   mistreated *)
  13 type signed_fd = Infd of Unix.file_descr | Outfd of Unix.file_descr | Eventfd of Unix.file_descr
  14
  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
  17   with EPIPE *)
  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
  21
  22
  23 (** Receive an event from a running script. This event must be relayed to the
  24   slice that invoked it.
  25
  26   @param idesc fd/fname identifier for process
  27   *)
  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
  31       Not_found->
  32         fprintf logfd "Fifo fd disappeared\n";flush logfd;raise Bug
  33   in
  34     match (cp) with
  35       | Fifo(fifo_outchan) ->
  36           let process_inchan = in_channel_of_descr ifd in
  37           let cont = ref true in
  38             while (!cont) do
  39               try
  40                 let curline = input_line process_inchan in
  41                   fprintf fifo_outchan "%s\n" curline;flush fifo_outchan
  42               with
  43                 | End_of_file|Sys_blocked_io|Unix_error(EPIPE,_,_)|Unix_error(EBADF,_,_) ->
  44                     begin
  45                       cont:=false
  46                     end
  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
  50             done
  51       | _ -> fprintf logfd "Bug! Process fd received in the channel handler\n";flush logfd;raise Bug
  52
  53 let rec openentry_int fifoin fifoout (abspath:string*string) =
  54   let fdin =
  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
  57   in
  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 =
  61   close fdin;
  62     Fdwatcher.del_fd fdin;
  63     let abspath = try
  64       Hashtbl.find fdmap fdin with _ -> fprintf logfd "Bug: Phantom pipe\n";flush logfd;raise Bug
  65     in
  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
  71   *)
  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 *)
  77   let outfd =
  78     match (fname_other) with
  79       | Some(str)->
  80           (
  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
  83           )
  84       | None-> fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug
  85   in
  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
  89     | Not_found ->
  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
  98           in
  99             match rpid with
 100               | None-> BrokenPipe
 101               | Some(pid)->
 102                   (* Register fds associated with pid so that they can be cleaned up
 103                    * when it dies *)
 104                   Hashtbl.add pidmap pid [Infd(script_infd);Outfd(script_outfd);Eventfd(evfd)];
 105
 106                   (* Connect pipe to running script *)
 107                   Hashtbl.add open_fds evfd (Process(out_channel_of_descr script_outfd));
 108
 109                   (* Connect the running script to the pipe *)
 110                   Hashtbl.add open_fds script_infd (Fifo(out_channel_of_descr outfd));
 111
 112                   (* Activate running script *)
 113                   Fdwatcher.add_fd (None,script_infd) (None,script_infd) receive_process_event;
 114
 115                   (Process(out_channel_of_descr script_outfd))
 116   in
 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
 120     match (pipe) with
 121       | Process(out_channel) ->
 122           let cont = ref true in
 123             while (!cont) do
 124               try
 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
 128               with
 129                 |End_of_file->
 130                     (
 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
 135                         | Some(str1),None ->
 136                             fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug
 137                         | None,_ ->
 138                             fprintf logfd "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n";
 139                             flush logfd
 140                     );
 141                     cont:=false
 142                 |Sys_blocked_io ->fprintf logfd "Sysblockedio\n";flush logfd;
 143                                   cont:=false
 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
 146                  * logfd;raise Bug*)
 147             done;
 148             ignore(sigprocmask SIG_UNBLOCK [Sys.sigchld])
 149       | BrokenPipe -> ()
 150       | Fifo(_) -> fprintf logfd "BUG! received process event from fifo\n";raise Bug
 151
 152
 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 _ -> ());
 160     (try
 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
 170          );
 171          Success
 172      with
 173          e->fprintf logfd "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush logfd;Failed)
 174
 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
 180
 181 let sigchld_handle s =
 182   let pid,_=Unix.waitpid [Unix.WNOHANG] 0 in
 183     try
 184       let sfd_list = Hashtbl.find pidmap pid in
 185       let handle_sfd sfd =
 186         match sfd with
 187           | Infd(fd) ->
 188               close fd;
 189               Fdwatcher.del_fd fd
 190           | Outfd(fd)->
 191               close fd
 192           | Eventfd(fd)->
 193               Hashtbl.remove open_fds fd (* Disconnect pipe *)
 194       in
 195         List.iter handle_sfd sfd_list;
 196         Hashtbl.remove pidmap pid
 197     with
 198         Not_found-> (* Do nothing, probably a grandchild *)
 199           ()
 200
 201 let initialize () =
 202   Sys.set_signal Sys.sigchld (Sys.Signal_handle sigchld_handle)