Runcommand/Tprocess with timeout
lazarus / 62-General

----------------------------------------------------------------------
marcov · 2020-07-10 16:32

Today, at work I attacked a long running nuisance in a minor
application. An old application/script written by somebody else
sometimes hangs, specially if the files it is supposed to parse have
been hand edited. 

It is a low prio item, and I worked around this by cleaning up and
restarting, but today got fed up and decided to tackle it once and for
all, so I tried quickly create a simple and easy tprocess derivate
with a simple timeout, and since it is also  a demonstration of some
of the new FPC 3.2.0+ TProcess features, I thought I should share:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i {$mode
delphi}uses classes,sysutils,process,dateutils;Type{ TProcessTimeout
} TProcessTimeout = class(TProcess)                            public 
                          timeoutperiod: TTime;                      
    timedout : boolean;                            started :
TDateTime;                            procedure
LocalnIdleSleep(Sender,Context :
TObject;status:TRunCommandEventCode;const message:string);           
             end; procedure
TProcessTimeout.LocalnIdleSleep(Sender,Context :
TObject;status:TRunCommandEventCode;const message:string);begin   if
status=RunCommandIdle then    begin      if (now-
started)>timeoutperiod then         begin           timedout:=true;  
       Terminate(255);           exit;         end;     
sleep(RunCommandSleepTime);    end;end; function
RunCommandTimeout(const exename:TProcessString;const commands:array of
TProcessString;out outputstring:string; Options : TProcessOptions = []
;SWOptions:TShowWindowOptions=swoNone;timeout:integer=60):boolean;Var 
  p : TProcessTimeout;    i,    exitstatus : integer;    ErrorString :
String;begin  p:=TProcessTimeout.create(nil); 
p.OnRunCommandEvent:=p.LocalnIdleSleep; 
p.timeoutperiod:=timeout/SecsPerDay;  if Options<>[] then   
P.Options:=Options - [poRunSuspended,poWaitOnExit]; 
p.options:=p.options+[poRunIdle]; // needed to run the RUNIDLE event.
See User Changes 3.2.0   P.ShowWindow:=SwOptions; 
p.Executable:=exename;  if high(commands)>=0 then   for
i:=low(commands) to high(commands) do   
 p.Parameters.add(commands[i]);  p.timedout:=false;  p.started:=now; 
try    // the core loop of runcommand() variants, originally based on
the "large output" scenario in the wiki, but continously expanded over
5 years.   
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;    if
p.timedout then      result:=false;  finally    p.free;  end;  if
exitstatus<>0 then result:=false;end;                                
     // example use: var s : string;begin  for s in FileList do   
begin       if not RunCommandTimeout('someexe',['-v',s,'--
output','dest\'+s],err,[],swoNone,60) then          begin           
// failed to run or timeout. Set it apart by movefile to a failed
dir.         end      else        begin         // ok, move file to
done directory.        end;    end;end; 
The moving of the files uses winapi movefileex() with several retries
in case the file is locked (getlasterror=32). A bit like many
operations to remove files and directories in fpmkunit are guarded
with retries.

I only tested in on Windows, but most of it should be portable. The
only potential problem is if the process being Terminate()'d cause
problems in p.RunCommandLoop on some targets. It might need extra
checks on e.g. p.running.

----------------------------------------------------------------------
af0815 · 2020-07-10 17:00

thank you for sharing.

but its better a good sample for the wiki ?! i think it will be found
better there.

----------------------------------------------------------------------
marcov · 2020-07-10 20:58

When validated, somebody can add it. I think the forum is better for
early days functionality.

----------------------------------------------------------------------
phuji · 2021-10-07 10:13

Thank you marcov, that is exactly what I am looking for. I have
modified for my own needs and confirm that it runs on Linux (Fedora).
Here is the class I implemented in case that is helpful.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses 
process, Classes, SysUtils; type   { TTimedProcess }  //Code from
marcov  //Link: https://forum.lazarus.freepascal.org/index.php/topic,5
0525.msg368880.html#msg368880   TTimedProcess = class  private   
FProcess: TProcess;    FTimeoutSeconds: Integer;    FTimedOut:
Boolean;    FResponse: string;    FStarted: TDateTime;    procedure
CommandEvent(Sender, Context: TObject; Status: TRunCommandEventCode;
const Message: string);  public    constructor Create(const
ProcessName: string; const Commands: array of string; const
TimeoutSeconds: Integer);    destructor Destroy; override;    property
TimedOut: Boolean read FTimedOut;    property Response: string read
FResponse;    function Run: Boolean;  end; implementation constructor
TTimedProcess.Create(const ProcessName: string; const Commands: array
of string; const TimeoutSeconds: Integer);var  command: string;begin 
FProcess := TProcess.Create(nil);  FTimeoutSeconds := TimeoutSeconds; 
FProcess.Executable := ProcessName;  FProcess.Options := [poRunIdle]; 
FProcess.OnRunCommandEvent := @CommandEvent;  for command in Commands
do    FProcess.Parameters.Add(command);end; destructor
TTimedProcess.Destroy;begin  FProcess.Free;  inherited
Destroy;end; function TTimedProcess.Run: Boolean;var  error: string; 
exitStatus: Integer;begin  FStarted := Now;  FTimedOut := False; 
FResponse := '';  Result := FProcess.RunCommandLoop(FResponse, error,
exitStatus) = 0;  if FTimedOut then Result := False;end; procedure
TTimedProcess.CommandEvent(Sender, Context: TObject; Status:
TRunCommandEventCode; const Message: string);begin  if Status =
RunCommandIdle then  begin    if 24 * 60 * 60 * (Now - FStarted) >
FTimeoutSeconds then    begin      FTimedOut := True;     
FProcess.Terminate(255);      Exit;    end;   
Sleep(FProcess.RunCommandSleepTime);  end;end; end.
[Edited to add code tags :-]