Browse Source

* http client: KeepConnectionReconnectLimit to prevent a dead-lock when a server is not available

Ondrej Pokorny 4 years ago
parent
commit
14dd153736
1 changed files with 18 additions and 4 deletions
  1. 18 4
      packages/fcl-web/src/base/fphttpclient.pp

+ 18 - 4
packages/fcl-web/src/base/fphttpclient.pp

@@ -71,6 +71,7 @@ Type
     FRequestContentLength : Int64;
     FRequestContentLength : Int64;
     FAllowRedirect: Boolean;
     FAllowRedirect: Boolean;
     FKeepConnection: Boolean;
     FKeepConnection: Boolean;
+    FKeepConnectionReconnectLimit: Integer;
     FMaxChunkSize: SizeUInt;
     FMaxChunkSize: SizeUInt;
     FMaxRedirects: Byte;
     FMaxRedirects: Byte;
     FOnIdle: TNotifyEvent;
     FOnIdle: TNotifyEvent;
@@ -340,6 +341,8 @@ Type
     Property Connected: Boolean read IsConnected;
     Property Connected: Boolean read IsConnected;
     // Keep-Alive support. Setting to true will set HTTPVersion to 1.1
     // Keep-Alive support. Setting to true will set HTTPVersion to 1.1
     Property KeepConnection: Boolean Read FKeepConnection Write SetKeepConnection;
     Property KeepConnection: Boolean Read FKeepConnection Write SetKeepConnection;
+    // Maximum reconnect attempts during one request. -1=unlimited, 0=don't try to reconnect
+    Property KeepConnectionReconnectLimit: Integer Read FKeepConnectionReconnectLimit Write FKeepConnectionReconnectLimit;
     // SSL certificate validation.
     // SSL certificate validation.
     Property VerifySSLCertificate : Boolean Read FVerifySSLCertificate Write FVerifySSLCertificate;
     Property VerifySSLCertificate : Boolean Read FVerifySSLCertificate Write FVerifySSLCertificate;
     // Called On redirect. Dest URL can be edited.
     // Called On redirect. Dest URL can be edited.
@@ -1401,10 +1404,11 @@ Var
   T: Boolean;
   T: Boolean;
   CHost: string;
   CHost: string;
   CPort: Word;
   CPort: Word;
-
+  A: Integer;
 begin
 begin
   ExtractHostPort(AURI, CHost, CPort);
   ExtractHostPort(AURI, CHost, CPort);
   T := False;
   T := False;
+  A := 0;
   Repeat
   Repeat
     If Not IsConnected Then
     If Not IsConnected Then
       ConnectToServer(CHost,CPort,AIsHttps);
       ConnectToServer(CHost,CPort,AIsHttps);
@@ -1419,13 +1423,22 @@ begin
       except
       except
         on E: EHTTPClientSocket do
         on E: EHTTPClientSocket do
         begin
         begin
-          // failed socket operations raise exceptions - e.g. if ReadString() fails
-          // try to reconnect also in this case
-          T:=False;
+          if ((FKeepConnectionReconnectLimit>=0) and (A>=KeepConnectionReconnectLimit)) then
+            raise // reconnect limit is reached -> reraise
+          else
+            begin
+            // failed socket operations raise exceptions - e.g. if ReadString() fails
+            // this can be due to a closed keep-alive connection by the server
+            // -> try to reconnect
+            T:=False;
+            end;
         end;
         end;
       end;
       end;
+      if (FKeepConnectionReconnectLimit>=0) and (A>=KeepConnectionReconnectLimit) then
+        break; // reconnect limit is reached -> exit
       If Not T and Not Terminated Then
       If Not T and Not Terminated Then
         ReconnectToServer(CHost,CPort,AIsHttps);
         ReconnectToServer(CHost,CPort,AIsHttps);
+      Inc(A);
     Finally
     Finally
       // On terminate, we close the request
       // On terminate, we close the request
       If HasConnectionClose or Terminated Then
       If HasConnectionClose or Terminated Then
@@ -1462,6 +1475,7 @@ begin
   // Infinite timeout on most platforms
   // Infinite timeout on most platforms
   FIOTimeout:=0;
   FIOTimeout:=0;
   FConnectTimeout:=3000;
   FConnectTimeout:=3000;
+  FKeepConnectionReconnectLimit:=1;
   FRequestHeaders:=TStringList.Create;
   FRequestHeaders:=TStringList.Create;
   FRequestHeaders.NameValueSeparator:=':';
   FRequestHeaders.NameValueSeparator:=':';
   FResponseHeaders:=TStringList.Create;
   FResponseHeaders:=TStringList.Create;