AsyncProcess.pas

   1 unit AsyncProcess;
   2 INTERFACE
   3 USES MemStream;
   4
   5 type tapx=object
   6  pid:SizeUInt;
   7  output: ^tMemoryStream;
   8  exitcode:Integer;
   9  exitsignal:Word;
  10  event: procedure of object; {notification on statuc change}
  11  procedure Init(const args:ppchar; var ioutput:tMemoryStream);
  12  procedure Kill;
  13  private
  14  opipe:tHandle;
  15  procedure PipeEvent(ev:word);
  16  end;
  17
  18 IMPLEMENTATION
  19 USES ServerLoop
  20     ,Sockets
  21     ,NetAddr
  22     ,BaseUnix
  23     ,SysUtils
  24     ;
  25
  26 procedure IOCHECK(prfx: string);
  27  var e:eOSError;
  28  begin
  29  e:=eOSError.CreateFmt('%S %U',[prfx,fpGetErrno]);
  30  e.ErrorCode:=fpGetErrno;
  31  raise e;
  32 end;
  33
  34 procedure tapx.PipeEvent(ev:word);
  35  var rl:longint;
  36  var ecode:LongInt;
  37  begin
  38  if (ev and POLLIN)>0 then begin
  39   if output^.WRBufLen=0 then begin
  40    fpKill(pid,SIGPIPE); {no space left for output, kill}
  41   end else begin
  42   rl:=fpRead(opipe,output^.WRBuf,output^.wrbuflen);
  43   if rl=-1 then IOCHECK('read from pipe');
  44   output^.wrend(rl);
  45   //writeln('pipeRead ',rl,' ev=',inttohex(ev,4));
  46   end;
  47  end;
  48  if (ev and POLLHUP)>0 then begin
  49   {the pipe was broken}
  50   ServerLoop.WatchFD(opipe,nil);
  51   fpClose(opipe);
  52   fpWaitPid(pid,ecode,0); {wait to terminate and remove zombie}
  53   {this could block it child closed stdout but did not terminate}
  54   pid:=0;
  55   if wifexited(ecode) then exitcode:=wexitstatus(ecode);
  56   if wifsignaled(ecode) then exitsignal:=wtermsig(ecode);
  57   if assigned(event) then event;
  58  end;
  59 end;
  60
  61 procedure tapx.Init(const args:ppchar; var ioutput:tMemoryStream);
  62  var spid:tPID;
  63  var pipes:tFilDes;
  64  begin
  65  output:=@ioutput;
  66  exitcode:=-1;
  67  exitsignal:=0;
  68  pid:=0;
  69  if fpPipe(pipes)=-1 then IOCHECK('pipe()');
  70  spid:=fpFork;
  71  if spid<0 then IOCHECK('fork()');
  72  if spid>0 then begin
  73   pid:=spid;
  74   Opipe:=pipes[0];  {save reading end}
  75   fpClose(pipes[1]); {close input of pipe}
  76   ServerLoop.WatchFD(opipe,@PipeEvent);
  77  end else begin
  78   fpDup2(pipes[1],1); {stdout:=pipeinput}
  79   fpClose(0); {stdin:=nil}
  80   fpClose(pipes[0]);
  81   fpClose(pipes[1]);
  82   fpExecv(args[0],args);
  83   halt(127); {this is another process, cannot really raise here if exec fails}
  84  end;
  85 end;
  86
  87 procedure tAPX.Kill;
  88  var ecode:LongInt;
  89  begin
  90  ServerLoop.WatchFD(opipe,nil);
  91  fpClose(opipe);
  92  fpKill(pid,SIGTERM);
  93  fpWaitPid(pid,ecode,0);
  94  pid:=0;
  95 end;
  96
  97 END.