View Issue Details

IDProjectCategoryView StatusLast Update
0030788FPCFCLpublic2016-11-18 13:27
Reportersilvioprog Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version3.1.1 
Target Version3.2.0Fixed in Version3.1.1 
Summary0030788: [PATCH] FpHTTPClient: Keep-Alive support
DescriptionHello,

Attached patch (0001-fcl-web-added-keep-alive-support-to-fphttpclient.-pa.patch) implements a simple keep-alive support to FpHttpClient. You can check the keep-alive advantages using the attached demo (keepalivedemo.tar.gz, its main form showed in picture frMain_001.png).
Steps To ReproduceJust apply the git serial patch and rebuild your fcl-web, after that, enjoy the attached demo.
Additional Information@Michael: dude, it seems reconnecting after client/server timeouts. Please let me know if this patch can be applied to trunk. :-)
TagsNo tags attached.
Fixed in Revision34875
FPCOldBugId
FPCTarget
Attached Files

Activities

silvioprog

2016-10-26 03:06

reporter  

keepalivedemo.tar.gz (2,133 bytes)

silvioprog

2016-10-26 03:06

reporter  

0001-fcl-web-added-keep-alive-support-to-fphttpclient.-pa.patch (21,250 bytes)   
From d134ea0e4db72aa85d7d8d5f332f081b2bbf5a5b Mon Sep 17 00:00:00 2001
From: silvioprog <silvioprog@gmail.com>
Date: Tue, 25 Oct 2016 21:36:48 -0300
Subject: [PATCH] fcl-web: added keep-alive support to fphttpclient. (patch by
 Silvio Clecio)

---
 packages/fcl-web/src/base/fphttpclient.pp | 267 ++++++++++++++++++++++--------
 1 file changed, 195 insertions(+), 72 deletions(-)

diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp
index 14a61f0..5189d76 100644
--- a/packages/fcl-web/src/base/fphttpclient.pp
+++ b/packages/fcl-web/src/base/fphttpclient.pp
@@ -70,6 +70,7 @@ Type
     FDataRead : Int64;
     FContentLength : Int64;
     FAllowRedirect: Boolean;
+    FKeepAlive: Boolean;
     FMaxRedirects: Byte;
     FOnDataReceived: TDataEvent;
     FOnHeaders: TNotifyEvent;
@@ -97,11 +98,23 @@ Type
     function GetProxy: TProxyData;
     Procedure ResetResponse;
     Procedure SetCookies(const AValue: TStrings);
+    procedure SetHTTPVersion(const AValue: String);
     procedure SetProxy(AValue: TProxyData);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
+    Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
   protected
     Function NoContentAllowed(ACode : Integer) : Boolean;
+    // Peform a request without keep-alive support
+    Procedure DoNormalRequest(const AURI: TURI; const AMethod: string;
+      AStream: TStream; const AAllowedResponseCodes: array of Integer;
+      AHeadersOnly, AIsHttps: Boolean); virtual;
+    // Peform a request with keep-alive support
+    Procedure DoKeepAliveRequest(const AURI: TURI; const AMethod: string;
+      AStream: TStream; const AAllowedResponseCodes: array of Integer;
+      AHeadersOnly, AIsHttps: Boolean); virtual;
+    // Return True if FSocket is assigned
+    Function IsConnected: Boolean; virtual;
     // True if we need to use a proxy: ProxyData Assigned and Hostname Set
     Function ProxyActive : Boolean;
     // Override this if you want to create a custom instance of proxy.
@@ -113,19 +126,23 @@ Type
     // Construct server URL for use in request line.
     function GetServerURL(URI: TURI): String;
     // Read 1 line of response. Fills FBuffer
-    function ReadString: String;
+    function ReadString(out S: String): Boolean;
     // Check if response code is in AllowedResponseCodes. if not, an exception is raised.
     // If AllowRedirect is true, and the result is a Redirect status code, the result is also true
     // If the OnPassword event is set, then a 401 will also result in True.
     function CheckResponseCode(ACode: Integer;  const AllowedResponseCodes: array of Integer): Boolean; virtual;
     // Read response from server, and write any document to Stream.
-    Procedure ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); virtual;
+    Function ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False): Boolean; virtual;
     // Read server response line and headers. Returns status code.
     Function ReadResponseHeaders : integer; virtual;
     // Allow header in request ? (currently checks only if non-empty and contains : token)
     function AllowHeader(var AHeader: String): Boolean; virtual;
+    // Return True if the "connection: close" header is present
+    Function HasConnectionClose: Boolean; virtual;
     // Connect to the server. Must initialize FSocket.
     Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
+    // Re-connect to the server. Must reinitialize FSocket.
+    Procedure ReconnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
     // Disconnect from server. Must free FSocket.
     Procedure DisconnectFromServer; virtual;
     // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
@@ -254,7 +271,7 @@ Type
     // Optional body to send (mainly in POST request)
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
     // used HTTP version when constructing the request.
-    Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
+    Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
     // After request properties.
     // After request, this contains the headers sent by server.
     Property ResponseHeaders : TStrings Read FResponseHeaders;
@@ -278,6 +295,10 @@ Type
     // They also override any Authenticate: header in Requestheaders.
     Property UserName : String Read FUserName Write FUserName;
     Property Password : String Read FPassword Write FPassword;
+    // Is client connected?
+    Property Connected: Boolean read IsConnected;
+    // Keep-Alive support
+    Property KeepAlive: Boolean Read FKeepAlive Write FKeepAlive;
     // If a request returns a 401, then the OnPassword event is fired.
     // It can modify the username/password and set RepeatRequest to true;
     Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
@@ -293,6 +314,8 @@ Type
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
   Published
+    Property KeepAlive;
+    Property Connected;
     Property IOTimeout;
     Property RequestHeaders;
     Property RequestBody;
@@ -458,6 +481,11 @@ begin
     FSocket.IOTimeout:=AValue;
 end;
 
+function TFPCustomHTTPClient.IsConnected: Boolean;
+begin
+  Result := Assigned(FSocket);
+end;
+
 function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
 begin
   Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
@@ -544,6 +572,8 @@ Var
 
 
 begin
+  If IsConnected Then
+    DisconnectFromServer; // avoid memory leaks
   if (Aport=0) then
     if UseSSL then
       Aport:=443
@@ -561,6 +591,13 @@ begin
   end;
 end;
 
+Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
+  APort: Integer; UseSSL: Boolean);
+begin
+  DisconnectFromServer;
+  ConnectToServer(AHost, APort, UseSSL);
+end;
+
 procedure TFPCustomHTTPClient.DisconnectFromServer;
 
 begin
@@ -573,6 +610,11 @@ begin
   Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
 end;
 
+Function TFPCustomHTTPClient.HasConnectionClose: Boolean;
+begin
+  Result := CompareText(GetHeader('Connection'), 'close') = 0;
+end;
+
 procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
 
 Var
@@ -607,6 +649,14 @@ begin
   S:=S+CRLF;
   If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
     AddHeader('Content-Length',IntToStr(RequestBody.Size));
+  If FKeepAlive Then
+    begin
+    i:=FRequestHeaders.IndexOf('Connection: close');
+    If i>-1 Then
+      FRequestHeaders.Delete(i);
+    end
+  Else
+    AddHeader('Connection', 'close');
   For I:=0 to FRequestHeaders.Count-1 do
     begin
     l:=FRequestHeaders[i];
@@ -634,9 +684,9 @@ begin
     FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
 end;
 
-function TFPCustomHTTPClient.ReadString : String;
+function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
 
-  Procedure FillBuffer;
+  Function FillBuffer: Boolean;
 
   Var
     R : Integer;
@@ -644,38 +694,42 @@ function TFPCustomHTTPClient.ReadString : String;
   begin
     SetLength(FBuffer,ReadBufLen);
     r:=FSocket.Read(FBuffer[1],ReadBufLen);
+    If r=0 Then
+      Exit(False);
     If r<0 then
       Raise EHTTPClient.Create(SErrReadingSocket);
     if (r<ReadBuflen) then
       SetLength(FBuffer,r);
     FDataRead:=FDataRead+R;
     DoDataRead;
+    Result:=r>0;
   end;
 
 Var
-  CheckLF,Done : Boolean;
+  CheckLF: Boolean;
   P,L : integer;
 
 begin
-  Result:='';
-  Done:=False;
+  S:='';
+  Result:=False;
   CheckLF:=False;
   Repeat
     if Length(FBuffer)=0 then
-      FillBuffer;
+      if not FillBuffer then
+        Break;
     if Length(FBuffer)=0 then
-      Done:=True
+      Result:=True
     else if CheckLF then
       begin
       If (FBuffer[1]<>#10) then
-        Result:=Result+#13
+        S:=S+#13
       else
         begin
         System.Delete(FBuffer,1,1);
-        Done:=True;
+        Result:=True;
         end;
       end;
-    if not Done then
+    if not Result then
       begin
       P:=Pos(#13#10,FBuffer);
       If P=0 then
@@ -683,20 +737,21 @@ begin
         L:=Length(FBuffer);
         CheckLF:=FBuffer[L]=#13;
         if CheckLF then
-          Result:=Result+Copy(FBuffer,1,L-1)
+          S:=S+Copy(FBuffer,1,L-1)
         else
-          Result:=Result+FBuffer;
+          S:=S+FBuffer;
         FBuffer:='';
         end
       else
         begin
-        Result:=Result+Copy(FBuffer,1,P-1);
+        S:=S+Copy(FBuffer,1,P-1);
         System.Delete(FBuffer,1,P+1);
-        Done:=True;
+        Result:=True;
         end;
       end;
-  until Done;
+  until Result;
 end;
+
 Function GetNextWord(Var S : String) : string;
 
 Const
@@ -765,11 +820,11 @@ Var
   StatusLine,S : String;
 
 begin
-  StatusLine:=ReadString;
+  if not ReadString(StatusLine) then
+    Exit(0);
   Result:=ParseStatusLine(StatusLine);
   Repeat
-    S:=ReadString;
-    if (S<>'') then
+    if ReadString(S) and (S<>'') then
       begin
       ResponseHeaders.Add(S);
       If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
@@ -877,14 +932,24 @@ begin
   GetCookies.Assign(AValue);
 end;
 
+procedure TFPCustomHTTPClient.SetHTTPVersion(const AValue: String);
+begin
+  if FHTTPVersion = AValue then Exit;
+  FHTTPVersion := AValue;
+  if AValue = '1.0' then
+    FKeepAlive := False
+  else if AValue = '1.1' then
+    FKeepAlive := True;
+end;
+
 procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
 begin
   if (AValue=FProxy) then exit;
   Proxy.Assign(AValue);
 end;
 
-procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
-  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
+Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
+  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
 
   Function Transfer(LB : Integer) : Integer;
 
@@ -1012,6 +1077,9 @@ begin
   FContentLength:=0;
   SetLength(FBuffer,0);
   FResponseStatusCode:=ReadResponseHeaders;
+  Result := FResponseStatusCode > 0;
+  if not Result then
+    Exit;
   if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
     Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
   if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
@@ -1050,13 +1118,76 @@ begin
     end;
 end;
 
-procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
-  Stream: TStream; const AllowedResponseCodes: array of Integer);
+Procedure TFPCustomHTTPClient.ExtractHostPort(AURI: TURI; Out AHost: String;
+  Out APort: Word);
+Begin
+  if ProxyActive then
+    begin
+    AHost:=Proxy.Host;
+    APort:=Proxy.Port;
+    end
+  else
+    begin
+    AHost:=AURI.Host;
+    APort:=AURI.Port;
+    end;
+End;
+
+Procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI;
+  const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer;
+  AHeadersOnly, AIsHttps: Boolean);
 
 Var
-  URI : TURI;
-  P,CHost : String;
-  CPort : Word;
+  CHost: string;
+  CPort: Word;
+
+begin
+  ExtractHostPort(AURI, CHost, CPort);
+  ConnectToServer(CHost,CPort,AIsHttps);
+  Try
+    SendRequest(AMethod,AURI);
+    ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+  Finally
+    DisconnectFromServer;
+  End;
+end;
+
+Procedure TFPCustomHTTPClient.DoKeepAliveRequest(const AURI: TURI;
+  const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer;
+  AHeadersOnly, AIsHttps: Boolean);
+
+Var
+  T: Boolean;
+  CHost: string;
+  CPort: Word;
+
+begin
+  ExtractHostPort(AURI, CHost, CPort);
+  T := False;
+  Repeat
+    If Not IsConnected Then
+      ConnectToServer(CHost,CPort,AIsHttps);
+    Try
+      SendRequest(AMethod,AURI);
+      T := ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+      If Not T Then
+        ReconnectToServer(CHost,CPort,AIsHttps);
+    Finally
+      If HasConnectionClose Then
+        DisconnectFromServer;
+    End;
+  Until T;
+end;
+
+Procedure TFPCustomHTTPClient.DoMethod(Const AMethod, AURL: String;
+  Stream: TStream; Const AllowedResponseCodes: Array of Integer);
+
+Var
+  URI: TURI;
+  P: String;
+  IsHttps, HeadersOnly: Boolean;
 
 begin
   ResetResponse;
@@ -1064,23 +1195,12 @@ begin
   p:=LowerCase(URI.Protocol);
   If Not ((P='http') or (P='https')) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
-  if ProxyActive then
-    begin
-    CHost:=Proxy.Host;
-    CPort:=Proxy.Port;
-    end
+  IsHttps:=P='https';
+  HeadersOnly:=CompareText(AMethod,'HEAD')=0;
+  if FKeepAlive then
+    DoKeepAliveRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
   else
-    begin
-    CHost:=URI.Host;
-    CPort:=URI.Port;
-    end;
-  ConnectToServer(CHost,CPort,P='https');
-  try
-    SendRequest(AMethod,URI);
-    ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
-  finally
-    DisconnectFromServer;
-  end;
+    DoNormalRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps);
 end;
 
 constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
@@ -1091,11 +1211,14 @@ begin
   FRequestHeaders:=TStringList.Create;
   FResponseHeaders:=TStringList.Create;
   FHTTPVersion:='1.1';
+  FKeepAlive := True;
   FMaxRedirects:=DefMaxRedirects;
 end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
+  if IsConnected then
+    DisconnectFromServer;
   FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
@@ -1205,7 +1328,7 @@ begin
         FOnPassword(Self,RR);
       end
     else
-      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'')
+      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'');
   until not RR;
 end;
 
@@ -1273,7 +1396,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Get(AURL,Stream);
     finally
       Free;
@@ -1287,7 +1410,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Get(AURL,LocalFileName);
     finally
       Free;
@@ -1301,7 +1424,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Get(AURL,Response);
     finally
       Free;
@@ -1369,7 +1492,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Post(URL,Response);
     finally
       Free;
@@ -1383,7 +1506,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Post(URL,Response);
     finally
       Free;
@@ -1397,7 +1520,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Post(URL,LocalFileName);
     finally
       Free;
@@ -1410,7 +1533,7 @@ class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Result:=Post(URL);
     finally
       Free;
@@ -1461,7 +1584,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Put(URL,Response);
     finally
       Free;
@@ -1474,7 +1597,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Put(URL,Response);
     finally
       Free;
@@ -1487,7 +1610,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Put(URL,LocalFileName);
     finally
       Free;
@@ -1499,7 +1622,7 @@ class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Result:=Put(URL);
     finally
       Free;
@@ -1551,7 +1674,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Delete(URL,Response);
     finally
       Free;
@@ -1564,7 +1687,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Delete(URL,Response);
     finally
       Free;
@@ -1577,7 +1700,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Delete(URL,LocalFileName);
     finally
       Free;
@@ -1589,7 +1712,7 @@ class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Result:=Delete(URL);
     finally
       Free;
@@ -1641,7 +1764,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Options(URL,Response);
     finally
       Free;
@@ -1654,7 +1777,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Options(URL,Response);
     finally
       Free;
@@ -1667,7 +1790,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Options(URL,LocalFileName);
     finally
       Free;
@@ -1679,7 +1802,7 @@ class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Result:=Options(URL);
     finally
       Free;
@@ -1690,7 +1813,7 @@ class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       HTTPMethod('HEAD', AURL, Nil, [200]);
       Headers.Assign(ResponseHeaders);
     Finally
@@ -1775,7 +1898,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1789,7 +1912,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1803,7 +1926,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1816,7 +1939,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1829,7 +1952,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1842,7 +1965,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1921,7 +2044,7 @@ class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepAlive := False;
       FileFormPost(AURL,AFieldName,AFileName,Response);
     Finally
       Free;
-- 
2.7.4

silvioprog

2016-10-26 03:06

reporter  

frMain_001.png (9,281 bytes)   
frMain_001.png (9,281 bytes)   

silvioprog

2016-11-01 19:43

reporter   ~0095455

Last edited: 2016-11-02 04:55

View 2 revisions

Oops, I forgot a info. `man tcp`: recv() also returns 0 when the server disconnect the client.

silvioprog

2016-11-04 20:45

reporter   ~0095573

There is another possible solution using the select() call, I can try that in a near future ...

Michael Van Canneyt

2016-11-11 13:30

administrator   ~0095768

Added, but with some modifications.
- KeepAlive -> KeepConnection
- When setting KeepConnection to True, HTTPVersion is forced to '1.1'
- When setting HTTPVersion to something different from '1.1', KeepConnection is set to false
- 'Connection: close' header is set/removed as soon as KeepConnection is set.
- 'Connection: close' is checked when doing the request

Added the sample program in command-line version.

silvioprog

2016-11-18 13:27

reporter   ~0095991

I took a look at your changes, if I could choose a word to define it, it would be: AWESOME! :-D

Thanks a lot for applying that! :-)

Issue History

Date Modified Username Field Change
2016-10-26 03:06 silvioprog New Issue
2016-10-26 03:06 silvioprog File Added: keepalivedemo.tar.gz
2016-10-26 03:06 silvioprog File Added: 0001-fcl-web-added-keep-alive-support-to-fphttpclient.-pa.patch
2016-10-26 03:06 silvioprog File Added: frMain_001.png
2016-10-26 07:42 Michael Van Canneyt Assigned To => Michael Van Canneyt
2016-10-26 07:42 Michael Van Canneyt Status new => assigned
2016-11-01 19:43 silvioprog Note Added: 0095455
2016-11-02 04:55 silvioprog Note Edited: 0095455 View Revisions
2016-11-04 20:45 silvioprog Note Added: 0095573
2016-11-11 13:30 Michael Van Canneyt Fixed in Revision => 34875
2016-11-11 13:30 Michael Van Canneyt Note Added: 0095768
2016-11-11 13:30 Michael Van Canneyt Status assigned => resolved
2016-11-11 13:30 Michael Van Canneyt Fixed in Version => 3.1.1
2016-11-11 13:30 Michael Van Canneyt Resolution open => fixed
2016-11-11 13:30 Michael Van Canneyt Target Version => 3.2.0
2016-11-18 13:27 silvioprog Note Added: 0095991
2016-11-18 13:27 silvioprog Status resolved => closed