{%MainUnit process.pp}
{
    This file is part of the Free Component Library (FCL)
    Copyright (c) 1999-2000 by the Free Pascal development team

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

Type
   {$ifdef processunicodestring}
   TProcessString = Unicodestring;
   TprocessChar   = UnicodeChar;

   { TProcessStrings }

   TProcessStrings = Class(TPersistent)
                private
                   name   : array of unicodestring;
                   function getcount: Integer;
                   function getname( index: integer): Unicodestring;
                public
                   procedure AssignTo(Dest: TPersistent); override;
                   procedure add(const s : Unicodestring);
                   procedure Clear;
                   procedure Delete(i:integer);

                   property Names[ index:integer]:Unicodestring read getname; default;
                   property Count : Integer read getcount;
   end;
   TProcessStringList = TProcessStrings;
   {$else}
   TprocessChar   = Char;
   TProcessString = String;
   TProcessStrings = TStrings;
   TProcessStringList = TStringList;
   {$endif}

   TFileWriteMode = (fwmTruncate, fwmAppend, fwmAtstart);


   TIODescriptor = class(TPersistent)
   private
     FAfterAllocateHandle: TAfterAllocateHandleEvent;
     FCloseHandleOnExecute: Boolean;
     FCustomHandle: THandle;
     FAutoCloseCustomHandle: Boolean;
     FCustomHandleIsInheritable: Boolean;
     FFileWriteMode: TFileWriteMode;
     FHandleType: TProcessHandleType;
     FFileName: TFileName;
     FIOType: TIOType;
     FOnGetHandle: TGetHandleEvent;
     FOwnerProcess: TProcess;
     FPipeBufferSize: cardinal;
     FProcess: TProcess;
     FTheirHandle : THandle;
     FTheirHandleIOType: TIOType;
     FHandleValid : Boolean;
     FStream : THandleStream;
     FOurHandle : THandle;
     procedure SetFileName(AValue: TFileName);
     procedure SetFileWriteMode(AValue: TFileWriteMode);
     procedure SetIOType(AValue: TIOType);
     procedure SetProcess(AValue: TProcess);
     function SysCreatePipeHandle: THandle;
     function SysPrepareCreatedHandleForProcess(aHandle: THandle): THandle;
     Function SysCreateFileNameHandle(const aFileName : string) : THandle;
     function SysNullFileName : string;
     function SysIsTypeSupported(AValue: TIOType) : Boolean;
   protected
     Procedure CheckNotRunning; virtual;
     // Create handles for new process
     Function PrepareCreatedHandleForProcess(aHandle : THandle) : THandle; virtual;
     Function CreateStandardHandle : THandle; virtual;
     Function CreatePipeHandle : THandle; virtual;
     Function CreateFileNameHandle : THandle; virtual;
     Function CreateNullFileHandle : THandle; virtual;
     Function CreateCustomHandle : THandle; virtual;
     Function CreateProcessHandle : THandle; virtual;
     Function ResolveProcessHandle : THandle; virtual;
     Function ResolveStream : THandleStream; virtual;
     Procedure CloseOurHandle; virtual;
     Procedure CloseTheirHandle(aForceClose : Boolean = false);virtual;
     Procedure PrepareHandles;virtual;
     Procedure ResetHandles;virtual;
     Property OwnerProcess : TProcess Read FOwnerProcess;
     Property PipeBufferSize : cardinal read FPipeBufferSize write FPipeBufferSize;
     Property OurHandle: THandle Read FOurHandle;
     Property HandleValid : Boolean Read FHandleValid;
     Property CloseHandleOnExecute : Boolean Read FCloseHandleOnExecute Write FCloseHandleOnExecute;
   public
     Constructor Create(aOwnerProcess : TProcess; aType : TProcessHandleType);
     Destructor Destroy; override;
     Property ProcessHandleType : TProcessHandleType Read FHandleType;
     Property CustomHandle : THandle Read FCustomHandle Write FCustomHandle;
     Property AutoCloseCustomHandle: Boolean Read FAutoCloseCustomHandle Write FAutoCloseCustomHandle;
     Property CustomHandleIsInheritable: Boolean Read FCustomHandleIsInheritable Write FCustomHandleIsInheritable; platform;

   Published
     Property IOType : TIOType Read FIOType Write SetIOType;
     Property FileName : TFileName Read FFileName Write SetFileName;
     Property OnGetHandle : TGetHandleEvent Read FOnGetHandle Write FOnGetHandle;
     Property AfterAllocateHandle : TAfterAllocateHandleEvent Read FAfterAllocateHandle Write FAfterAllocateHandle;
     Property Process : TProcess Read FProcess Write SetProcess;
     Property FileWriteMode : TFileWriteMode Read FFileWriteMode Write SetFileWriteMode;
   end;


  { TProcess }

  TProcess = Class (TComponent)
  Private
    FOnRunCommandEvent: TOnRunCommandEvent;
    FProcessOptions : TProcessOptions;
    FRunCommandSleepTime: Integer;
    FStartupOptions : TStartupOptions;
    FFillAttribute : Cardinal;
    FApplicationName : TProcessString;
    FConsoleTitle : TProcessString;
    FCommandLine : TProcessString;
    FCurrentDirectory : TProcessString;
    FDesktop : String;
    FEnvironment : TProcessStrings;
    FExecutable : TProcessString;
    FParameters : TProcessStrings;
    FShowWindow : TShowWindowOptions;
    FInherithandles : Boolean;
    {$ifdef UNIX}
    FForkEvent : TProcessForkEvent;
    {$endif UNIX}
    FProcessPriority : TProcessPriority;
    dwXCountchars,
    dwXSize,
    dwYsize,
    dwx,
    dwYcountChars,
    dwy : Cardinal;
    FXTermProgram: String;
    FPipeBufferSize : cardinal;
    FDescriptors: Array [TProcessHandleType] of TIODescriptor;
    function GetDescriptor(AIndex: Integer): TIODescriptor;
    Function  GetExitStatus : Integer;
    Function  GetExitCode : Integer;
    function GetInputStream: TOutputPipeStream;
    function GetOutputStream: TInputPipeStream;
    Function  GetRunning : Boolean;
    function GetStderrStream: TinputPipeStream;
    Function  GetWindowRect : TRect;
    procedure SetCommandLine(const AValue: TProcessString); deprecated;
    procedure SetDescriptor(AIndex: Integer; AValue: TIODescriptor);
    procedure SetParameters(const AValue: TProcessStrings);
    procedure SetPipeBufferSize(AValue: cardinal);
    Procedure SetWindowRect (Value : TRect);
    Procedure SetShowWindow (Value : TShowWindowOptions);
    Procedure SetWindowColumns (Value : Cardinal);
    Procedure SetWindowHeight (Value : Cardinal);
    Procedure SetWindowLeft (Value : Cardinal);
    Procedure SetWindowRows (Value : Cardinal);
    Procedure SetWindowTop (Value : Cardinal);
    Procedure SetWindowWidth (Value : Cardinal);
    procedure SetApplicationName(const Value: TProcessString);
    procedure SetProcessOptions(const Value: TProcessOptions);
    procedure SetActive(const Value: Boolean);
    procedure SetEnvironment(const Value: TProcessStrings);
    Procedure ConvertCommandLine;
    function  PeekExitStatus: Boolean;
    Procedure IntOnIdleSleep(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:String);
  Protected
    FRunning : Boolean;
    FExitCode : Cardinal;
    FProcessID : Integer;
    FThreadID : Integer;
    FProcessHandle : Thandle;
    FThreadHandle : Thandle;
    procedure CloseProcessHandles; virtual;
    procedure Loaded; override;
    Procedure SysExecute; virtual;
    function CreateIODescriptor(aOwner: TProcess; aHandleType: TProcessHandleType): TIODescriptor; virtual;
  Public
    Constructor Create (AOwner : TComponent);override;
    Destructor Destroy; override;
    Procedure Execute; virtual;
    procedure CloseInput; virtual;
    procedure CloseOutput; virtual;
    procedure CloseStderr; virtual;
    Function Resume : Integer; virtual;
    Function Suspend : Integer; virtual;
    Function Terminate (AExitCode : Integer): Boolean; virtual;
    Function WaitOnExit : Boolean;
    Function WaitOnExit(Timeout : DWord) : Boolean;
    function ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean; virtual;
    function ReadInputStream(p:TInputPipeStream;data:TStream;MaxLoops:integer=10):boolean; virtual;
    function RunCommandLoop(out outputstring:string;out stderrstring:string; out anexitstatus:integer):integer; virtual;

    Property WindowRect : Trect Read GetWindowRect Write SetWindowRect;
    Property Handle : THandle Read FProcessHandle;
    Property ProcessHandle : THandle Read FProcessHandle;
    Property ThreadHandle : THandle Read FProcessHandle;
    Property ProcessID : Integer Read FProcessID;
    Property ThreadID : Integer Read FThreadID;
    Property Input  : TOutputPipeStream Read GetInputStream;
    Property Output : TInputPipeStream  Read GetOutputStream;
    Property Stderr : TinputPipeStream  Read GetStderrStream;
    Property ExitStatus : Integer Read GetExitStatus;
    Property ExitCode : Integer Read GetExitCode;
    Property InheritHandles : Boolean Read FInheritHandles Write FInheritHandles;
    Property OnRunCommandEvent : TOnRunCommandEvent Read FOnRunCommandEvent Write FOnRunCommandEvent;
    Property RunCommandSleepTime : Integer read FRunCommandSleepTime write FRunCommandSleepTime;
    {$ifdef UNIX}
    property OnForkEvent : TProcessForkEvent Read FForkEvent Write FForkEvent;
    {$endif UNIX}
  Published
    property PipeBufferSize : cardinal read FPipeBufferSize write SetPipeBufferSize default 1024;
    Property Active : Boolean Read GetRunning Write SetActive;
    Property ApplicationName : TProcessString Read FApplicationName Write SetApplicationName; deprecated;
    Property CommandLine : TProcessString Read FCommandLine Write SetCommandLine ; deprecated;
    Property Executable : TProcessString Read FExecutable Write FExecutable;
    Property Parameters : TProcessStrings Read FParameters Write SetParameters;
    Property ConsoleTitle : TProcessString Read FConsoleTitle Write FConsoleTitle;
    Property CurrentDirectory : TProcessString Read FCurrentDirectory Write FCurrentDirectory;
    Property Desktop : String Read FDesktop Write FDesktop;
    Property Environment : TProcessStrings Read FEnvironment Write SetEnvironment;
    Property Options : TProcessOptions Read FProcessOptions Write SetProcessOptions;
    Property Priority : TProcessPriority Read FProcessPriority Write FProcessPriority;
    Property StartupOptions : TStartupOptions Read FStartupOptions Write FStartupOptions;
    Property Running : Boolean Read GetRunning;
    Property ShowWindow : TShowWindowOptions Read FShowWindow Write SetShowWindow;
    Property WindowColumns : Cardinal Read dwXCountChars Write SetWindowColumns;
    Property WindowHeight : Cardinal Read dwYSize Write SetWindowHeight;
    Property WindowLeft : Cardinal Read dwX Write SetWindowLeft;
    Property WindowRows : Cardinal Read dwYCountChars Write SetWindowRows;
    Property WindowTop : Cardinal Read dwY Write SetWindowTop ;
    Property WindowWidth : Cardinal Read dwXSize Write SetWindowWidth;
    Property FillAttribute : Cardinal read FFillAttribute Write FFillAttribute;
    Property XTermProgram : String Read FXTermProgram Write FXTermProgram;
    Property InputDescriptor : TIODescriptor index Ord(phtInput) Read GetDescriptor Write SetDescriptor;
    Property OutputDescriptor : TIODescriptor Index Ord(phtOutput) Read GetDescriptor Write SetDescriptor;
    Property ErrorDescriptor : TIODescriptor Index Ord(phtError) Read GetDescriptor Write SetDescriptor;
  end;

  TProcessClass = Class of TProcess;

Procedure CommandToList(S : TProcessString; List : TProcessStrings);

{$ifdef unix}
Var
  TryTerminals : Array of string;
  XTermProgram : String;
  SignalWaitTime : Integer = 20; // Wait time in ms. after sending SIGTERM
  Function DetectXTerm : String;
{$endif unix}

function RunCommandIndir(const curdir:TProcessString;const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; out exitstatus:integer; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):integer;
function RunCommandIndir(const curdir:TProcessString;const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):boolean;
function RunCommand(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):boolean;

function RunCommandInDir(const curdir,cmdline:TProcessString;out outputstring:string):boolean; deprecated;
function RunCommand(const cmdline:TProcessString;out outputstring:string):boolean; deprecated;

// Allows override of the class instantiated for RunCommand*.

var DefaultTProcess : TProcessClass = TProcess;

const
  SErrCannotCreatePipes = 'Failed to create pipes';

{$IFDEF LINUX}
  INVALID_HANDLE_VALUE = DWORD(-1);
{$ENDIF}

implementation

{$IFDEF MSWINDOWS}
{$i win_process.inc}
{$ELSE}
{$i unix_process.inc}
{$ENDIF}

{$IFNDEF SKIPHELPERS}
function TIOTypeHelper.ToString : string;

begin
  WriteStr(Result,Self);
end;

{ TProcessHandleTypeHelper }

function TProcessHandleTypeHelper.ToString: string;
begin
  WriteStr(Result,Self);
end;


{ TProcessOption }

function TProcessOptionHelper.ToString: String;
begin
  WriteStr(Result,Self);
end;

{ TShowWindowOptionsHelper }

function TShowWindowOptionsHelper.ToString: String;
begin
  WriteStr(Result,Self);
end;

{ TStartupOptionHelper }

function TStartupOptionHelper.ToString: String;
begin
  WriteStr(Result,Self);
end;

{ TProcessPriorityhelper }

function TProcessPriorityhelper.ToString: String;
begin
  WriteStr(Result,Self);
end;

{ TRunCommandEventCodeHelper }

function TRunCommandEventCodeHelper.ToString: string;
begin
  WriteStr(Result,Self);
end;

{$ENDIF SKIPHELPERS}

Procedure CommandToList(S : TProcessString; List : TProcessStrings);

  Function GetNextWord : TProcessString;

  Const
    WhiteSpace = [' ',#9,#10,#13];
    Literals = ['"',''''];

  Var
    Wstart,wend : Integer;
    InLiteral : Boolean;
    LastLiteral : TProcessChar;

  begin
    WStart:=1;
    While (WStart<=Length(S)) and charinset(S[WStart],WhiteSpace) do
      Inc(WStart);
    WEnd:=WStart;
    InLiteral:=False;
    LastLiteral:=#0;
    While (Wend<=Length(S)) and (Not charinset(S[Wend],WhiteSpace) or InLiteral) do
      begin
      if charinset(S[Wend],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);

     if  (Length(Result) > 0)
     and (Result[1] = Result[Length(Result)]) // if 1st AnsiChar = last AnsiChar and..
     and (Result[1] in Literals) then // it's one of the literals, then
       Result:=Copy(Result, 2, Length(Result) - 2); //delete the 2 (but not others in it)

     While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
       inc(Wend);
     Delete(S,1,WEnd-1);

  end;

Var
  W : TProcessString;

begin
  While Length(S)>0 do
    begin
    W:=GetNextWord;
    If (W<>'') then
      List.Add(W);
    end;
end;

Constructor TProcess.Create (AOwner : TComponent);

Var
  HT : TProcessHandleType;

begin
  Inherited;
  FProcessPriority:=ppNormal;
  FShowWindow:=swoNone;
  FInheritHandles:=True;
  {$ifdef UNIX}
  FForkEvent:=nil;
  {$endif UNIX}
  FPipeBufferSize := 1024;
  FEnvironment:=TProcessStringList.Create;
  FParameters:=TProcessStringList.Create;
  FRunCommandSleepTime:=100;
  FOnRunCommandEvent:=@IntOnIdleSleep;
  For HT in TProcessHandleType do
    FDescriptors[HT]:=CreateIODescriptor(Self,HT)
end;

Destructor TProcess.Destroy;

Var
  HT : TProcessHandleType;

begin
  FParameters.Free;
  FEnvironment.Free;
  CloseProcessHandles;
  For HT in TProcessHandleType do
    FreeAndNil(FDescriptors[HT]);
  Inherited Destroy;
end;

Function TProcess.CreateIODescriptor(aOwner : TProcess; aHandleType : TProcessHandleType) :TIODescriptor;

begin
  Result:=TIODescriptor.Create(aOwner,aHandleType);
end;

function TProcess.GetDescriptor(AIndex: Integer): TIODescriptor;
begin
  Result:=FDescriptors[TProcessHandleType(aIndex)];
end;

function TProcess.GetInputStream: TOutputPipeStream;
begin
  Result:=FDescriptors[phtInput].ResolveStream as TOutputPipeStream;
end;

function TProcess.GetOutputStream: TInputPipeStream;
begin
  Result:=FDescriptors[phtOutput].ResolveStream as TInputPipeStream;
end;



Function TProcess.GetExitStatus : Integer;

begin
  GetRunning;
  Result:=Integer(FExitCode);
end;

{$IFNDEF OS_HASEXITCODE}
Function TProcess.GetExitCode : Integer;

begin
  if Not Running then
    Result:=GetExitStatus
  else
    Result:=0
end;
{$ENDIF}

Function TProcess.GetRunning : Boolean;

begin
  IF FRunning then
    FRunning:=Not PeekExitStatus;
  Result:=FRunning;
end;

function TProcess.GetStderrStream: TinputPipeStream;
begin
  Result:=FDescriptors[phtError].ResolveStream as TInputPipeStream;
end;

procedure TProcess.Loaded;
begin
  inherited Loaded;
  If (csDesigning in ComponentState) and (FCommandLine<>'') then
    ConvertCommandLine;
end;

Procedure TProcess.Execute;

Var
  HT : TProcessHandleType;

begin
  for HT in TProcessHandleType do
    FDescriptors[HT].ResetHandles;
  SysExecute;
end;


procedure TProcess.CloseInput;
begin
  FDescriptors[phtInput].CloseOurHandle;
end;

procedure TProcess.CloseOutput;
begin
  FDescriptors[phtOutput].CloseOurHandle;
end;

procedure TProcess.CloseStderr;
begin
  FDescriptors[phtError].CloseOurHandle;
end;

Procedure TProcess.SetWindowColumns (Value : Cardinal);

begin
  if Value<>0 then
    Include(FStartupOptions,suoUseCountChars);
  dwXCountChars:=Value;
end;


Procedure TProcess.SetWindowHeight (Value : Cardinal);

begin
  if Value<>0 then
    include(FStartupOptions,suoUsePosition);
  dwYSize:=Value;
end;

Procedure TProcess.SetWindowLeft (Value : Cardinal);

begin
  if Value<>0 then
    Include(FStartupOptions,suoUseSize);
  dwx:=Value;
end;

Procedure TProcess.SetWindowTop (Value : Cardinal);

begin
  if Value<>0 then
    Include(FStartupOptions,suoUsePosition);
  dwy:=Value;
end;

Procedure TProcess.SetWindowWidth (Value : Cardinal);
begin
  If (Value<>0) then
    Include(FStartupOptions,suoUseSize);
  dwXSize:=Value;
end;

Function TProcess.GetWindowRect : TRect;
begin
  With Result do
    begin
    Left:=dwx;
    Right:=dwx+dwxSize;
    Top:=dwy;
    Bottom:=dwy+dwysize;
    end;
end;

procedure TProcess.SetCommandLine(const AValue: TProcessString);
begin
  if FCommandLine=AValue then exit;
  FCommandLine:=AValue;
  If Not (csLoading in ComponentState) then
    ConvertCommandLine;
end;

procedure TProcess.SetDescriptor(AIndex: Integer; AValue: TIODescriptor);
begin
  FDescriptors[TProcessHandleType(aIndex)].Assign(AValue);
end;

procedure TProcess.SetParameters(const AValue: TProcessStrings);
begin
  FParameters.Assign(AValue);
end;

procedure TProcess.SetPipeBufferSize(AValue: cardinal);
var
  HT: TProcessHandleType;
begin
  if FPipeBufferSize = AValue then Exit;
  FPipeBufferSize := AValue;
  for HT in TProcessHandleType do
    FDescriptors[HT].PipeBufferSize:=AValue;
end;

Procedure TProcess.SetWindowRect (Value : Trect);
begin
  Include(FStartupOptions,suoUseSize);
  Include(FStartupOptions,suoUsePosition);
  With Value do
    begin
    dwx:=Left;
    dwxSize:=Right-Left;
    dwy:=Top;
    dwySize:=Bottom-top;
    end;
end;


Procedure TProcess.SetWindowRows (Value : Cardinal);

begin
  if Value<>0 then
    Include(FStartupOptions,suoUseCountChars);
  dwYCountChars:=Value;
end;

procedure TProcess.SetApplicationName(const Value: TProcessString);
begin
  FApplicationName := Value;
  If (csDesigning in ComponentState) and
     (FCommandLine='') then
    FCommandLine:=Value;
end;

procedure TProcess.SetProcessOptions(const Value: TProcessOptions);

var
  HT : TProcessHandleType;

begin
  FProcessOptions := Value;
  If poNewConsole in FProcessOptions then
    Exclude(FProcessOptions,poNoConsole);
  if poRunSuspended in FProcessOptions then
    Exclude(FProcessOptions,poWaitOnExit);
  if poUsePipes in FProcessOptions then
    for HT in TProcessHandleType do
      FDescriptors[HT].IOType:=iotPipe;
  if poStderrToOutPut in FProcessOptions then
    FDescriptors[phtError].IOType:=iotDefault;
  if poPassInput in FProcessOptions then
    FDescriptors[phtInput].IOType:=iotDefault;
end;

procedure TProcess.SetActive(const Value: Boolean);
begin
  if (Value<>GetRunning) then
    If Value then
      Execute
    else
      Terminate(0);
end;

procedure TProcess.SetEnvironment(const Value: TProcessStrings);
begin
  FEnvironment.Assign(Value);
end;

procedure TProcess.ConvertCommandLine;
begin
  FParameters.Clear;
  CommandToList(FCommandLine,FParameters);
  If FParameters.Count>0 then
    begin
    Executable:=FParameters[0];
    FParameters.Delete(0);
    end;
end;

Const
  READ_BYTES = 65536; // not too small to avoid fragmentation when reading large files.

function TProcess.ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var data:string;MaxLoops:integer=10):boolean;
var Available, NumBytes: integer;
begin
    Available:=P.NumBytesAvailable;
    result:=Available>0;
    if not result then
     exit;
    while (available > 0) and (MaxLoops>0) do
      begin
        if (BytesRead + available > DataLength) then
          begin
            DataLength:=BytesRead + max(READ_BYTES,available);
            Setlength(Data,DataLength);
          end;
        NumBytes := p.Read(data[1+BytesRead], Available);
        if NumBytes > 0 then
          Inc(BytesRead, NumBytes);
        Available:=P.NumBytesAvailable;
        dec(MaxLoops);
      end;
end;

function TProcess.ReadInputStream(p:TInputPipeStream;data:TStream;MaxLoops:integer=10):boolean;
const
  BufSize = 4096;
var
  Buffer: array[0..BufSize - 1] of byte;
  ReadBytes: integer;
  Available : integer;
begin
  Available:=P.NumBytesAvailable;
  result:=Available>0;
  if not result then
    Exit;
  while (available > 0) and (MaxLoops>0) do
  begin
    ReadBytes := Output.Read({%H-}Buffer, min(BufSize,Available));
    data.Write(Buffer, ReadBytes);
    Available:=P.NumBytesAvailable;
    dec(MaxLoops);
  end;
end;

procedure TProcess.IntOnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
begin
  if status=RunCommandIdle then
    sleep(FRunCommandSleepTime);
end;

// helperfunction that does the bulk of the work.
// We need to also collect stderr output in order to avoid
// lock out if the stderr pipe is full.
function TProcess.RunCommandLoop(out outputstring:string;
                            out stderrstring:string; out anexitstatus:integer):integer;
var
    bytesread : integer;
    outputlength, stderrlength : integer;
    stderrbytesread : integer;
    gotoutput,gotoutputstderr : boolean;
begin
  result:=-1;
    try
    Options := Options + [poUsePipes];
    bytesread:=0;
    outputlength:=0;
    stderrbytesread:=0;
    stderrlength:=0;
    Execute;
    while Running do
      begin
        // Only call ReadFromStream if Data from corresponding stream
        // is already available, otherwise, on  linux, the read call
        // is blocking, and thus it is not possible to be sure to handle
        // big data amounts bboth on output and stderr pipes. PM.
        gotoutput:=ReadInputStream(output,BytesRead,OutputLength,OutputString,1);
        // The check for assigned(P.stderr) is mainly here so that
        // if we use poStderrToOutput in p.Options, we do not access invalid memory.
        gotoutputstderr:=false;
        if assigned(stderr) then
            gotoutputstderr:=ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,1);
 
        if (porunidle in options) and not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then
          FOnRunCommandEvent(self,Nil,RunCommandIdle,'');
      end;
    // Get left output after end of execution
    ReadInputStream(output,BytesRead,OutputLength,OutputString,250);
    setlength(outputstring,BytesRead);
    if assigned(stderr) then
      ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,250);
    setlength(stderrstring,StderrBytesRead);
    anexitstatus:=exitstatus;
    result:=0; // we came to here, document that.
    if Assigned(FOnRunCommandEvent) then          // allow external apps to react to that and finish GUI
      FOnRunCommandEvent(self,Nil,RunCommandFinished,'');

    except
      on e : Exception do
         begin
           result:=1;
           setlength(outputstring,BytesRead);
           setlength(stderrstring,StderrBytesRead);
           if Assigned(FOnRunCommandEvent) then
             FOnRunCommandEvent(self,Nil,RunCommandException,e.Message);
         end;
     end;
end;

{ Functions without StderrString }

Const
  ForbiddenOptions = [poRunSuspended,poWaitOnExit];

function RunCommandIndir(const curdir:TProcessString;const exename:TProcessString;const commands:array of TProcessString;out outputstring:string;out exitstatus:integer; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):integer;
Var
    p : TProcess;
    i : integer;
    ErrorString : String;
begin
  p:=DefaultTProcess.create(nil);
  if Options<>[] then
    P.Options:=Options - ForbiddenOptions;
  P.ShowWindow:=SwOptions;
  p.Executable:=exename;
  if curdir<>'' then
    p.CurrentDirectory:=curdir;
  if high(commands)>=0 then
   for i:=low(commands) to high(commands) do
     p.Parameters.add(commands[i]);
  try
    result:=p.RunCommandLoop(outputstring,errorstring,exitstatus);
  finally
    p.free;
  end;
end;

function RunCommandInDir(const curdir,cmdline:TProcessString;out outputstring:string):boolean; deprecated;
Var
    p : TProcess;
    exitstatus : integer;
    ErrorString : String;
begin
  p:=DefaultTProcess.create(nil);
  p.setcommandline(cmdline);
  if curdir<>'' then
    p.CurrentDirectory:=curdir;
  try
    result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
  finally
    p.free;
  end;
  if exitstatus<>0 then result:=false;
end;

function RunCommandIndir(const curdir:TProcessString;const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):boolean;
Var
    p : TProcess;
    i,
    exitstatus : integer;
    ErrorString : String;
begin
  p:=DefaultTProcess.create(nil);
  if Options<>[] then
    P.Options:=Options - ForbiddenOptions;
  P.ShowWindow:=SwOptions;
  p.Executable:=exename;
  if curdir<>'' then
    p.CurrentDirectory:=curdir;
  if high(commands)>=0 then
   for i:=low(commands) to high(commands) do
     p.Parameters.add(commands[i]);
  try
    result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
  finally
    p.free;
  end;
  if exitstatus<>0 then result:=false;
end;

function RunCommand(const cmdline:TProcessString;out outputstring:String):boolean; deprecated;
Var
    p : TProcess;
    exitstatus : integer;
    ErrorString : String;
begin
  p:=DefaultTProcess.create(nil);
  p.setcommandline(cmdline);
  try
    result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
  finally
    p.free;
  end;
  if exitstatus<>0 then result:=false;
end;

function RunCommand(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):boolean;
Var
    p : TProcess;
    i,
    exitstatus : integer;
    ErrorString : String;
begin
  p:=DefaultTProcess.create(nil);
  if Options<>[] then
    P.Options:=Options - ForbiddenOptions;
  P.ShowWindow:=SwOptions;
  p.Executable:=exename;
  if high(commands)>=0 then
   for i:=low(commands) to high(commands) do
     p.Parameters.add(commands[i]);
  try
    result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
  finally
    p.free;
  end;
  if exitstatus<>0 then result:=false;
end;

{$ifdef processunicodestring}
// dummy subset of tstrings.
{ TProcessStrings }

function TProcessStrings.getname( index: integer): Unicodestring;
begin
  if index<length(name) then
     result:=name[index]
  else
     result:='';
end;

function TProcessStrings.getcount: Integer;
begin
  result:=length(name);
end;

procedure TProcessStrings.AssignTo(Dest: TPersistent);
var i : integer;
begin
  inherited assign(dest);
  if dest is TStrings then
    begin
      setlength(name,tstrings(dest).count);
      for i:=0 to length(name)-1 do
        name[i]:=tstrings(dest)[i];
    end;
  if dest is tprocessstrings then
     name:=copy(tprocessstrings(dest).name);
end;

procedure TProcessStrings.add(const s: Unicodestring);
var len : integer;
begin
  len:=length(name);
  setlength(name, len+1);
  name[len]:=s;
end;

procedure TProcessStrings.Clear;
begin
 setlength(name,0);
end;

procedure TProcessStrings.Delete(i: integer);
var len,j : integer;
begin
  len:=length(name);
  if len=0 then exit;
  if (i<>len-1) and (len<>1) then
     begin
       for j:=i+1 to len-1 do
         name[j-1]:=name[j];
       setlength(name,len-1)
     end
  else
    setlength(name,len-1)
end;
{$endif}

{ TIODescriptor }

procedure TIODescriptor.SetFileName(AValue: TFileName);
begin
  if FileName=AValue then Exit;
  CheckNotRunning;
  FFileName:=AValue;
  if aValue<>'' then
    FIOType:=iotFile;
end;

procedure TIODescriptor.SetFileWriteMode(AValue: TFileWriteMode);
begin
  if FFileWriteMode=AValue then Exit;
  CheckNotRunning;
  FFileWriteMode:=AValue;
end;

procedure TIODescriptor.SetIOType(AValue: TIOType);

var
  S : String;

begin
  if FIOType=AValue then Exit;
  CheckNotRunning;
  if not SysIsTypeSupported(aValue) then
    begin
    WriteStr(S,aValue);
    Raise EProcess.CreateFmt('I/O Type "%s" not supported on this platform',[S]);
    end;
  FIOType:=AValue;
  // Some cleanup
  if aValue<>iotProcess then
    FProcess:=Nil;
  if aValue<>iotFile then
    FFileName:='';
end;

procedure TIODescriptor.SetProcess(AValue: TProcess);

begin
  if FProcess=AValue then Exit;
  CheckNotRunning;
  if (FOwnerProcess=FProcess) then
    Raise EProcess.Create('Remote process cannot refer to self process');
  if Assigned(FOwnerProcess) and Assigned(FProcess) then
    FProcess.RemoveComponent(FOwnerProcess);
  if (aValue<>Nil) then
    FIOType:=iotProcess;
  FProcess:=AValue;
  if Assigned(FOwnerProcess) and Assigned(FProcess) then
    FProcess.RemoveComponent(FOwnerProcess);
  if Self.ProcessHandleType=phtInput then
    FProcess.OutputDescriptor.IOType:=iotPipe
  else
    FProcess.InputDescriptor.IOType:=iotPipe;
end;


procedure TIODescriptor.CheckNotRunning;
begin
  If Assigned(FOwnerProcess) then
    if FOwnerProcess.Active then
       Raise EProcess.Create('Cannot perform operation while process is running');
end;

function TIODescriptor.PrepareCreatedHandleForProcess(aHandle: THandle): THandle;
begin
  Result:=SysPrepareCreatedHandleForProcess(aHandle);
end;

Function TIODescriptor.CreateStandardHandle : THandle;

begin
  case ProcessHandleType of
    phtInput:  Result:=StdInputHandle;
    phtOutput:  Result:=StdOutputHandle;
    phtError:  Result:=StdErrorHandle;
  end;
end;

Function TIODescriptor.CreatePipeHandle : THandle;

begin
  Result:=SysCreatePipeHandle;
end;

{$IFNDEF OS_HASCREATEPIPE}
Function TIODescriptor.SysCreatePipeHandle : THandle;

var
  HIn,HOut : Thandle;
begin
  HIn:=THandle(INVALID_HANDLE_VALUE);
  HOut:=HIn;
  If not CreatePipeHandles(Hin,HOut) then
    Raise EProcess.Create(SErrCannotCreatePipes);
  case ProcessHandleType of
    phtInput:
      begin
      Result:=HIn;
      FOurHandle:=hOut;
      end;
    phtOutput,
    phtError:
      begin
      Result:=hOut;
      FOurHandle:=HIn;
      end;
  end;
end;
{$ENDIF}

Function TIODescriptor.CreateFileNameHandle : THandle;

begin
  Result:=SysCreateFileNameHandle(FileName);
  if (ProcessHandleType<>phtInput) then
    case FFileWriteMode of
      fwmAtstart: ;
      fwmTruncate : FileTruncate(Result,0);
      fwmAppend : FileSeek(Result,0,soFromEnd);
    end;
end;

function TIODescriptor.CreateNullFileHandle: THandle;
begin
  Result:=SysCreateFileNameHandle(SysNullFileName);
end;

Function TIODescriptor.CreateCustomHandle : THandle;

begin
  Result:=FCustomHandle;
  if Assigned(FOnGetHandle) then
    FOnGetHandle(Self,Result,FCloseHandleOnExecute);
  if FCustomHandle=THandle(INVALID_HANDLE_VALUE) then
    Raise EProcess.Create('Cannot get custom handle. No handle set');
end;

Function TIODescriptor.CreateProcessHandle : THandle;

begin
  if Not Assigned(Process) then
    Raise EProcess.Create('Cannot get handle. No process assigned');
  case ProcessHandleType of
    phtInput:  Result:=Process.OutputDescriptor.OurHandle;
    phtOutput:  Result:=Process.InputDescriptor.OurHandle;
    phtError:  Result:=Process.InputDescriptor.OurHandle;
  end;
  if Result=THandle(INVALID_HANDLE_VALUE) then
    Raise EProcess.Create('Cannot get handle. Process not active');
end;

function TIODescriptor.ResolveStream: THandleStream;
begin
  if (FStream=Nil) and (FHandleValid) and (FTheirHandleIOType=iotPipe) then
    begin
    // Writeln(ProcessHandleType,' creating stream for stream ',IOType,': ',OurHandle);
    Case FHandleType of
      phtInput : FStream:=TOutputPipeStream.Create(OurHandle);
      phtError,
      phtOutput : FStream:=TInputPipeStream.Create(OurHandle);
    end;
    end;
  FOurHandle:=THandle(INVALID_HANDLE_VALUE);
  Result:=FStream;
end;


procedure TIODescriptor.CloseOurHandle;

var
  H : THandle;

begin
  if Not FHandleValid then
     exit;
  H:=OurHandle;
  // Writeln(StdErr, GetProcessID ,' : ',ProcessHandleType,' closing our handle ',IOType,': ',FOurHandle);
  FOurHandle:=THandle(INVALID_HANDLE_VALUE) ;
  if H<>THandle(INVALID_HANDLE_VALUE) then
    FileClose(H);
end;

procedure TIODescriptor.CloseTheirHandle(aForceClose: Boolean);
var
  H : THandle;

begin
  if Not FHandleValid then
     exit;
  If (FTheirHandleIOType=iotDefault) or not (CloseHandleOnExecute or aForceClose) then
    begin
    FTheirHandle:=THandle(INVALID_HANDLE_VALUE);
    exit;
    end;
  H:=ResolveProcessHandle;
  // Writeln(StdErr,GetProcessID,' : ',ProcessHandleType,' closing their handle ',IOType,': ',H);
  FTheirHandle:=THandle(INVALID_HANDLE_VALUE);
  if H<>THandle(INVALID_HANDLE_VALUE) then
    begin
    FileClose(H);
    end;
end;

procedure TIODescriptor.PrepareHandles;

var
  H : THandle;
  S : String;

begin
  WriteStr(S,IOType);
  H:=ResolveProcessHandle;
  // Writeln('PReparing handle ',S,' : ',H,' (ours: ',OurHandle,')');
  if H=THandle(INVALID_HANDLE_VALUE) then
     Raise EProcess.CreateFmt('Failed to prepare process handle for %s',[S]);
end;

procedure TIODescriptor.ResetHandles;

begin
  CloseOurHandle;
  CloseTheirHandle(True);
  FreeAndNil(FStream);
  FHandleValid:=False;
end;



function TIODescriptor.ResolveProcessHandle: THandle;

var
  H : THandle;

begin
  if not FHandleValid then
    begin
    FTheirHandleIOType := IOType;
    FOurHandle:=THAndle(INVALID_HANDLE_VALUE);
    FCloseHandleOnExecute:=(IOType<>iotDefault);
    if IOType = iotHandle then
      FCloseHandleOnExecute:=FAutoCloseCustomHandle;
    Case IOType of
      iotDefault : H:=CreateStandardHandle;
      iotPipe : H:=CreatePipeHandle;
      iotFile : H:=CreateFileNameHandle;
      iotProcess : H:=CreateProcessHandle;
      iotHandle : H:=CreateCustomHandle;
      iotNull : H:=CreateNullFileHandle;
    end;
    FTheirHandle:=PrepareCreatedHandleForProcess(H);
    if Assigned(FAfterAllocateHandle) then
      FAfterAllocateHandle(Self,FTheirHandle,FCloseHandleOnExecute);
    FHandleValid:=True;
    end;
  Result:=FTheirHandle;
end;

constructor TIODescriptor.Create(aOwnerProcess: TProcess; aType: TProcessHandleType);
begin
  FOwnerProcess:=aOwnerProcess;
  FHandleType:=aType;
  FCustomHandle:=THandle(INVALID_HANDLE_VALUE);
  FTheirHandle:=THandle(INVALID_HANDLE_VALUE);
  FOurHandle:=THandle(INVALID_HANDLE_VALUE);
  FPipeBufferSize := 1024;
  FAutoCloseCustomHandle := True;
end;

destructor TIODescriptor.Destroy;
begin
  FreeAndNil(FStream);
  ResetHandles;
  inherited Destroy;
end;

end.