Recent

Author Topic: Runcommand/Tprocess with timeout  (Read 301 times)

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 8733
  • FPC developer.
Runcommand/Tprocess with timeout
« on: July 10, 2020, 06:32:40 pm »
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][+][-]
  1. {$mode delphi}
  2. uses classes,sysutils,process,dateutils;
  3. Type
  4. { TProcessTimeout }
  5.  TProcessTimeout = class(TProcess)
  6.                             public
  7.                             timeoutperiod: TTime;
  8.                             timedout : boolean;
  9.                             started : TDateTime;
  10.                             procedure LocalnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
  11.                           end;
  12.  
  13. procedure TProcessTimeout.LocalnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
  14. begin
  15.    if status=RunCommandIdle then
  16.     begin
  17.       if (now-started)>timeoutperiod then
  18.          begin
  19.            timedout:=true;
  20.            Terminate(255);
  21.            exit;
  22.          end;
  23.       sleep(RunCommandSleepTime);
  24.     end;
  25. end;
  26.  
  27. function RunCommandTimeout(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone;timeout:integer=60):boolean;
  28. Var
  29.     p : TProcessTimeout;
  30.     i,
  31.     exitstatus : integer;
  32.     ErrorString : String;
  33. begin
  34.   p:=TProcessTimeout.create(nil);
  35.   p.OnRunCommandEvent:=p.LocalnIdleSleep;
  36.   p.timeoutperiod:=timeout/SecsPerDay;
  37.   if Options<>[] then
  38.     P.Options:=Options - [poRunSuspended,poWaitOnExit];
  39.   p.options:=p.options+[poRunIdle]; // needed to run the RUNIDLE event. See User Changes 3.2.0
  40.  
  41.   P.ShowWindow:=SwOptions;
  42.   p.Executable:=exename;
  43.   if high(commands)>=0 then
  44.    for i:=low(commands) to high(commands) do
  45.      p.Parameters.add(commands[i]);
  46.   p.timedout:=false;
  47.   p.started:=now;
  48.   try
  49.     // the core loop of runcommand() variants, originally based on the "large output" scenario in the wiki, but continously expanded over 5 years.
  50.     result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
  51.     if p.timedout then
  52.       result:=false;
  53.   finally
  54.     p.free;
  55.   end;
  56.   if exitstatus<>0 then result:=false;
  57. end;                                      
  58.  
  59. // example use:
  60.  
  61. var s : string;
  62. begin
  63.   for s in FileList do
  64.     begin
  65.        if not RunCommandTimeout('someexe',['-v',s,'--output','dest\'+s],err,[],swoNone,60) then
  66.           begin
  67.             // failed to run or timeout. Set it apart by movefile to a failed dir.
  68.          end
  69.       else
  70.         begin
  71.          // ok, move file to done directory.
  72.         end;
  73.     end;
  74. end;
  75.  

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

  • Hero Member
  • *****
  • Posts: 582
Re: Runcommand/Tprocess with timeout
« Reply #1 on: July 10, 2020, 07:00:43 pm »
thank you for sharing.

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

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 8733
  • FPC developer.
Re: Runcommand/Tprocess with timeout
« Reply #2 on: July 10, 2020, 10:58:59 pm »
When validated, somebody can add it. I think the forum is better for early days functionality.

 

TinyPortal © 2005-2018