View Issue Details

IDProjectCategoryView StatusLast Update
0030788FPCFCLpublic2016-11-18 13:27
ReportersilvioprogAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version3.1.1Product Build 
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
  • keepalivedemo.tar.gz (2,133 bytes)
  • 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
    
    
  • frMain_001.png (9,281 bytes)
    frMain_001.png (9,281 bytes)

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