GUI putis.
[brdnet.git] / AsyncProcess.pas
blob811d449cd495e4141337bff9cbcfd9b34ed37c17
1 unit AsyncProcess;
2 INTERFACE
3 USES MemStream;
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;
18 IMPLEMENTATION
19 USES ServerLoop
20 ,Sockets
21 ,NetAddr
22 ,BaseUnix
23 ,SysUtils
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;
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;
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;
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;
97 END.