{ Unix Process .inc. } uses {$ifdef ver1_0} Linux; {$else} Unix, Baseunix; {$endif} Const PriorityConstants : Array [TProcessPriority] of Integer = (20,20,0,-20); Const GeometryOption : String = '-geometry'; TitleOption : String ='-title'; {$ifdef ver1_0} // Compatibility functions. // Change to function, check results.. procedure fpDup2(H1,H2 : Longint); begin dup2(H1,H2) end; function fpFork : Longint; begin end; function fpGetEnv(S : String) : PChar; begin Result:=GetEnv(S : String); end; Procedure fpExecve(S : PChar; A,E : PPChar); begin ExecVE(S,A,E); end; Procedure fpExecv(S : PChar; A : PPChar); begin ExecVE(S,A); end; Function fpWaitPID(H: Longint; P : Pointer; Opts : Longint) : Integer; begin Result:=WaitPID(Handle,@FExitCode,Opts); end; Function fpKill(PID,SIG : Longint) : Longint; begin Result:=kill(Handle,SIGTERM)=0; end; {$endif} procedure TProcess.CloseProcessHandles; begin // Do nothing. Win32 call. end; Function TProcess.PeekExitStatus : Boolean; begin Result:=fpWaitPid(Handle,@FExitCode,WNOHANG)=Handle; If Result then FExitCode:=wexitstatus(FExitCode) else FexitCode:=0; end; Type TPCharArray = Array[Word] of pchar; PPCharArray = ^TPcharArray; Function StringsToPCharList(List : TStrings) : PPChar; Var I : Integer; S : String; begin I:=(List.Count)+1; GetMem(Result,I*sizeOf(PChar)); PPCharArray(Result)^[List.Count]:=Nil; For I:=0 to List.Count-1 do begin S:=List[i]; Result[i]:=StrNew(PChar(S)); end; end; Procedure FreePCharList(List : PPChar); Var I : integer; begin I:=0; While List[i]<>Nil do begin StrDispose(List[i]); Inc(I); end; FreeMem(List); end; Procedure CommandToList(S : String; List : TStrings); Function GetNextWord : String; Const WhiteSpace = [' ',#8,#10]; Literals = ['"','''']; Var Wstart,wend : Integer; InLiteral : Boolean; LastLiteral : char; begin WStart:=1; While (WStart<=Length(S)) and (S[WStart] in WhiteSpace) do Inc(WStart); WEnd:=WStart; InLiteral:=False; LastLiteral:=#0; While (Wend<=Length(S)) and (Not (S[Wend] in WhiteSpace) or InLiteral) do begin if S[Wend] in Literals then If InLiteral then InLiteral:=Not (S[Wend]=LastLiteral) else begin InLiteral:=True; LastLiteral:=S[Wend]; end; inc(wend); end; Result:=Copy(S,WStart,WEnd-WStart); Result:=StringReplace(Result,'"','',[rfReplaceAll]); Result:=StringReplace(Result,'''','',[rfReplaceAll]); While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do inc(Wend); Delete(S,1,WEnd-1); end; Var W : String; begin While Length(S)>0 do begin W:=GetNextWord; If (W<>'') then List.Add(W); end; end; Function MakeCommand(P : TProcess) : PPchar; Const SNoCommandLine = 'Cannot execute empty command-line'; Var Cmd : String; S : TStringList; G : String; begin if (P.ApplicationName='') then begin If (P.CommandLine='') then Raise Exception.Create(SNoCommandline); Cmd:=P.CommandLine; end else begin If (P.CommandLine='') then Cmd:=P.ApplicationName else Cmd:=P.CommandLine; end; S:=TStringList.Create; try CommandToList(Cmd,S); if poNewConsole in P.Options then begin S.Insert(0,'-e'); If (P.ApplicationName<>'') then begin S.Insert(0,P.ApplicationName); S.Insert(0,'-title'); end; if suoUseCountChars in P.StartupOptions then begin S.Insert(0,Format('%dx%d',[P.dwXCountChars,P.dwYCountChars])); S.Insert(0,'-geometry'); end; S.Insert(0,'xterm'); end; if (P.ApplicationName<>'') then begin S.Add(TitleOption); S.Add(P.ApplicationName); end; G:=''; if (suoUseSize in P.StartupOptions) then g:=format('%dx%d',[P.dwXSize,P.dwYsize]); if (suoUsePosition in P.StartupOptions) then g:=g+Format('+%d+%d',[P.dwX,P.dwY]); if G<>'' then begin S.Add(GeometryOption); S.Add(g); end; Result:=StringsToPcharList(S); Finally S.free; end; end; Function GetLastError : Integer; begin Result:=-1; end; Type TPipeEnd = (peRead,peWrite); TPipePair = Array[TPipeEnd] of Integer; Procedure CreatePipes(Var HI,HO,HE : TPipePair; CE : Boolean); Procedure CreatePair(Var P : TPipePair); begin If not CreatePipeHandles(P[peRead],P[peWrite]) then Raise Exception.Create('Failed to create pipes'); end; Procedure ClosePair(Var P : TPipePair); begin if (P[peRead]<>-1) then FileClose(P[peRead]); if (P[peWrite]<>-1) then FileClose(P[peWrite]); end; begin HO[peRead]:=-1;HO[peWrite]:=-1; HI[peRead]:=-1;HI[peWrite]:=-1; HE[peRead]:=-1;HE[peWrite]:=-1; Try CreatePair(HO); CreatePair(HI); If CE then CreatePair(HE); except ClosePair(HO); ClosePair(HI); If CE then ClosePair(HE); Raise; end; end; Procedure TProcess.Execute; Var HI,HO,HE : TPipePair; PID : Longint; FEnv : PPChar; Argv : PPChar; fd : Integer; PName : String; begin If (poUsePipes in FProcessOptions) then CreatePipes(HI,HO,HE,Not (poStdErrToOutPut in FProcessOptions)); Try if FEnvironment.Count<>0 then FEnv:=StringsToPcharList(FEnvironment) else FEnv:=Nil; Try Argv:=MakeCommand(Self); Try If (Argv<>Nil) and (ArgV[0]<>Nil) then PName:=StrPas(Argv[0]) else begin // This should never happen, actually. PName:=ApplicationName; If (PName='') then PName:=CommandLine; end; if (pos('/',PName)<>1) then PName:=FileSearch(Pname,fpgetenv('PATH')); Pid:=fpfork; if Pid<0 then Raise Exception.Create('Failed to Fork process'); if (PID>0) then begin // Parent process. Copy process information. FProcessHandle:=PID; FThreadHandle:=PID; FProcessId:=PID; //FThreadId:=PID; end else begin { We're in the child } if (FCurrentDirectory<>'') then ChDir(FCurrentDirectory); if PoUsePipes in Options then begin fpdup2(HI[peRead],0); fpdup2(HO[peWrite],1); if (poStdErrToOutPut in Options) then fpdup2(HO[peWrite],2) else fpdup2(HE[peWrite],2); end else if poNoConsole in Options then begin fd:=FileOpen('/dev/null',fmOpenReadWrite); fpdup2(fd,0); fpdup2(fd,1); fpdup2(fd,2); end; if (poRunSuspended in Options) then sigraise(SIGSTOP); if FEnv<>Nil then fpexecve(PName,Argv,Fenv) else fpexecv(PName,argv); Halt(127); end Finally FreePcharList(Argv); end; Finally If (FEnv<>Nil) then FreePCharList(FEnv); end; Finally if POUsePipes in FProcessOptions then begin FileClose(HO[peWrite]); FileClose(HI[peRead]); if Not (poStdErrToOutPut in FProcessOptions) then FileClose(HE[peWrite]); CreateStreams(HI[peWrite],HO[peRead],HE[peRead]); end; end; FRunning:=True; if not (csDesigning in ComponentState) and // This would hang the IDE ! (poWaitOnExit in FProcessOptions) and not (poRunSuspended in FProcessOptions) then WaitOnExit; end; Function TProcess.WaitOnExit : Dword; begin Result:=fpWaitPid(Handle,@FExitCode,0); If Result=Handle then FExitCode:=WexitStatus(FExitCode); FRunning:=False; end; Function TProcess.Suspend : Longint; begin If fpkill(Handle,SIGSTOP)<>0 then Result:=-1 else Result:=1; end; Function TProcess.Resume : LongInt; begin If fpKill(Handle,SIGCONT)<>0 then Result:=-1 else Result:=0; end; Function TProcess.Terminate(AExitCode : Integer) : Boolean; begin Result:=False; Result:=fpkill(Handle,SIGTERM)=0; If Result then begin If Running then Result:=fpkill(Handle,SIGKILL)=0; end; GetExitStatus; end; Procedure TProcess.SetShowWindow (Value : TShowWindowOptions); begin FShowWindow:=Value; end;