Search code examples
multithreadingdelphiasync-awaitidhttp

Wait for thread execution inside TIdHttpServer's OnCommandGet event handler


My Delphi Berlin app uses TIdHttpServer to get some data from client via HTTP GET, process it and send it back.

All logic is performed within a single event handler: OnCommandGet. The identifier is received in a QueryString, then data will be transformed and returned back to client inside the same OnCommandGet event handler.

Data transformation is implemented in a separate thread which uses PostMessage to inform the main thread that the worker thread completes the execution and the data is ready to be sent back to client.

The data is sent in a AResponseInfo.ContentText property.

My question is:

How do I make OnCommandGet handler wait until the worker thread does its job and sends the pointer to a transformed data, so I can get the value and fire it back in a AResponseInfo.ContentText?


UPDATE Here is the pseudo-code I want to execute:

type
  TMyResponsesArray = array[0..5] of TMyObjectAttributes;
  PMyResponsesArray = ^TMyResponsesArray;

{There will be 6 tasks run in parallel. Tasks' responses
will be stored in the below declared Responses array.}

var
  Responses: TMyResponsesArray;

{Below is a Server handler, which takes the input parameter and calls
a proc which runs 6 threads in parallel. The result of each thread is
stored as an ordered array value. Only when the array is completely
populated, ServerCommandGet may send the response!}

procedure TMainForm.ServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  ObjectId: string;
begin
  ObjectId := ARequestInfo.Params.Values['oid'];
  RunTasksInParallel(ObjectId);
end;

{Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in
parallel. Each of the thread instantiates an object, sets its basic
parameter and fires the method. Each task runs queued. When each thread
completes the job, it sends a WM to the main thread (via ParentHandler
which must accept and process the response.}

procedure TMainForm.RunTasksInParallel(const ObjectId: string);
const
  c: array[0..5] of Byte = (0, 1, 2, 3, 4, 5);
var
  ParentHandle: HWND;
begin

  {running 6 tasks in parallel}
  TTask.Run(
    procedure
    begin
      TParallel.For(Low(c), High(c),
        procedure(index: Integer)
        var
          MyObj: TMyObject;
          i: Byte;
        begin
          i := c[index];
          MyObj := TMyObject.Create;

          try
            MyObj.SetMyParameter := Random(10);
            Responses[i] := MyObj.CallMyMethd(ObjectId);

            TThread.Queue(nil,
              procedure
              begin
                SendMessage(ParentHandle,
                  UM_DATAPACKET, i, Integer(@Responses));
              end);

          finally
            MyObj.Free;
          end;

        end);
    end);
end;

{Now the WM handler. It decreases internal task counter and when
TaskCounter = 0, it means that all tasks finished execution and the
Responses array is fully populated. Then we somehow need to pass the
Response array to the ServerCommandGet and send it back to client...}

procedure TMainForm.OnDataPacket(var Msg: TMessage);
begin
  i := Msg.WParam;
  Responses := PMyResponsesArray(Msg.LParam)^;

  {Skipped for for brevity:
  When ALL tasks have finished execution, the Responses array is FULL.
  Then all array values are wrapped into XML and sent back to initial
  invoker ** ServerCommandGet ** which must send XML to client.}
end;

Solution

  • Your use of a global Responses array is not safe, unless you limit TIdHTTPServer to allow only 1 connected client at a time. Otherwise, you could potentially have multiple clients sending requests at the same time and overwriting each other's values in the array. Each invokation of ServerCommandGet() should use a local array instead.

    TIdHTTPServer is not designed for the type of asynchronous processing you are attempting to do. ServerCommandGet() must block, as TIdHTTPServer sends a response to the client when the OnCommandGet handler exits, unless the handler sends a response first, which you are not doing. So, regarding your task thread management, I would suggest either:

    1. getting rid of TTask.Run() and have RunTasksInParallel() call TParallel.For() directly.

    2. or at least calling TTask.Wait() on the TTask object that is calling TParallel.For().

    Either way will make RunTasksInParallel() block (and thus make ServerCommandGet() block) until all tasks have finished. Then you can send the response to the client immediately when RunTasksInParallel() exits. You don't need to wait for the tasks to post UM_DATAPACKET to the main thread and round-trip back into TIdHTTPServer. If you are using UM_DATAPACKET for other things, that's fine, but I do not recommend using it for your HTTP processing.

    Try something more like this instead:

    const
      MaxResponses = 6;
    
    type
      TMyResponsesArray = array[0..MaxResponses-1] of TMyObjectAttributes;
    
      {$POINTERMATH ON}
      PMyResponsesArray = ^TMyResponsesArray;
    
    {There will be 6 tasks run in parallel. Tasks' responses
    will be stored in the below declared Responses array.}
    
    procedure TMainForm.ServerCommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    var
      ObjectId: string;
      Responses: TMyResponsesArray;
    begin
      ObjectId := ARequestInfo.Params.Values['oid'];
      RunTasksInParallel(ObjectId, @Responses);
      {ALL tasks have finished execution, the Responses array is FULL.
      Wrap all array values into XML and send it back to the client.}
    end;
    
    {Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in
    parallel. Each of the thread instantiates an object, sets its basic
    parameter and fires the method.}
    
    procedure TMainForm.RunTasksInParallel(const ObjectId: string; Responses: PMyResponsesArray);
    begin
      {running 6 tasks in parallel}
      TParallel.For(0, MaxResponses-1,
        procedure(index: Integer)
        var
          MyObj: TMyObject;
        begin
          MyObj := TMyObject.Create;
          try
            MyObj.SetMyParameter := Random(10);
            Responses[index] := MyObj.CallMyMethd(ObjectId);
          finally
            MyObj.Free;
          end;
        end
      );
    end;
    

    I would also not recommend doing the database updates in the main thread, either. If you can't update the database directly in ServerCommandGet(), or directly in the individual task threads, then I would suggest having a separate thread dedicated for database updates that you post to as needed. Stay out of the main thread as much as possible.