Recent

Author Topic: Tprocess - How to time out while sending data to stdin?  (Read 4206 times)

fedkad

  • Full Member
  • ***
  • Posts: 176
Tprocess - How to time out while sending data to stdin?
« on: August 04, 2021, 04:41:41 pm »
I am currently trying to implement calling a process and communicating with it using pipes. The algorithm is something like this:

Code: Pascal  [Select][+][-]
  1. var
  2.   P : TProcess;
  3.   outstr : String = '';
  4.   errstr : String = '';
  5.   buf : Array [0..BUFSIZ-1] of char;
  6.   oc, ec, maxoc, maxec,
  7.   i  : Integer;
  8.   exitcode : Integer = 0;
  9.   stime : QWord;  
  10. begin
  11.  (*...*)
  12.   P := TProcess.Create(Nil);  
  13.   try
  14.     P.Options := P.Options+[poUsePipes,poNoConsole];
  15.     P.Executable:= CmdFileName;
  16.     for i:=low(pars) to high(pars) do
  17.       P.Parameters.add(pars[i]);
  18.     P.Execute;
  19.     if instr <> '' then
  20.       P.Input.Write(instr[1], Length(instr));
  21.     P.CloseInput;
  22.     P.WaitOnExit(1000);
  23.     oc:=0;  maxoc := 500000;
  24.     ec:=0;  maxec := 200;
  25.     stime := GetTickCount64;
  26.     while p.Running or (p.output.NumBytesAvailable>0) or (p.stderr.NumBytesAvailable>0) do
  27.     begin
  28.       if p.output.NumBytesAvailable>0 then
  29.       begin
  30.         i := min(BUFSIZ,p.output.NumBytesAvailable);
  31.         p.output.read(buf,i);
  32.         if oc<maxoc then
  33.           outstr := outstr + copy(buf,0,i);
  34.         oc := oc+i;
  35.       end;
  36.       if p.stderr.NumBytesAvailable>0 then
  37.       begin
  38.         i := min(BUFSIZ,p.stderr.NumBytesAvailable);
  39.         p.stderr.read(buf,i);
  40.         if ec<maxec then
  41.           errstr := errstr + copy(buf,0,i);
  42.         ec := ec+i;
  43.       end;
  44.       if (GetTickCount64-stime)>4000 then break;
  45.     end;
  46.     (* *)
  47.     P.Terminate(exitcode);
  48.     if exitcode=0 then
  49.       exitcode := p.exitcode;
  50.   except
  51.     on E: Exception do
  52.     begin
  53.       errstr := E.Message + eol + CmdFileName;
  54.       exitcode := -1;
  55.     end;
  56.   end;
  57.   P.Free;
  58.   (* ... *)
  59.  
       

As you see, I am trying to read stdout and stderr in a loop and if the calling process does not finish writing these outputs in a specific time period (4 secs) I am timing out and exiting the "read loop."

However, I cannot do something similar while sending large amount of data to stdin of the called process. For example, I "P.Input.Write" (@line 20) a large amount of data and the called process does not even bother to read this data, my program hangs indefinitely, until I kill the called process. How can I gracefully time out in such a case?
Lazarus 2.2.6 / FPC 3.2.2 on x86_64-linux-gtk2 (Ubuntu/GNOME) and x86_64-win64-win32/win64 (Windows 11)

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: Tprocess - How to time out while sending data to stdin?
« Reply #1 on: August 04, 2021, 05:05:08 pm »
Look at the body of runcommandloop and its applications, e.g.

https://forum.lazarus.freepascal.org/index.php/topic,50525.msg368880.html#msg368880
« Last Edit: August 04, 2021, 05:08:17 pm by marcov »

fedkad

  • Full Member
  • ***
  • Posts: 176
Re: Tprocess - How to time out while sending data to stdin?
« Reply #2 on: August 04, 2021, 05:27:34 pm »
@marcov

In my case, the problem is that the call P.Input.Write(...); (@line 20) hangs. I need a method to time out this call or something similar to NumBytesAvailable in output and stderr.
« Last Edit: August 04, 2021, 05:29:49 pm by fedkad »
Lazarus 2.2.6 / FPC 3.2.2 on x86_64-linux-gtk2 (Ubuntu/GNOME) and x86_64-win64-win32/win64 (Windows 11)

rsz

  • New Member
  • *
  • Posts: 45
Re: Tprocess - How to time out while sending data to stdin?
« Reply #3 on: August 04, 2021, 08:44:52 pm »
I'd outsource the process interaction into a separate thread (and class) and periodically check the current processing status in the main thread and if it's stuck too long on the same status then just kill the child process from the main thread and let the pipe break (SIGPIPE exception is raised on Linux, can't say for Windows).

Here's a program that reproduces the hang when writing more than 256 bytes to it:
Code: Pascal  [Select][+][-]
  1. program Hang;
  2.  
  3. uses Classes, sysutils, iostream;
  4.  
  5. var
  6.   Stream: TIOStream;
  7.   I: Integer;
  8.   B: Byte;
  9. begin
  10.   Stream := TIOStream.Create(iosInput);
  11.   try
  12.     // read first 256 bytes form stdin
  13.     for I := 1 to 256 do
  14.     begin
  15.       B := Stream.ReadByte;
  16.       WriteLn(Chr(B));
  17.     end;
  18.     // hang indefinitely
  19.     while True do
  20.     begin
  21.       Sleep(1000);
  22.     end;
  23.   finally
  24.     Stream.Free;
  25.   end;
  26. end.

and here's a program that uses a thread and kills the child process and gracefully waits for the thread and frees it. Change the line marked CHANGEME to the above program that hangs.
Code: Pascal  [Select][+][-]
  1. program project1;
  2.  
  3. uses
  4.   {$ifdef UNIX}
  5.   cthreads, cmem, BaseUnix,
  6.   {$endif}
  7.   {$ifdef WINDOWS}
  8.   // uses for WINAPI
  9.   {$endif}
  10.   Classes, sysutils, Process, syncobjs
  11.   ;
  12.  
  13. type
  14.   TMyThread = class(TThread)
  15.   private
  16.     FCriticalSection: TCriticalSection;
  17.     FProcessId: Integer;
  18.   public
  19.     constructor Create;
  20.     destructor Destroy; override;
  21.     procedure Execute; override;
  22.     function GetProcessId: Integer;
  23.     procedure SetProcessId(Value: Integer);
  24.     property ProcessId: Integer read GetProcessId write SetProcessId;
  25.   end;
  26.  
  27. constructor TMyThread.Create;
  28. begin
  29.   inherited Create(True);   // start suspended, we want to manually start it
  30.   FreeOnTerminate := False; // we want to manually free it
  31.   FProcessId := -1;
  32.   FCriticalSection := TCriticalSection.Create;
  33. end;
  34.  
  35. destructor TMyThread.Destroy;
  36. begin
  37.   FCriticalSection.Free;
  38.   inherited;
  39. end;
  40.  
  41. function TMyThread.GetProcessId: Integer;
  42. begin
  43.   // use critical section to prevent race conditions
  44.   FCriticalSection.Acquire;
  45.   try
  46.     Result := FProcessId;
  47.   finally
  48.     FCriticalSection.Release;
  49.   end;
  50. end;
  51.  
  52. procedure TMyThread.SetProcessId(Value: Integer);
  53. begin
  54.   // use critical section to prevent race conditions
  55.   FCriticalSection.Acquire;
  56.   try
  57.     FProcessId := Value;
  58.   finally
  59.     FCriticalSection.Release;
  60.   end;
  61. end;
  62.  
  63. procedure TMyThread.Execute;
  64. var
  65.   P : TProcess;
  66.   InStr: String;
  67.   I: Integer;
  68. begin
  69.   P := TProcess.Create(Nil);
  70.   try
  71.     InStr := '';
  72.     SetLength(InStr, 1024000);
  73.     for I := Low(InStr) to High(InStr) do
  74.     begin
  75.       InStr[I] := 'A';
  76.     end;
  77.     P.Options := P.Options+[poUsePipes,poNoConsole];
  78.     P.Executable:= '/path/to/program/hang'; // CHANGE ME
  79.     P.Execute;
  80.     ProcessId := P.ProcessId;
  81.     P.Input.Write(instr[1], Length(instr));
  82.     P.CloseInput;
  83.     P.WaitOnExit;
  84.   finally
  85.     P.Free;
  86.   end;
  87. end;
  88.  
  89. procedure KillProcessById(PID: Integer);
  90. begin
  91.   if PID = -1 then
  92.     raise Exception.Create('Invalid PID...');
  93.   {$ifdef WINDOWS}
  94.   // implement for windows with WINAPI function to kill process
  95.   {$endif}
  96.   {$ifdef UNIX}
  97.   FpKill(PID, SIGKILL);
  98.   {$endif}
  99. end;
  100.  
  101. var
  102.   T: TMyThread;
  103. begin
  104.   T := TMyThread.Create;
  105.   try
  106.     T.Start;
  107.     Sleep(3000);
  108.     KillProcessById(T.ProcessId);
  109.     T.WaitFor;
  110.   finally
  111.     T.Free;
  112.   end;
  113. end.

As is with threads, care should be taken when accessing shared memory from multiple threads and care should also be taken if you decide to kill them.

Implementing this in a non blocking read/write way without threading may also be possible, but could require changing the internals of TProcess and the streams it uses.

Edson

  • Hero Member
  • *****
  • Posts: 1301
Re: Tprocess - How to time out while sending data to stdin?
« Reply #4 on: August 04, 2021, 10:01:32 pm »
I would recommend https://github.com/t-edson/UnTerminal

It's a wrapper for a wrapper for TProcess with prompt detection and event driven.
Lazarus 2.2.6 - FPC 3.2.2 - x86_64-win64 on Windows 10

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: Tprocess - How to time out while sending data to stdin?
« Reply #5 on: August 04, 2021, 10:05:49 pm »
@marcov

In my case, the problem is that the call P.Input.Write(...); (@line 20) hangs. I need a method to time out this call or something similar to NumBytesAvailable in output and stderr.

Yeah. Probably you need to switch to async I/O (writefile with overlapped record as param and then waitmultiple() on the result). On *nix iirc async I/O is done using the aio_write etc functions, but I don't know the details.

Would be a pretty big rewrite of the pipes unit.

fedkad

  • Full Member
  • ***
  • Posts: 176
Re: Tprocess - How to time out while sending data to stdin?
« Reply #6 on: August 06, 2021, 12:57:31 pm »
Would be a pretty big rewrite of the pipes unit.

Yes. But, I am not going to do such a thing.

It seems that the Tprocess.Input "output pipe stream" is missing something like, I would say, a "symmetrical" property that the Tprocess.Output or Tprocess.StdErr "input pipe streams" do have: Similar to the NumBytesAvailable property (the number of bytes available for reading from the input pipe stream), we should have something like a NumBytesAvailable property (the number of bytes available for writing to the output pipe stream without the Write function blocking). This should be 0 when the pipe is full and the size of pipe when the called program has completely read everything from the pipe and waiting for more input.

Then, the calling program will be able to write as much as (but, not more than) the amount indicated in the NumBytesAvailable property and will wait until some space is freed in the pipe before writing more. In such a scenario, it would be very easy to time out such an operation, if the called program does not read data from its input pipe for a certain amount of time.
« Last Edit: August 06, 2021, 01:31:00 pm by fedkad »
Lazarus 2.2.6 / FPC 3.2.2 on x86_64-linux-gtk2 (Ubuntu/GNOME) and x86_64-win64-win32/win64 (Windows 11)

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: Tprocess - How to time out while sending data to stdin?
« Reply #7 on: August 06, 2021, 03:19:27 pm »
It seems that the Tprocess.Input "output pipe stream" is missing something like, I would say, a "symmetrical" property that the Tprocess.Output or Tprocess.StdErr "input pipe streams" do have: Similar to the NumBytesAvailable property (the number of bytes available for reading from the input pipe stream), we should have something like a NumBytesAvailable property (the number of bytes available for writing to the output pipe stream without the Write function blocking). This should be 0 when the pipe is full and the size of pipe when the called program has completely read everything from the pipe and waiting for more input.

At least on Windows the pipes used for inter process communication do not provide this functionality, thus FPC's TOutputPipeStream can't provide it either.

fedkad

  • Full Member
  • ***
  • Posts: 176
Re: Tprocess - How to time out while sending data to stdin?
« Reply #8 on: August 06, 2021, 03:29:25 pm »
At least on Windows the pipes used for inter process communication do not provide this functionality, thus FPC's TOutputPipeStream can't provide it either.

 :( That was something I was afraid of.

As another workaround, is there any possibility to automatically kill the called process after a certain amount of time passes (say 4 seconds of timeout in my case), so that any blocked Write function to the "output pipe stream" gets released? (Without resorting to multi-threaded programming.)
Lazarus 2.2.6 / FPC 3.2.2 on x86_64-linux-gtk2 (Ubuntu/GNOME) and x86_64-win64-win32/win64 (Windows 11)

 

TinyPortal © 2005-2018