mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-07-29 15:26:20 +02:00
379 lines
7.6 KiB
PHP
379 lines
7.6 KiB
PHP
{
|
|
Unix Process .inc.
|
|
}
|
|
|
|
uses
|
|
Unix,
|
|
Baseunix;
|
|
|
|
|
|
|
|
Const
|
|
PriorityConstants : Array [TProcessPriority] of Integer =
|
|
(20,20,0,-20);
|
|
|
|
Const
|
|
GeometryOption : String = '-geometry';
|
|
TitleOption : String ='-title';
|
|
|
|
|
|
|
|
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;
|
|
|