fphttpclient: remove OnIdle and add protected methods so that the feature can be added in a descendant

packages/fcl-web/src/base/fphttpclient.pp

@@ -19,7 +19,7 @@ unit fphttpclient;
 interface
 
 uses
-  Classes, SysUtils, ssockets, httpdefs, uriparser, base64, sslsockets, DateUtils;
+  Classes, SysUtils, ssockets, httpdefs, uriparser, base64, sslsockets;
 
 Const
   // Socket Read buffer size
@@ -74,7 +74,6 @@ Type
     FKeepConnectionReconnectLimit: Integer;
     FMaxChunkSize: SizeUInt;
     FMaxRedirects: Byte;
-    FOnIdle: TNotifyEvent;
     FOnDataReceived: TDataEvent;
     FOnDataSent: TDataEvent;
     FOnHeaders: TNotifyEvent;
@@ -133,10 +132,6 @@ Type
     Function ProxyActive : Boolean;
     // Override this if you want to create a custom instance of proxy.
     Function CreateProxyData : TProxyData;
-    // Called before data is read.
-    Procedure DoBeforeDataRead; virtual;
-    // Called when the client is waiting for the server.
-    Procedure DoOnIdle;
     // Called whenever data is read.
     Procedure DoDataRead; virtual;
     // Called whenever data is written.
@@ -145,6 +140,10 @@ Type
     Function ParseStatusLine(AStatusLine : String) : Integer;
     // Construct server URL for use in request line.
     function GetServerURL(URI: TURI): String;
+    // Read raw data from socket
+    Function ReadFromSocket(var Buffer; Count: Longint): Longint; virtual;
+    // Write raw data to socket
+    Function WriteToSocket(const Buffer; Count: Longint): Longint; virtual;
     // Read 1 line of response. Fills FBuffer
     function ReadString(out S: String): Boolean;
     // Write string
@@ -300,6 +299,8 @@ Type
     // Has Terminate been called ?
     Property Terminated : Boolean Read FTerminated;
   Protected
+    // Socket
+    Property Socket : TInetSocket read FSocket;
     // Timeouts
     Property IOTimeout : Integer read FIOTimeout write SetIOTimeout;
     Property ConnectTimeout : Integer read FConnectTimeout write SetConnectTimeout;
@@ -353,8 +354,6 @@ Type
     Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
     // Called whenever data is read from the connection.
     Property OnDataReceived : TDataEvent Read FOnDataReceived Write FOnDataReceived;
-    // Called when the client is waiting for the server
-    Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdle;
     // Called whenever data is written to the connection.
     Property OnDataSent : TDataEvent Read FOnDataSent Write FOnDataSent;
     // Called when headers have been processed.
@@ -390,7 +389,6 @@ Type
     Property OnPassword;
     Property OnDataReceived;
     Property OnDataSent;
-    Property OnIdle;
     Property OnHeaders;
     Property OnGetSocketHandler;
     Property Proxy;
@@ -700,24 +698,13 @@ begin
   FreeAndNil(FSocket);
 end;
 
-procedure TFPCustomHTTPClient.DoBeforeDataRead;
+function TFPCustomHTTPClient.ReadFromSocket(var Buffer; Count: Longint): Longint;
-var
-  BreakUTC: TDateTime;
 begin
-  // Use CanRead to keep the client responsive in case the server needs a lot of time to respond.
+  Result:=FSocket.Read(Buffer,Count)
-  // The request can be terminated in OnIdle - therefore it makes sense only if FOnIdle is set
+end;
-  If not Assigned(FOnIdle) Then
+function TFPCustomHTTPClient.WriteToSocket(const Buffer; Count: Longint): Longint;
-    Exit;
+begin
-  if IOTimeout>0 then
+  Result:=FSocket.Write(Buffer,Count)
-    BreakUTC := IncMilliSecond(NowUTC, IOTimeout);
-  while not Terminated and not FSocket.CanRead(10) and (FSocket.LastError=0) do
-    begin
-    DoOnIdle;
-    if (IOTimeout>0) and (CompareDateTime(NowUTC, BreakUTC)>0) then // we exceeded the timeout -> read error
-      Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
-    end;
-  if FSocket.LastError<>0 then
-    Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
 end;
 
 function TFPCustomHTTPClient.AllowHeader(var AHeader: String): Boolean;
@@ -811,11 +798,10 @@ function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
     R : Integer;
 
   begin
-    DoBeforeDataRead;
     if Terminated then
       Exit(False);
     SetLength(FBuffer,ReadBufLen);
-    r:=FSocket.Read(FBuffer[1],ReadBufLen);
+    r:=ReadFromSocket(FBuffer[1],ReadBufLen);
     If (r=0) or Terminated Then
       Exit(False);
     If (r<0) then
@@ -884,7 +870,7 @@ begin
 
   T:=0;
   Repeat
-     r:=FSocket.Write(S[t+1],Length(S)-t);
+     r:=WriteToSocket(S[t+1],Length(S)-t);
      inc(t,r);
      DoDataWrite;
   Until Terminated or (t=Length(S)) or (r<=0);
@@ -919,7 +905,7 @@ begin
        begin
          T:=0;
          Repeat
-           w:=FSocket.Write(PByte(Buffer)[t],i-t);
+           w:=WriteToSocket(PByte(Buffer)[t],i-t);
            FRequestDataWritten:=FRequestDataWritten+w;
            DoDataWrite;
            inc(t,w);
@@ -1153,10 +1139,9 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
   Function Transfer(LB : Integer) : Integer;
 
   begin
-    DoBeforeDataRead;
     if Terminated then
       Exit(0);
-    Result:=FSocket.Read(FBuffer[1],LB);
+    Result:=ReadFromSocket(FBuffer[1],LB);
     If Result<0 then
       Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
     if (Result>0) then
@@ -1187,11 +1172,10 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
 
     begin
       Result:=False;
-      DoBeforeDataRead;
       If Terminated then
         exit;
       SetLength(FBuffer,ReadBuflen);
-      Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
+      Cnt:=ReadFromSocket(FBuffer[1],length(FBuffer));
       If Cnt<0 then
         Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
       SetLength(FBuffer,Cnt);
@@ -1392,12 +1376,6 @@ begin
   End;
 end;
 
-procedure TFPCustomHTTPClient.DoOnIdle;
-begin
-  If Assigned(FOnIdle) Then
-    FOnIdle(Self);
-end;
-
 Procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI;
   const AMethod: string; AStream: TStream;
   const AAllowedResponseCodes: array of Integer;

packages/fcl-web/src/base/fphttpclientasyncpool.pas

@@ -180,7 +180,6 @@ type
 
     procedure OnDataReceived(Sender: TObject; const aContentLength, aCurrentPos: Int64);
     procedure OnDataSent(Sender: TObject; const aContentLength, aCurrentPos: Int64);
-    procedure OnIdle(Sender: TObject);
 
     // the ExecOn* methods call their DoOn* counterparts - do the synchronisation here
     procedure ExecOnInit;
@@ -253,6 +252,7 @@ type
   protected
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 
+    function CreatePool: TFPCustomHTTPClientPool; virtual;
     function CreateRequestThread(aRequest: TFPHTTPClientAsyncPoolRequest; aClient: TFPHTTPClient): TFPHTTPClientAsyncPoolRequestThread; virtual;
     function CreateWaitForAllRequestsThread(const aOnAllDone: TNotifyEvent; const aSynchronizeOnAllDone: Boolean;
       const aOwner: TComponent; const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolWaitForAllThread; virtual;
@@ -366,6 +366,7 @@ begin
   inherited OwnerDestroyed;
 
   fOwner := nil;
+  fOnAllDone := nil;
 end;
 
 { TFPHTTPClientAsyncPoolThread }
@@ -601,6 +602,11 @@ begin
   InterlockedIncrement(fBlockRequestsCounter);
 end;
 
+function TFPCustomHTTPClientAsyncPool.CreatePool: TFPCustomHTTPClientPool;
+begin
+  Result := TFPCustomHTTPClientPool.Create(Self);
+end;
+
 function TFPCustomHTTPClientAsyncPool.CreateRequestThread(aRequest: TFPHTTPClientAsyncPoolRequest;
   aClient: TFPHTTPClient): TFPHTTPClientAsyncPoolRequestThread;
 begin
@@ -618,7 +624,7 @@ constructor TFPCustomHTTPClientAsyncPool.Create(AOwner: TComponent);
 begin
   fWorkingThreads := TThreadList.Create;
   fWaitingQueue := TList.Create;
-  fHttpPool := TFPCustomHTTPClientPool.Create(Self);
+  fHttpPool := CreatePool;
   fDoOnAbortedFinishSynchronizedCS := TCriticalSection.Create;
 
   inherited Create(AOwner);
@@ -986,12 +992,6 @@ begin
   OnDataReceivedSend(Sender, pdDataSent, aContentLength, aCurrentPos);
 end;
 
-procedure TFPHTTPClientAsyncPoolRequestThread.OnIdle(Sender: TObject);
-begin
-  if Terminated then
-    (Sender as TFPCustomHTTPClient).Terminate;
-end;
-
 procedure TFPHTTPClientAsyncPoolRequestThread.OwnerDestroyed;
 begin
   inherited;
@@ -1026,47 +1026,19 @@ begin
 end;
 
 procedure TFPHTTPClientAsyncPoolRequestThread.ExecOnFinish;
-var
-  xUnlocked: Boolean;
 begin
-  xUnlocked := False;
+  if Request.SynchronizeOnFinish then
-  LockProperties;
+    Synchronize(@DoOnFinish)
-  try
+  else
-    if Request.SynchronizeOnFinish then
+    DoOnFinish;
-    begin
-      UnlockProperties;
-      xUnlocked := True;
-      Synchronize(@DoOnFinish)
-    end
-    else
-      DoOnFinish;
-  finally
-    if not xUnlocked then
-      UnlockProperties;
-  end;
 end;
 
 procedure TFPHTTPClientAsyncPoolRequestThread.ExecOnInit;
-var
-  xUnlocked: Boolean;
 begin
-  xUnlocked := False;
+  if Request.SynchronizeOnInit then
-  LockProperties;
+    Synchronize(@DoOnInit)
-  try
+  else
-    if not Assigned(Request.OnInit) then
+    DoOnInit;
-      Exit;
-
-    if Request.SynchronizeOnInit then
-    begin
-      UnlockProperties;
-      xUnlocked := True;
-      Synchronize(@DoOnInit);
-    end else
-      DoOnInit;
-  finally
-    if not xUnlocked then
-      UnlockProperties;
-  end;
 end;
 
 procedure TFPHTTPClientAsyncPoolRequestThread.ExecOnProgress(const aDirection: TFPHTTPClientPoolProgressDirection;
@@ -1079,61 +1051,63 @@ procedure TFPHTTPClientAsyncPoolRequestThread.Execute;
 begin
   // don't LockProperties here - Request.Headers/ContentType/URLData/Method/URL/ResponseStream/AllowedResponseCodes are read-only
   try
-    fClient.ConnectTimeout := Request.ConnectTimeout;
-    fClient.IOTimeout := Request.IOTimeout;
-
-    fClient.RequestHeaders.Text := Request.Headers;
-    if Request.ContentType<>'' then
-      fClient.AddHeader(fClient.RequestHeaders, HeaderContentType, Request.ContentType);
-    if Length(Request.URLData)>0 then
-      fClient.RequestBody := TBytesStream.Create(Request.URLData);
-
-    ExecOnInit;
-
-    fClient.OnDataReceived := @OnDataReceived;
-    fClient.OnDataSent := @OnDataSent;
-    fClient.OnIdle := @OnIdle;
-
-    if Terminated then
-    begin
-      fResult.MethodResult := mrAbortedByClient;
-      Exit;
-    end;
-
     try
-      fClient.HTTPMethod(Request.Method, Request.URL, fResult.ResponseStream, Request.AllowedResponseCodes);
+      fClient.ConnectTimeout := Request.ConnectTimeout;
-    finally
+      fClient.IOTimeout := Request.IOTimeout;
-      fClient.RequestBody.Free;
+
-      fClient.RequestBody := nil;
+      fClient.RequestHeaders.Text := Request.Headers;
+      if Request.ContentType<>'' then
+        fClient.AddHeader(fClient.RequestHeaders, HeaderContentType, Request.ContentType);
+      if Length(Request.URLData)>0 then
+        fClient.RequestBody := TBytesStream.Create(Request.URLData);
+
+      ExecOnInit;
+
+      fClient.OnDataReceived := @OnDataReceived;
+      fClient.OnDataSent := @OnDataSent;
+
+      if Terminated then
+      begin
+        fResult.MethodResult := mrAbortedByClient;
+        Exit;
+      end;
+
+      try
+        fClient.HTTPMethod(Request.Method, Request.URL, fResult.ResponseStream, Request.AllowedResponseCodes);
+      finally
+        fClient.RequestBody.Free;
+        fClient.RequestBody := nil;
+      end;
+      fResult.ResponseStream.Position := 0;
+      if Terminated then
+      begin
+        fResult.MethodResult := mrAbortedByClient;
+      end else
+      begin
+        fResult.MethodResult := mrSuccess;
+        fResult.ResponseStatusCode := fClient.ResponseStatusCode;
+        fResult.ResponseStatusText := fClient.ResponseStatusText;
+        fResult.ResponseHeaders.Assign(fClient.ResponseHeaders);
+      end;
+    except
+      on E: TObject do
+      begin
+        if Terminated then // client terminated the connection -> it has priority above mrAbortedWithException
+          fResult.MethodResult := mrAbortedByClient
+        else
+          fResult.MethodResult := mrAbortedWithException;
+        fResult.ExceptionClass := E.ClassType;
+        if E is Exception then
+          fResult.ExceptionMessage := Exception(E).Message;
+      end;
     end;
-    fResult.ResponseStream.Position := 0;
+  finally
-    if Terminated then
+    try
-    begin
+      Pool.ReleaseClient(Request.URL, fClient);
-      fResult.MethodResult := mrAbortedByClient;
+      fClient := nil; // do not use fClient - it doesn't belong here anymore
-    end else
+      ExecOnFinish;
-    begin
+    except
-      fResult.MethodResult := mrSuccess;
-      fResult.ResponseStatusCode := fClient.ResponseStatusCode;
-      fResult.ResponseStatusText := fClient.ResponseStatusText;
-      fResult.ResponseHeaders.Assign(fClient.ResponseHeaders);
     end;
-  except
-    on E: TObject do
-    begin
-      if Terminated then // client terminated the connection -> it has priority above mrAbortedWithException
-        fResult.MethodResult := mrAbortedByClient
-      else
-        fResult.MethodResult := mrAbortedWithException;
-      fResult.ExceptionClass := E.ClassType;
-      if E is Exception then
-        fResult.ExceptionMessage := Exception(E).Message;
-    end;
-  end;
-  try
-    Pool.ReleaseClient(Request.URL, fClient);
-    fClient := nil; // do not use fClient - it doesn't belong here anymore
-    ExecOnFinish;
-  except
   end;
 end;