Browse Source

* Added KeepConnection by Silvio Clecio (Bug ID 30788)

git-svn-id: trunk@34875 -
michael 8 years ago
parent
commit
5e6026b020

+ 2 - 0
.gitattributes

@@ -3120,6 +3120,8 @@ packages/fcl-web/examples/httpclient/httppost.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppost.pp svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppost.pp svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppostfile.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppostfile.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppostfile.pp svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppostfile.pp svneol=native#text/plain
+packages/fcl-web/examples/httpclient/keepalive.lpi svneol=native#text/plain
+packages/fcl-web/examples/httpclient/keepalive.pp svneol=native#text/plain
 packages/fcl-web/examples/httpserver/simplehttpserver.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpserver/simplehttpserver.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpserver/simplehttpserver.pas svneol=native#text/plain
 packages/fcl-web/examples/httpserver/simplehttpserver.pas svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain

+ 60 - 0
packages/fcl-web/examples/httpclient/keepalive.lpi

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="keepalive"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="keepalive.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="keepalive"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 125 - 0
packages/fcl-web/examples/httpclient/keepalive.pp

@@ -0,0 +1,125 @@
+program keepalive;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CustApp, fphttpclient;
+
+const
+  URL_DIRECT = 'https://www.google.com/humans.txt';
+  URL_REDIRECTED = 'https://google.com/humans.txt';
+
+type
+
+  { TKeepConnectionDemo }
+
+  TKeepConnectionDemo = class(TCustomApplication)
+  private
+    FURL : String;
+    FShowResult : Boolean;
+    FCount : Integer;
+    FHttp: TFPHTTPClient;
+    FData: TBytesStream;
+    procedure DoRequests;
+    procedure Usage(Msg: string);
+  Protected
+    Procedure DoRun; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
+
+constructor TKeepConnectionDemo.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  StopOnException:=True;
+  FHttp := TFPHTTPClient.Create(nil);
+  FData := TBytesStream.Create;
+end;
+
+destructor TKeepConnectionDemo.Destroy;
+begin
+  FData.Free;
+  FHttp.Free;
+  inherited Destroy;
+end;
+
+
+procedure TKeepConnectionDemo.DoRequests;
+var
+  U: string;
+  B, E: TDateTime;
+  L : TStrings;
+  I : Integer;
+
+begin
+  for I:=1 to FCount do
+    begin
+    FData.Clear;
+    B := Now;
+    if (FURL<>'') then
+      U:=FURL
+    else if FHTTP.AllowRedirect then
+      U := URL_REDIRECTED
+    else
+      U := URL_DIRECT;
+    FHttp.Get(U, FData);
+    E := Now;
+    Writeln('Request ',i,', Duration: ',FormatDateTime('hh:nn:ss.zzz', E - B));
+    If FShowResult then
+      begin
+      FData.Seek(0, TSeekOrigin.soBeginning);
+      With TStringList.Create do
+        try
+          LoadFromStream(FData);
+          Writeln(text);
+        finally
+          Free;
+        end;
+     end;
+    end;
+end;
+
+procedure TKeepConnectionDemo.Usage(Msg : string);
+
+begin
+  if (Msg<>'') then
+    Writeln('Error : ',Msg);
+  Writeln(' Usage : keepalive [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h  --help              This help');
+  Writeln('-r  --redirect          Allow HTTP Redirect');
+  Writeln('-k  --keep-connection   Keep connection');
+  Writeln('-c  --count=N           Number of requests');
+  Writeln('-u  --URL=uri           Specify url');
+  Halt(Ord(Msg<>''));
+end;
+procedure TKeepConnectionDemo.DoRun;
+
+Var
+  S : String;
+
+begin
+  S:=CheckOptions('hrksc:u:',['count:','show','url:','redirect','keep-connection','help']);
+  if (S<>'') or HasOption('h','help') then
+    Usage(S);
+  FCount:=StrToIntDef(GetOptionValue('c','count'),10);
+  FShowResult:=HasOption('s','show');
+  FURL:=GetOptionValue('u','url');
+  FHTTP.AllowRedirect:=HasOption('r','redirect');
+  FHTTP.KeepConnection:=HasOption('k','keep-connection');
+  DoRequests;
+  Terminate;
+end;
+
+begin
+  With TKeepConnectionDemo.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    Finally
+      Free;
+    end;
+end.
+

+ 227 - 74
packages/fcl-web/src/base/fphttpclient.pp

@@ -70,6 +70,7 @@ Type
     FDataRead : Int64;
     FDataRead : Int64;
     FContentLength : Int64;
     FContentLength : Int64;
     FAllowRedirect: Boolean;
     FAllowRedirect: Boolean;
+    FKeepConnection: Boolean;
     FMaxRedirects: Byte;
     FMaxRedirects: Byte;
     FOnDataReceived: TDataEvent;
     FOnDataReceived: TDataEvent;
     FOnHeaders: TNotifyEvent;
     FOnHeaders: TNotifyEvent;
@@ -97,11 +98,26 @@ Type
     function GetProxy: TProxyData;
     function GetProxy: TProxyData;
     Procedure ResetResponse;
     Procedure ResetResponse;
     Procedure SetCookies(const AValue: TStrings);
     Procedure SetCookies(const AValue: TStrings);
+    procedure SetHTTPVersion(const AValue: String);
+    procedure SetKeepConnection(AValue: Boolean);
     procedure SetProxy(AValue: TProxyData);
     procedure SetProxy(AValue: TProxyData);
     Procedure SetRequestHeaders(const AValue: TStrings);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
     procedure SetIOTimeout(AValue: Integer);
+    Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
+    Procedure CheckConnectionCloseHeader;
   protected
   protected
+
     Function NoContentAllowed(ACode : Integer) : Boolean;
     Function NoContentAllowed(ACode : Integer) : Boolean;
+    // Peform a request, close connection.
+    Procedure DoNormalRequest(const AURI: TURI; const AMethod: string;
+      AStream: TStream; const AAllowedResponseCodes: array of Integer;
+      AHeadersOnly, AIsHttps: Boolean); virtual;
+    // Peform a request, try to keep connection.
+    Procedure DoKeepConnectionRequest(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
     // True if we need to use a proxy: ProxyData Assigned and Hostname Set
     Function ProxyActive : Boolean;
     Function ProxyActive : Boolean;
     // Override this if you want to create a custom instance of proxy.
     // Override this if you want to create a custom instance of proxy.
@@ -113,19 +129,23 @@ Type
     // Construct server URL for use in request line.
     // Construct server URL for use in request line.
     function GetServerURL(URI: TURI): String;
     function GetServerURL(URI: TURI): String;
     // Read 1 line of response. Fills FBuffer
     // 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.
     // 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 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.
     // 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;
     function CheckResponseCode(ACode: Integer;  const AllowedResponseCodes: array of Integer): Boolean; virtual;
     // Read response from server, and write any document to Stream.
     // 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.
     // Read server response line and headers. Returns status code.
     Function ReadResponseHeaders : integer; virtual;
     Function ReadResponseHeaders : integer; virtual;
     // Allow header in request ? (currently checks only if non-empty and contains : token)
     // Allow header in request ? (currently checks only if non-empty and contains : token)
     function AllowHeader(var AHeader: String): Boolean; virtual;
     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.
     // Connect to the server. Must initialize FSocket.
     Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
     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.
     // Disconnect from server. Must free FSocket.
     Procedure DisconnectFromServer; virtual;
     Procedure DisconnectFromServer; virtual;
     // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
     // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
@@ -152,7 +172,7 @@ Type
     // Add header, replacing an existing one if it exists.
     // Add header, replacing an existing one if it exists.
     Procedure AddHeader(Const AHeader,AValue : String);
     Procedure AddHeader(Const AHeader,AValue : String);
     // Return header value, empty if not present.
     // Return header value, empty if not present.
-    Function GetHeader(Const AHeader : String) : String;
+    Function  GetHeader(Const AHeader : String) : String;
     // General-purpose call. Handles redirect and authorization retry (OnPassword).
     // General-purpose call. Handles redirect and authorization retry (OnPassword).
     Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
     Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
     // Execute GET on server, store result in Stream, File, StringList or string
     // Execute GET on server, store result in Stream, File, StringList or string
@@ -254,7 +274,8 @@ Type
     // Optional body to send (mainly in POST request)
     // Optional body to send (mainly in POST request)
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
     // used HTTP version when constructing the request.
     // used HTTP version when constructing the request.
-    Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
+    // Setting this to any other value than 1.1 will set KeepConnection to False.
+    Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
     // After request properties.
     // After request properties.
     // After request, this contains the headers sent by server.
     // After request, this contains the headers sent by server.
     Property ResponseHeaders : TStrings Read FResponseHeaders;
     Property ResponseHeaders : TStrings Read FResponseHeaders;
@@ -278,6 +299,10 @@ Type
     // They also override any Authenticate: header in Requestheaders.
     // They also override any Authenticate: header in Requestheaders.
     Property UserName : String Read FUserName Write FUserName;
     Property UserName : String Read FUserName Write FUserName;
     Property Password : String Read FPassword Write FPassword;
     Property Password : String Read FPassword Write FPassword;
+    // Is client connected?
+    Property Connected: Boolean read IsConnected;
+    // Keep-Alive support. Setting to true will set HTTPVersion to 1.1
+    Property KeepConnection: Boolean Read FKeepConnection Write SetKeepConnection;
     // If a request returns a 401, then the OnPassword event is fired.
     // If a request returns a 401, then the OnPassword event is fired.
     // It can modify the username/password and set RepeatRequest to true;
     // It can modify the username/password and set RepeatRequest to true;
     Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
     Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
@@ -293,6 +318,8 @@ Type
 
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
   TFPHTTPClient = Class(TFPCustomHTTPClient)
   Published
   Published
+    Property KeepConnection;
+    Property Connected;
     Property IOTimeout;
     Property IOTimeout;
     Property RequestHeaders;
     Property RequestHeaders;
     Property RequestBody;
     Property RequestBody;
@@ -458,6 +485,11 @@ begin
     FSocket.IOTimeout:=AValue;
     FSocket.IOTimeout:=AValue;
 end;
 end;
 
 
+function TFPCustomHTTPClient.IsConnected: Boolean;
+begin
+  Result := Assigned(FSocket);
+end;
+
 function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
 function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
 begin
 begin
   Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
   Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
@@ -544,6 +576,8 @@ Var
 
 
 
 
 begin
 begin
+  If IsConnected Then
+    DisconnectFromServer; // avoid memory leaks
   if (Aport=0) then
   if (Aport=0) then
     if UseSSL then
     if UseSSL then
       Aport:=443
       Aport:=443
@@ -561,6 +595,13 @@ begin
   end;
   end;
 end;
 end;
 
 
+Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
+  APort: Integer; UseSSL: Boolean);
+begin
+  DisconnectFromServer;
+  ConnectToServer(AHost, APort, UseSSL);
+end;
+
 procedure TFPCustomHTTPClient.DisconnectFromServer;
 procedure TFPCustomHTTPClient.DisconnectFromServer;
 
 
 begin
 begin
@@ -573,6 +614,11 @@ begin
   Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
   Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
 end;
 end;
 
 
+Function TFPCustomHTTPClient.HasConnectionClose: Boolean;
+begin
+  Result := CompareText(GetHeader('Connection'), 'close') = 0;
+end;
+
 procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
 procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
 
 
 Var
 Var
@@ -607,6 +653,7 @@ begin
   S:=S+CRLF;
   S:=S+CRLF;
   If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
   If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
     AddHeader('Content-Length',IntToStr(RequestBody.Size));
     AddHeader('Content-Length',IntToStr(RequestBody.Size));
+  CheckConnectionCloseHeader;
   For I:=0 to FRequestHeaders.Count-1 do
   For I:=0 to FRequestHeaders.Count-1 do
     begin
     begin
     l:=FRequestHeaders[i];
     l:=FRequestHeaders[i];
@@ -634,9 +681,9 @@ begin
     FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
     FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
 end;
 end;
 
 
-function TFPCustomHTTPClient.ReadString : String;
+function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
 
 
-  Procedure FillBuffer;
+  Function FillBuffer: Boolean;
 
 
   Var
   Var
     R : Integer;
     R : Integer;
@@ -644,38 +691,42 @@ function TFPCustomHTTPClient.ReadString : String;
   begin
   begin
     SetLength(FBuffer,ReadBufLen);
     SetLength(FBuffer,ReadBufLen);
     r:=FSocket.Read(FBuffer[1],ReadBufLen);
     r:=FSocket.Read(FBuffer[1],ReadBufLen);
+    If r=0 Then
+      Exit(False);
     If r<0 then
     If r<0 then
       Raise EHTTPClient.Create(SErrReadingSocket);
       Raise EHTTPClient.Create(SErrReadingSocket);
     if (r<ReadBuflen) then
     if (r<ReadBuflen) then
       SetLength(FBuffer,r);
       SetLength(FBuffer,r);
     FDataRead:=FDataRead+R;
     FDataRead:=FDataRead+R;
     DoDataRead;
     DoDataRead;
+    Result:=r>0;
   end;
   end;
 
 
 Var
 Var
-  CheckLF,Done : Boolean;
+  CheckLF: Boolean;
   P,L : integer;
   P,L : integer;
 
 
 begin
 begin
-  Result:='';
-  Done:=False;
+  S:='';
+  Result:=False;
   CheckLF:=False;
   CheckLF:=False;
   Repeat
   Repeat
     if Length(FBuffer)=0 then
     if Length(FBuffer)=0 then
-      FillBuffer;
+      if not FillBuffer then
+        Break;
     if Length(FBuffer)=0 then
     if Length(FBuffer)=0 then
-      Done:=True
+      Result:=True
     else if CheckLF then
     else if CheckLF then
       begin
       begin
       If (FBuffer[1]<>#10) then
       If (FBuffer[1]<>#10) then
-        Result:=Result+#13
+        S:=S+#13
       else
       else
         begin
         begin
         System.Delete(FBuffer,1,1);
         System.Delete(FBuffer,1,1);
-        Done:=True;
+        Result:=True;
         end;
         end;
       end;
       end;
-    if not Done then
+    if not Result then
       begin
       begin
       P:=Pos(#13#10,FBuffer);
       P:=Pos(#13#10,FBuffer);
       If P=0 then
       If P=0 then
@@ -683,20 +734,21 @@ begin
         L:=Length(FBuffer);
         L:=Length(FBuffer);
         CheckLF:=FBuffer[L]=#13;
         CheckLF:=FBuffer[L]=#13;
         if CheckLF then
         if CheckLF then
-          Result:=Result+Copy(FBuffer,1,L-1)
+          S:=S+Copy(FBuffer,1,L-1)
         else
         else
-          Result:=Result+FBuffer;
+          S:=S+FBuffer;
         FBuffer:='';
         FBuffer:='';
         end
         end
       else
       else
         begin
         begin
-        Result:=Result+Copy(FBuffer,1,P-1);
+        S:=S+Copy(FBuffer,1,P-1);
         System.Delete(FBuffer,1,P+1);
         System.Delete(FBuffer,1,P+1);
-        Done:=True;
+        Result:=True;
         end;
         end;
       end;
       end;
-  until Done;
+  until Result;
 end;
 end;
+
 Function GetNextWord(Var S : String) : string;
 Function GetNextWord(Var S : String) : string;
 
 
 Const
 Const
@@ -765,11 +817,11 @@ Var
   StatusLine,S : String;
   StatusLine,S : String;
 
 
 begin
 begin
-  StatusLine:=ReadString;
+  if not ReadString(StatusLine) then
+    Exit(0);
   Result:=ParseStatusLine(StatusLine);
   Result:=ParseStatusLine(StatusLine);
   Repeat
   Repeat
-    S:=ReadString;
-    if (S<>'') then
+    if ReadString(S) and (S<>'') then
       begin
       begin
       ResponseHeaders.Add(S);
       ResponseHeaders.Add(S);
       If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
       If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
@@ -877,14 +929,33 @@ begin
   GetCookies.Assign(AValue);
   GetCookies.Assign(AValue);
 end;
 end;
 
 
+procedure TFPCustomHTTPClient.SetHTTPVersion(const AValue: String);
+begin
+  if FHTTPVersion = AValue then Exit;
+  FHTTPVersion := AValue;
+  if (AValue<>'1.1') then
+    KeepConnection:=False;
+end;
+
+procedure TFPCustomHTTPClient.SetKeepConnection(AValue: Boolean);
+begin
+  if FKeepConnection=AValue then Exit;
+  FKeepConnection:=AValue;
+  if AValue then
+    HTTPVersion:='1.1'
+  else if IsConnected then
+    DisconnectFromServer;
+  CheckConnectionCloseHeader;
+end;
+
 procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
 procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
 begin
 begin
   if (AValue=FProxy) then exit;
   if (AValue=FProxy) then exit;
   Proxy.Assign(AValue);
   Proxy.Assign(AValue);
 end;
 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;
   Function Transfer(LB : Integer) : Integer;
 
 
@@ -1012,6 +1083,9 @@ begin
   FContentLength:=0;
   FContentLength:=0;
   SetLength(FBuffer,0);
   SetLength(FBuffer,0);
   FResponseStatusCode:=ReadResponseHeaders;
   FResponseStatusCode:=ReadResponseHeaders;
+  Result := FResponseStatusCode > 0;
+  if not Result then
+    Exit;
   if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
   if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
     Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
     Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
   if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
   if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
@@ -1050,13 +1124,99 @@ begin
     end;
     end;
 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.CheckConnectionCloseHeader;
 
 
 Var
 Var
-  URI : TURI;
-  P,CHost : String;
-  CPort : Word;
+  I : integer;
+  N,V : String;
+
+begin
+  V:=GetHeader('Connection');
+  If FKeepConnection Then
+    begin
+    I:=IndexOfHeader(FRequestHeaders,'Connection');
+    If i>-1 Then
+      begin
+      // It can be keep-alive, check value
+      FRequestHeaders.GetNameValue(I,N,V);
+      If CompareText(V,'close')=0  then
+        FRequestHeaders.Delete(i);
+      end
+    end
+  Else
+    AddHeader('Connection', 'close');
+end;
+
+Procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI;
+  const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer;
+  AHeadersOnly, AIsHttps: Boolean);
+
+Var
+  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.DoKeepConnectionRequest(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
 begin
   ResetResponse;
   ResetResponse;
@@ -1064,23 +1224,12 @@ begin
   p:=LowerCase(URI.Protocol);
   p:=LowerCase(URI.Protocol);
   If Not ((P='http') or (P='https')) then
   If Not ((P='http') or (P='https')) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
    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 FKeepConnection then
+    DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
   else
   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;
 end;
 
 
 constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
 constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
@@ -1089,13 +1238,17 @@ begin
   // Infinite timeout on most platforms
   // Infinite timeout on most platforms
   FIOTimeout:=0;
   FIOTimeout:=0;
   FRequestHeaders:=TStringList.Create;
   FRequestHeaders:=TStringList.Create;
+  FRequestHeaders.NameValueSeparator:=':';
   FResponseHeaders:=TStringList.Create;
   FResponseHeaders:=TStringList.Create;
-  FHTTPVersion:='1.1';
+  FResponseHeaders.NameValueSeparator:=':';
+  HTTPVersion:='1.1';
   FMaxRedirects:=DefMaxRedirects;
   FMaxRedirects:=DefMaxRedirects;
 end;
 end;
 
 
 destructor TFPCustomHTTPClient.Destroy;
 destructor TFPCustomHTTPClient.Destroy;
 begin
 begin
+  if IsConnected then
+    DisconnectFromServer;
   FreeAndNil(FProxy);
   FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
   FreeAndNil(FSentCookies);
@@ -1205,7 +1358,7 @@ begin
         FOnPassword(Self,RR);
         FOnPassword(Self,RR);
       end
       end
     else
     else
-      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'')
+      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'');
   until not RR;
   until not RR;
 end;
 end;
 
 
@@ -1273,7 +1426,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,Stream);
       Get(AURL,Stream);
     finally
     finally
       Free;
       Free;
@@ -1287,7 +1440,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,LocalFileName);
       Get(AURL,LocalFileName);
     finally
     finally
       Free;
       Free;
@@ -1301,7 +1454,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,Response);
       Get(AURL,Response);
     finally
     finally
       Free;
       Free;
@@ -1369,7 +1522,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,Response);
       Post(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1383,7 +1536,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,Response);
       Post(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1397,7 +1550,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,LocalFileName);
       Post(URL,LocalFileName);
     finally
     finally
       Free;
       Free;
@@ -1410,7 +1563,7 @@ class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Post(URL);
       Result:=Post(URL);
     finally
     finally
       Free;
       Free;
@@ -1461,7 +1614,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,Response);
       Put(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1474,7 +1627,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,Response);
       Put(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1487,7 +1640,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,LocalFileName);
       Put(URL,LocalFileName);
     finally
     finally
       Free;
       Free;
@@ -1499,7 +1652,7 @@ class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Put(URL);
       Result:=Put(URL);
     finally
     finally
       Free;
       Free;
@@ -1551,7 +1704,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,Response);
       Delete(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1564,7 +1717,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,Response);
       Delete(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1577,7 +1730,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,LocalFileName);
       Delete(URL,LocalFileName);
     finally
     finally
       Free;
       Free;
@@ -1589,7 +1742,7 @@ class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Delete(URL);
       Result:=Delete(URL);
     finally
     finally
       Free;
       Free;
@@ -1641,7 +1794,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,Response);
       Options(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1654,7 +1807,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,Response);
       Options(URL,Response);
     finally
     finally
       Free;
       Free;
@@ -1667,7 +1820,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,LocalFileName);
       Options(URL,LocalFileName);
     finally
     finally
       Free;
       Free;
@@ -1679,7 +1832,7 @@ class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Options(URL);
       Result:=Options(URL);
     finally
     finally
       Free;
       Free;
@@ -1690,7 +1843,7 @@ class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       HTTPMethod('HEAD', AURL, Nil, [200]);
       HTTPMethod('HEAD', AURL, Nil, [200]);
       Headers.Assign(ResponseHeaders);
       Headers.Assign(ResponseHeaders);
     Finally
     Finally
@@ -1775,7 +1928,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
       FormPost(URL,FormData,Response);
     Finally
     Finally
       Free;
       Free;
@@ -1789,7 +1942,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
       FormPost(URL,FormData,Response);
     Finally
     Finally
       Free;
       Free;
@@ -1803,7 +1956,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
       FormPost(URL,FormData,Response);
     Finally
     Finally
       Free;
       Free;
@@ -1816,7 +1969,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
       FormPost(URL,FormData,Response);
     Finally
     Finally
       Free;
       Free;
@@ -1829,7 +1982,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=FormPost(URL,FormData);
       Result:=FormPost(URL,FormData);
     Finally
     Finally
       Free;
       Free;
@@ -1842,7 +1995,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=FormPost(URL,FormData);
       Result:=FormPost(URL,FormData);
     Finally
     Finally
       Free;
       Free;
@@ -1921,7 +2074,7 @@ class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
 begin
 begin
   With Self.Create(nil) do
   With Self.Create(nil) do
     try
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FileFormPost(AURL,AFieldName,AFileName,Response);
       FileFormPost(AURL,AFieldName,AFileName,Response);
     Finally
     Finally
       Free;
       Free;