View Issue Details

IDProjectCategoryView StatusLast Update
0031470FPCPackagespublic2017-03-06 14:24
ReporterJuha ManninenAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
PlatformIntel x86_64OSLinuxOS VersionManjaro
Product Version3.1.1Product Buildr35505 
Target Version3.2.0Fixed in Version3.1.1 
Summary0031470: fcl-web: Backport changes in fphttpclient used in Lazarus OPM to FPC project.
DescriptionLazarus Online Package Manager has a temporary copy of fphttpclient unit.
The attached patch backports the changes to the master version in FPC packages. The changes are for general use, not specific to the Lazarus OPM.

The main change is a timeout/aborting mechanism.

Most changes were made by Balázs Székely. He can answer specific questions if needed.
The code has been used in OPM for a while and is well tested.
TagsNo tags attached.
Fixed in Revision35516
FPCOldBugId
FPCTarget
Attached Files
  • 0001-fcl-web-Backport-changes-in-fphttpclient-used-in-OPM.patch (27,924 bytes)
    From 84b4954b16bee1066727a68495cbdb3bf36ff300 Mon Sep 17 00:00:00 2001
    From: juha <juha.manninen62@gmail.com>
    Date: Thu, 2 Mar 2017 16:50:10 +0200
    Subject: [PATCH] fcl-web: Backport changes in fphttpclient used in OPM.
    
    ---
     packages/fcl-web/src/base/fphttpclient.pp | 348 ++++++++++--------------------
     1 file changed, 110 insertions(+), 238 deletions(-)
    
    diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp
    index 0633c47040..044f444811 100644
    --- a/packages/fcl-web/src/base/fphttpclient.pp
    +++ b/packages/fcl-web/src/base/fphttpclient.pp
    @@ -15,6 +15,11 @@
     unit fphttpclient;
     
     { ---------------------------------------------------------------------
    +  Author: ?
    +
    +  Balázs Székely implemented a timeout/aborting mechanism which is useful when
    +  downloading a large file.
    +
       Todo:
       * Proxy support ?
       ---------------------------------------------------------------------}
    @@ -70,7 +75,6 @@ Type
         FDataRead : Int64;
         FContentLength : Int64;
         FAllowRedirect: Boolean;
    -    FKeepConnection: Boolean;
         FMaxRedirects: Byte;
         FOnDataReceived: TDataEvent;
         FOnHeaders: TNotifyEvent;
    @@ -91,6 +95,7 @@ Type
         FBuffer : Ansistring;
         FUserName: String;
         FOnGetSocketHandler : TGetSocketHandlerEvent;
    +    FNeedToBreak: Boolean;
         FProxy : TProxyData;
         function CheckContentLength: Int64;
         function CheckTransferEncoding: string;
    @@ -98,26 +103,11 @@ Type
         function GetProxy: TProxyData;
         Procedure ResetResponse;
         Procedure SetCookies(const AValue: TStrings);
    -    procedure SetHTTPVersion(const AValue: String);
    -    procedure SetKeepConnection(AValue: Boolean);
         procedure SetProxy(AValue: TProxyData);
         Procedure SetRequestHeaders(const AValue: TStrings);
         procedure SetIOTimeout(AValue: Integer);
    -    Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
    -    Procedure CheckConnectionCloseHeader;
       protected
    -
         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
         Function ProxyActive : Boolean;
         // Override this if you want to create a custom instance of proxy.
    @@ -129,23 +119,19 @@ Type
         // Construct server URL for use in request line.
         function GetServerURL(URI: TURI): String;
         // Read 1 line of response. Fills FBuffer
    -    function ReadString(out S: String): Boolean;
    +    function ReadString: String;
         // 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.
    -    Function ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False): Boolean; virtual;
    +    Procedure ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); 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.
    @@ -172,7 +158,7 @@ Type
         // Add header, replacing an existing one if it exists.
         Procedure AddHeader(Const AHeader,AValue : String);
         // 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).
         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
    @@ -245,7 +231,7 @@ Type
         Procedure FormPost(const URL : string; FormData:  TStrings; const Response: TStrings);
         function FormPost(const URL, FormData: string): String;
         function FormPost(const URL: string; FormData : TStrings): String;
    -    // Simple form 
    +    // Simple form
         Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStream);
         Class Procedure SimpleFormPost(const URL : string; FormData:  TStrings; const Response: TStream);
         Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStrings);
    @@ -274,8 +260,7 @@ Type
         // Optional body to send (mainly in POST request)
         Property RequestBody : TStream read FRequestBody Write FRequestBody;
         // used HTTP version when constructing the request.
    -    // Setting this to any other value than 1.1 will set KeepConnection to False.
    -    Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
    +    Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
         // After request properties.
         // After request, this contains the headers sent by server.
         Property ResponseHeaders : TStrings Read FResponseHeaders;
    @@ -299,10 +284,6 @@ 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. 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.
         // It can modify the username/password and set RepeatRequest to true;
         Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
    @@ -312,14 +293,12 @@ Type
         Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
         // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
         Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
    -
    +    Property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak;
       end;
     
     
       TFPHTTPClient = Class(TFPCustomHTTPClient)
       Published
    -    Property KeepConnection;
    -    Property Connected;
         Property IOTimeout;
         Property RequestHeaders;
         Property RequestBody;
    @@ -339,6 +318,7 @@ Type
         Property OnHeaders;
         Property OnGetSocketHandler;
         Property Proxy;
    +    Property NeedToBreak;
       end;
     
       EHTTPClient = Class(EHTTP);
    @@ -347,19 +327,19 @@ Function EncodeURLElement(S : String) : String;
     Function DecodeURLElement(Const S : String) : String;
     
     implementation
    -{$if not defined(hasamiga)}
    +{$if not defined(HASAMIGA)}
     uses sslsockets;
     {$endif}
     
     resourcestring
    -  SErrInvalidProtocol = 'Invalid protocol : "%s"';
    +  SErrInvalidProtocol = 'Invalid protocol: "%s"';
       SErrReadingSocket = 'Error reading data from socket';
       SErrInvalidProtocolVersion = 'Invalid protocol version in response: "%s"';
       SErrInvalidStatusCode = 'Invalid response status code: %s';
       SErrUnexpectedResponse = 'Unexpected response status code: %d';
       SErrChunkTooBig = 'Chunk too big';
       SErrChunkLineEndMissing = 'Chunk line end missing';
    -  SErrMaxRedirectsReached = 'Maximum allowed redirects reached : %d';
    +  SErrMaxRedirectsReached = 'Maximum allowed redirects reached: %d';
       //SErrRedirectAborted = 'Redirect aborted.';
     
     Const
    @@ -481,13 +461,8 @@ procedure TFPCustomHTTPClient.SetIOTimeout(AValue: Integer);
     begin
       if AValue=FIOTimeout then exit;
       FIOTimeout:=AValue;
    -  if Assigned(FSocket) then
    -    FSocket.IOTimeout:=AValue;
    -end;
    -
    -function TFPCustomHTTPClient.IsConnected: Boolean;
    -begin
    -  Result := Assigned(FSocket);
    +   if Assigned(FSocket) then
    +     FSocket.IOTimeout:=AValue;
     end;
     
     function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
    @@ -564,7 +539,7 @@ begin
         If UseSSL then
           Result:=TSSLSocketHandler.Create
         else
    -  {$endif}  
    +  {$endif}
           Result:=TSocketHandler.Create;
     end;
     
    @@ -574,20 +549,17 @@ procedure TFPCustomHTTPClient.ConnectToServer(const AHost: String;
     Var
       G : TSocketHandler;
     
    -
     begin
    -  If IsConnected Then
    -    DisconnectFromServer; // avoid memory leaks
       if (Aport=0) then
         if UseSSL then
           Aport:=443
         else
           Aport:=80;
    -  G:=GetSocketHandler(UseSSL);    
    +  G:=GetSocketHandler(UseSSL);
       FSocket:=TInetSocket.Create(AHost,APort,G);
       try
    -    if FIOTimeout<>0 then
    -      FSocket.IOTimeout:=FIOTimeout;
    +    if FIOTimeout <> 0 then
    +      FSocket.IOTimeout := FIOTimeout;
         FSocket.Connect;
       except
         FreeAndNil(FSocket);
    @@ -595,13 +567,6 @@ begin
       end;
     end;
     
    -Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
    -  APort: Integer; UseSSL: Boolean);
    -begin
    -  DisconnectFromServer;
    -  ConnectToServer(AHost, APort, UseSSL);
    -end;
    -
     procedure TFPCustomHTTPClient.DisconnectFromServer;
     
     begin
    @@ -614,11 +579,6 @@ 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
    @@ -653,7 +613,6 @@ begin
       S:=S+CRLF;
       If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
         AddHeader('Content-Length',IntToStr(RequestBody.Size));
    -  CheckConnectionCloseHeader;
       For I:=0 to FRequestHeaders.Count-1 do
         begin
         l:=FRequestHeaders[i];
    @@ -681,9 +640,9 @@ begin
         FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
     end;
     
    -function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
    +function TFPCustomHTTPClient.ReadString : String;
     
    -  Function FillBuffer: Boolean;
    +  Procedure FillBuffer;
     
       Var
         R : Integer;
    @@ -691,42 +650,40 @@ function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
       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: Boolean;
    +  CheckLF,Done : Boolean;
       P,L : integer;
     
     begin
    -  S:='';
    -  Result:=False;
    +  Result:='';
    +  Done:=False;
       CheckLF:=False;
       Repeat
    +    if NeedToBreak then
    +      Break;
         if Length(FBuffer)=0 then
    -      if not FillBuffer then
    -        Break;
    +      FillBuffer;
         if Length(FBuffer)=0 then
    -      Result:=True
    +      Done:=True
         else if CheckLF then
           begin
           If (FBuffer[1]<>#10) then
    -        S:=S+#13
    +        Result:=Result+#13
           else
             begin
             System.Delete(FBuffer,1,1);
    -        Result:=True;
    +        Done:=True;
             end;
           end;
    -    if not Result then
    +    if not Done then
           begin
           P:=Pos(#13#10,FBuffer);
           If P=0 then
    @@ -734,19 +691,19 @@ begin
             L:=Length(FBuffer);
             CheckLF:=FBuffer[L]=#13;
             if CheckLF then
    -          S:=S+Copy(FBuffer,1,L-1)
    +          Result:=Result+Copy(FBuffer,1,L-1)
             else
    -          S:=S+FBuffer;
    +          Result:=Result+FBuffer;
             FBuffer:='';
             end
           else
             begin
    -        S:=S+Copy(FBuffer,1,P-1);
    +        Result:=Result+Copy(FBuffer,1,P-1);
             System.Delete(FBuffer,1,P+1);
    -        Result:=True;
    +        Done:=True;
             end;
           end;
    -  until Result;
    +  until Done;
     end;
     
     Function GetNextWord(Var S : String) : string;
    @@ -801,6 +758,8 @@ function TFPCustomHTTPClient.ReadResponseHeaders: integer;
         P:=Pos(':',S);
         System.Delete(S,1,P);
         Repeat
    +      if NeedToBreak then
    +        Break;
           P:=Pos(';',S);
           If (P=0) then
             P:=Length(S)+1;
    @@ -817,11 +776,13 @@ Var
       StatusLine,S : String;
     
     begin
    -  if not ReadString(StatusLine) then
    -    Exit(0);
    +  StatusLine:=ReadString;
       Result:=ParseStatusLine(StatusLine);
       Repeat
    -    if ReadString(S) and (S<>'') then
    +    if NeedToBreak then
    +      Break;
    +    S:=ReadString;
    +    if (S<>'') then
           begin
           ResponseHeaders.Add(S);
           If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
    @@ -929,33 +890,14 @@ begin
       GetCookies.Assign(AValue);
     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);
     begin
       if (AValue=FProxy) then exit;
       Proxy.Assign(AValue);
     end;
     
    -Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
    -  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
    +procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
    +  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
     
       Function Transfer(LB : Integer) : Integer;
     
    @@ -1030,9 +972,13 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
       begin
         BufPos:=1;
         repeat
    +      if NeedToBreak then
    +        Break;
           // read ChunkSize
           ChunkSize:=0;
           repeat
    +        if NeedToBreak then
    +          Break;
             if ReadData(@c,1)<1 then exit;
             case c of
             '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
    @@ -1049,6 +995,8 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
           if ChunkSize=0 then exit;
           // read data
           repeat
    +        if NeedToBreak then
    +          Break;
             l:=length(FBuffer)-BufPos+1;
             if l=0 then
               if not FetchData(l) then
    @@ -1083,9 +1031,6 @@ 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
    @@ -1107,6 +1052,8 @@ begin
           // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
           L:=L-LB;
           Repeat
    +        if NeedToBreak then
    +          Break;
             LB:=ReadBufLen;
             If (LB>L) then
               LB:=L;
    @@ -1118,105 +1065,21 @@ begin
           begin
           // No content-length, so we read till no more data available.
           Repeat
    +        if NeedToBreak then
    +          Break;
             R:=Transfer(ReadBufLen);
           until (R=0);
           end;
         end;
     end;
     
    -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
    -  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);
    +procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
    +  Stream: TStream; const AllowedResponseCodes: array of Integer);
     
     Var
    -  URI: TURI;
    -  P: String;
    -  IsHttps, HeadersOnly: Boolean;
    +  URI : TURI;
    +  P,CHost : String;
    +  CPort : Word;
     
     begin
       ResetResponse;
    @@ -1224,12 +1087,23 @@ begin
       p:=LowerCase(URI.Protocol);
       If Not ((P='http') or (P='https')) then
        Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
    -  IsHttps:=P='https';
    -  HeadersOnly:=CompareText(AMethod,'HEAD')=0;
    -  if FKeepConnection then
    -    DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
    +  if ProxyActive then
    +    begin
    +    CHost:=Proxy.Host;
    +    CPort:=Proxy.Port;
    +    end
       else
    -    DoNormalRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps);
    +    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;
     end;
     
     constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
    @@ -1238,17 +1112,13 @@ begin
       // Infinite timeout on most platforms
       FIOTimeout:=0;
       FRequestHeaders:=TStringList.Create;
    -  FRequestHeaders.NameValueSeparator:=':';
       FResponseHeaders:=TStringList.Create;
    -  FResponseHeaders.NameValueSeparator:=':';
    -  HTTPVersion:='1.1';
    +  FHTTPVersion:='1.1';
       FMaxRedirects:=DefMaxRedirects;
     end;
     
     destructor TFPCustomHTTPClient.Destroy;
     begin
    -  if IsConnected then
    -    DisconnectFromServer;
       FreeAndNil(FProxy);
       FreeAndNil(FCookies);
       FreeAndNil(FSentCookies);
    @@ -1327,6 +1197,8 @@ begin
       RR:=False;
       M:=AMethod;
       Repeat
    +    if FNeedToBreak then
    +      Break;
         if Not AllowRedirect then
           DoMethod(M,L,Stream,AllowedResponseCodes)
         else
    @@ -1426,7 +1298,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Get(AURL,Stream);
         finally
           Free;
    @@ -1440,7 +1312,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Get(AURL,LocalFileName);
         finally
           Free;
    @@ -1454,7 +1326,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Get(AURL,Response);
         finally
           Free;
    @@ -1463,7 +1335,7 @@ end;
     
     
     class function TFPCustomHTTPClient.SimpleGet(const AURL: String): String;
    - 
    +
     begin
       With Self.Create(nil) do
         try
    @@ -1522,7 +1394,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Post(URL,Response);
         finally
           Free;
    @@ -1536,7 +1408,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Post(URL,Response);
         finally
           Free;
    @@ -1550,7 +1422,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Post(URL,LocalFileName);
         finally
           Free;
    @@ -1563,7 +1435,7 @@ class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Result:=Post(URL);
         finally
           Free;
    @@ -1614,7 +1486,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Put(URL,Response);
         finally
           Free;
    @@ -1627,7 +1499,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Put(URL,Response);
         finally
           Free;
    @@ -1640,7 +1512,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Put(URL,LocalFileName);
         finally
           Free;
    @@ -1652,7 +1524,7 @@ class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Result:=Put(URL);
         finally
           Free;
    @@ -1704,7 +1576,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Delete(URL,Response);
         finally
           Free;
    @@ -1717,7 +1589,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Delete(URL,Response);
         finally
           Free;
    @@ -1730,7 +1602,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Delete(URL,LocalFileName);
         finally
           Free;
    @@ -1742,7 +1614,7 @@ class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Result:=Delete(URL);
         finally
           Free;
    @@ -1794,7 +1666,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Options(URL,Response);
         finally
           Free;
    @@ -1807,7 +1679,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Options(URL,Response);
         finally
           Free;
    @@ -1820,7 +1692,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Options(URL,LocalFileName);
         finally
           Free;
    @@ -1832,7 +1704,7 @@ class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Result:=Options(URL);
         finally
           Free;
    @@ -1843,7 +1715,7 @@ class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           HTTPMethod('HEAD', AURL, Nil, [200]);
           Headers.Assign(ResponseHeaders);
         Finally
    @@ -1928,7 +1800,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           FormPost(URL,FormData,Response);
         Finally
           Free;
    @@ -1942,7 +1814,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           FormPost(URL,FormData,Response);
         Finally
           Free;
    @@ -1956,7 +1828,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           FormPost(URL,FormData,Response);
         Finally
           Free;
    @@ -1969,7 +1841,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           FormPost(URL,FormData,Response);
         Finally
           Free;
    @@ -1982,7 +1854,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Result:=FormPost(URL,FormData);
         Finally
           Free;
    @@ -1995,7 +1867,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           Result:=FormPost(URL,FormData);
         Finally
           Free;
    @@ -2074,7 +1946,7 @@ class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
     begin
       With Self.Create(nil) do
         try
    -      KeepConnection := False;
    +      RequestHeaders.Add('Connection: Close');
           FileFormPost(AURL,AFieldName,AFileName,Response);
         Finally
           Free;
    -- 
    2.12.0
    
    
  • fphttpclient.diff (3,159 bytes)
    Index: fphttpclient.pp
    ===================================================================
    --- fphttpclient.pp	(revision 34062)
    +++ fphttpclient.pp	(working copy)
    @@ -18,6 +18,11 @@
       Todo:
       * Proxy support ?
       ---------------------------------------------------------------------}
    +{
    +  TFPHTTPClient does not implement a timeout/aborting mechanism(2016.10.01), which
    +  is useful when downloading a large file for example. opkman_httpclient and opkman_downloader
    +  fix this issue.
    +}
     
     {$mode objfpc}{$H+}
     
    @@ -90,6 +95,7 @@
         FBuffer : Ansistring;
         FUserName: String;
         FOnGetSocketHandler : TGetSocketHandlerEvent;
    +    FNeedToBreak: Boolean;
         FProxy : TProxyData;
         function CheckContentLength: Int64;
         function CheckTransferEncoding: string;
    @@ -287,7 +293,7 @@
         Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
         // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
         Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
    -
    +    Property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak;
       end;
     
     
    @@ -312,6 +318,7 @@
         Property OnHeaders;
         Property OnGetSocketHandler;
         Property Proxy;
    +    Property NeedToBreak;
       end;
     
       EHTTPClient = Class(EHTTP);
    @@ -661,6 +668,8 @@
       Done:=False;
       CheckLF:=False;
       Repeat
    +    if NeedToBreak then
    +      Break;
         if Length(FBuffer)=0 then
           FillBuffer;
         if Length(FBuffer)=0 then
    @@ -749,6 +758,8 @@
         P:=Pos(':',S);
         System.Delete(S,1,P);
         Repeat
    +      if NeedToBreak then
    +        Break;
           P:=Pos(';',S);
           If (P=0) then
             P:=Length(S)+1;
    @@ -768,6 +779,8 @@
       StatusLine:=ReadString;
       Result:=ParseStatusLine(StatusLine);
       Repeat
    +    if NeedToBreak then
    +      Break;
         S:=ReadString;
         if (S<>'') then
           begin
    @@ -959,9 +972,13 @@
       begin
         BufPos:=1;
         repeat
    +      if NeedToBreak then
    +        Break;
           // read ChunkSize
           ChunkSize:=0;
           repeat
    +        if NeedToBreak then
    +          Break;
             if ReadData(@c,1)<1 then exit;
             case c of
             '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
    @@ -978,6 +995,8 @@
           if ChunkSize=0 then exit;
           // read data
           repeat
    +        if NeedToBreak then
    +          Break;
             l:=length(FBuffer)-BufPos+1;
             if l=0 then
               if not FetchData(l) then
    @@ -1033,6 +1052,8 @@
           // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
           L:=L-LB;
           Repeat
    +        if NeedToBreak then
    +          Break;
             LB:=ReadBufLen;
             If (LB>L) then
               LB:=L;
    @@ -1044,6 +1065,8 @@
           begin
           // No content-length, so we read till no more data available.
           Repeat
    +        if NeedToBreak then
    +          Break;
             R:=Transfer(ReadBufLen);
           until (R=0);
           end;
    @@ -1174,6 +1197,8 @@
       RR:=False;
       M:=AMethod;
       Repeat
    +    if FNeedToBreak then
    +      Break;
         if Not AllowRedirect then
           DoMethod(M,L,Stream,AllowedResponseCodes)
         else
    
    fphttpclient.diff (3,159 bytes)

Activities

Juha Manninen

2017-03-02 15:59

reporter  

0001-fcl-web-Backport-changes-in-fphttpclient-used-in-OPM.patch (27,924 bytes)
From 84b4954b16bee1066727a68495cbdb3bf36ff300 Mon Sep 17 00:00:00 2001
From: juha <juha.manninen62@gmail.com>
Date: Thu, 2 Mar 2017 16:50:10 +0200
Subject: [PATCH] fcl-web: Backport changes in fphttpclient used in OPM.

---
 packages/fcl-web/src/base/fphttpclient.pp | 348 ++++++++++--------------------
 1 file changed, 110 insertions(+), 238 deletions(-)

diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp
index 0633c47040..044f444811 100644
--- a/packages/fcl-web/src/base/fphttpclient.pp
+++ b/packages/fcl-web/src/base/fphttpclient.pp
@@ -15,6 +15,11 @@
 unit fphttpclient;
 
 { ---------------------------------------------------------------------
+  Author: ?
+
+  Balázs Székely implemented a timeout/aborting mechanism which is useful when
+  downloading a large file.
+
   Todo:
   * Proxy support ?
   ---------------------------------------------------------------------}
@@ -70,7 +75,6 @@ Type
     FDataRead : Int64;
     FContentLength : Int64;
     FAllowRedirect: Boolean;
-    FKeepConnection: Boolean;
     FMaxRedirects: Byte;
     FOnDataReceived: TDataEvent;
     FOnHeaders: TNotifyEvent;
@@ -91,6 +95,7 @@ Type
     FBuffer : Ansistring;
     FUserName: String;
     FOnGetSocketHandler : TGetSocketHandlerEvent;
+    FNeedToBreak: Boolean;
     FProxy : TProxyData;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
@@ -98,26 +103,11 @@ Type
     function GetProxy: TProxyData;
     Procedure ResetResponse;
     Procedure SetCookies(const AValue: TStrings);
-    procedure SetHTTPVersion(const AValue: String);
-    procedure SetKeepConnection(AValue: Boolean);
     procedure SetProxy(AValue: TProxyData);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
-    Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
-    Procedure CheckConnectionCloseHeader;
   protected
-
     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
     Function ProxyActive : Boolean;
     // Override this if you want to create a custom instance of proxy.
@@ -129,23 +119,19 @@ Type
     // Construct server URL for use in request line.
     function GetServerURL(URI: TURI): String;
     // Read 1 line of response. Fills FBuffer
-    function ReadString(out S: String): Boolean;
+    function ReadString: String;
     // 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.
-    Function ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False): Boolean; virtual;
+    Procedure ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); 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.
@@ -172,7 +158,7 @@ Type
     // Add header, replacing an existing one if it exists.
     Procedure AddHeader(Const AHeader,AValue : String);
     // 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).
     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
@@ -245,7 +231,7 @@ Type
     Procedure FormPost(const URL : string; FormData:  TStrings; const Response: TStrings);
     function FormPost(const URL, FormData: string): String;
     function FormPost(const URL: string; FormData : TStrings): String;
-    // Simple form 
+    // Simple form
     Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStream);
     Class Procedure SimpleFormPost(const URL : string; FormData:  TStrings; const Response: TStream);
     Class Procedure SimpleFormPost(const URL, FormData: string; const Response: TStrings);
@@ -274,8 +260,7 @@ Type
     // Optional body to send (mainly in POST request)
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
     // used HTTP version when constructing the request.
-    // Setting this to any other value than 1.1 will set KeepConnection to False.
-    Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
+    Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
     // After request properties.
     // After request, this contains the headers sent by server.
     Property ResponseHeaders : TStrings Read FResponseHeaders;
@@ -299,10 +284,6 @@ 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. 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.
     // It can modify the username/password and set RepeatRequest to true;
     Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
@@ -312,14 +293,12 @@ Type
     Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
     // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
     Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
-
+    Property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak;
   end;
 
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
   Published
-    Property KeepConnection;
-    Property Connected;
     Property IOTimeout;
     Property RequestHeaders;
     Property RequestBody;
@@ -339,6 +318,7 @@ Type
     Property OnHeaders;
     Property OnGetSocketHandler;
     Property Proxy;
+    Property NeedToBreak;
   end;
 
   EHTTPClient = Class(EHTTP);
@@ -347,19 +327,19 @@ Function EncodeURLElement(S : String) : String;
 Function DecodeURLElement(Const S : String) : String;
 
 implementation
-{$if not defined(hasamiga)}
+{$if not defined(HASAMIGA)}
 uses sslsockets;
 {$endif}
 
 resourcestring
-  SErrInvalidProtocol = 'Invalid protocol : "%s"';
+  SErrInvalidProtocol = 'Invalid protocol: "%s"';
   SErrReadingSocket = 'Error reading data from socket';
   SErrInvalidProtocolVersion = 'Invalid protocol version in response: "%s"';
   SErrInvalidStatusCode = 'Invalid response status code: %s';
   SErrUnexpectedResponse = 'Unexpected response status code: %d';
   SErrChunkTooBig = 'Chunk too big';
   SErrChunkLineEndMissing = 'Chunk line end missing';
-  SErrMaxRedirectsReached = 'Maximum allowed redirects reached : %d';
+  SErrMaxRedirectsReached = 'Maximum allowed redirects reached: %d';
   //SErrRedirectAborted = 'Redirect aborted.';
 
 Const
@@ -481,13 +461,8 @@ procedure TFPCustomHTTPClient.SetIOTimeout(AValue: Integer);
 begin
   if AValue=FIOTimeout then exit;
   FIOTimeout:=AValue;
-  if Assigned(FSocket) then
-    FSocket.IOTimeout:=AValue;
-end;
-
-function TFPCustomHTTPClient.IsConnected: Boolean;
-begin
-  Result := Assigned(FSocket);
+   if Assigned(FSocket) then
+     FSocket.IOTimeout:=AValue;
 end;
 
 function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
@@ -564,7 +539,7 @@ begin
     If UseSSL then
       Result:=TSSLSocketHandler.Create
     else
-  {$endif}  
+  {$endif}
       Result:=TSocketHandler.Create;
 end;
 
@@ -574,20 +549,17 @@ procedure TFPCustomHTTPClient.ConnectToServer(const AHost: String;
 Var
   G : TSocketHandler;
 
-
 begin
-  If IsConnected Then
-    DisconnectFromServer; // avoid memory leaks
   if (Aport=0) then
     if UseSSL then
       Aport:=443
     else
       Aport:=80;
-  G:=GetSocketHandler(UseSSL);    
+  G:=GetSocketHandler(UseSSL);
   FSocket:=TInetSocket.Create(AHost,APort,G);
   try
-    if FIOTimeout<>0 then
-      FSocket.IOTimeout:=FIOTimeout;
+    if FIOTimeout <> 0 then
+      FSocket.IOTimeout := FIOTimeout;
     FSocket.Connect;
   except
     FreeAndNil(FSocket);
@@ -595,13 +567,6 @@ begin
   end;
 end;
 
-Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
-  APort: Integer; UseSSL: Boolean);
-begin
-  DisconnectFromServer;
-  ConnectToServer(AHost, APort, UseSSL);
-end;
-
 procedure TFPCustomHTTPClient.DisconnectFromServer;
 
 begin
@@ -614,11 +579,6 @@ 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
@@ -653,7 +613,6 @@ begin
   S:=S+CRLF;
   If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
     AddHeader('Content-Length',IntToStr(RequestBody.Size));
-  CheckConnectionCloseHeader;
   For I:=0 to FRequestHeaders.Count-1 do
     begin
     l:=FRequestHeaders[i];
@@ -681,9 +640,9 @@ begin
     FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
 end;
 
-function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
+function TFPCustomHTTPClient.ReadString : String;
 
-  Function FillBuffer: Boolean;
+  Procedure FillBuffer;
 
   Var
     R : Integer;
@@ -691,42 +650,40 @@ function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
   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: Boolean;
+  CheckLF,Done : Boolean;
   P,L : integer;
 
 begin
-  S:='';
-  Result:=False;
+  Result:='';
+  Done:=False;
   CheckLF:=False;
   Repeat
+    if NeedToBreak then
+      Break;
     if Length(FBuffer)=0 then
-      if not FillBuffer then
-        Break;
+      FillBuffer;
     if Length(FBuffer)=0 then
-      Result:=True
+      Done:=True
     else if CheckLF then
       begin
       If (FBuffer[1]<>#10) then
-        S:=S+#13
+        Result:=Result+#13
       else
         begin
         System.Delete(FBuffer,1,1);
-        Result:=True;
+        Done:=True;
         end;
       end;
-    if not Result then
+    if not Done then
       begin
       P:=Pos(#13#10,FBuffer);
       If P=0 then
@@ -734,19 +691,19 @@ begin
         L:=Length(FBuffer);
         CheckLF:=FBuffer[L]=#13;
         if CheckLF then
-          S:=S+Copy(FBuffer,1,L-1)
+          Result:=Result+Copy(FBuffer,1,L-1)
         else
-          S:=S+FBuffer;
+          Result:=Result+FBuffer;
         FBuffer:='';
         end
       else
         begin
-        S:=S+Copy(FBuffer,1,P-1);
+        Result:=Result+Copy(FBuffer,1,P-1);
         System.Delete(FBuffer,1,P+1);
-        Result:=True;
+        Done:=True;
         end;
       end;
-  until Result;
+  until Done;
 end;
 
 Function GetNextWord(Var S : String) : string;
@@ -801,6 +758,8 @@ function TFPCustomHTTPClient.ReadResponseHeaders: integer;
     P:=Pos(':',S);
     System.Delete(S,1,P);
     Repeat
+      if NeedToBreak then
+        Break;
       P:=Pos(';',S);
       If (P=0) then
         P:=Length(S)+1;
@@ -817,11 +776,13 @@ Var
   StatusLine,S : String;
 
 begin
-  if not ReadString(StatusLine) then
-    Exit(0);
+  StatusLine:=ReadString;
   Result:=ParseStatusLine(StatusLine);
   Repeat
-    if ReadString(S) and (S<>'') then
+    if NeedToBreak then
+      Break;
+    S:=ReadString;
+    if (S<>'') then
       begin
       ResponseHeaders.Add(S);
       If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
@@ -929,33 +890,14 @@ begin
   GetCookies.Assign(AValue);
 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);
 begin
   if (AValue=FProxy) then exit;
   Proxy.Assign(AValue);
 end;
 
-Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
-  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
+procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
+  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
 
   Function Transfer(LB : Integer) : Integer;
 
@@ -1030,9 +972,13 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
   begin
     BufPos:=1;
     repeat
+      if NeedToBreak then
+        Break;
       // read ChunkSize
       ChunkSize:=0;
       repeat
+        if NeedToBreak then
+          Break;
         if ReadData(@c,1)<1 then exit;
         case c of
         '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
@@ -1049,6 +995,8 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
       if ChunkSize=0 then exit;
       // read data
       repeat
+        if NeedToBreak then
+          Break;
         l:=length(FBuffer)-BufPos+1;
         if l=0 then
           if not FetchData(l) then
@@ -1083,9 +1031,6 @@ 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
@@ -1107,6 +1052,8 @@ begin
       // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
       L:=L-LB;
       Repeat
+        if NeedToBreak then
+          Break;
         LB:=ReadBufLen;
         If (LB>L) then
           LB:=L;
@@ -1118,105 +1065,21 @@ begin
       begin
       // No content-length, so we read till no more data available.
       Repeat
+        if NeedToBreak then
+          Break;
         R:=Transfer(ReadBufLen);
       until (R=0);
       end;
     end;
 end;
 
-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
-  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);
+procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
+  Stream: TStream; const AllowedResponseCodes: array of Integer);
 
 Var
-  URI: TURI;
-  P: String;
-  IsHttps, HeadersOnly: Boolean;
+  URI : TURI;
+  P,CHost : String;
+  CPort : Word;
 
 begin
   ResetResponse;
@@ -1224,12 +1087,23 @@ begin
   p:=LowerCase(URI.Protocol);
   If Not ((P='http') or (P='https')) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
-  IsHttps:=P='https';
-  HeadersOnly:=CompareText(AMethod,'HEAD')=0;
-  if FKeepConnection then
-    DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
+  if ProxyActive then
+    begin
+    CHost:=Proxy.Host;
+    CPort:=Proxy.Port;
+    end
   else
-    DoNormalRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps);
+    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;
 end;
 
 constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
@@ -1238,17 +1112,13 @@ begin
   // Infinite timeout on most platforms
   FIOTimeout:=0;
   FRequestHeaders:=TStringList.Create;
-  FRequestHeaders.NameValueSeparator:=':';
   FResponseHeaders:=TStringList.Create;
-  FResponseHeaders.NameValueSeparator:=':';
-  HTTPVersion:='1.1';
+  FHTTPVersion:='1.1';
   FMaxRedirects:=DefMaxRedirects;
 end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
-  if IsConnected then
-    DisconnectFromServer;
   FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
@@ -1327,6 +1197,8 @@ begin
   RR:=False;
   M:=AMethod;
   Repeat
+    if FNeedToBreak then
+      Break;
     if Not AllowRedirect then
       DoMethod(M,L,Stream,AllowedResponseCodes)
     else
@@ -1426,7 +1298,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Get(AURL,Stream);
     finally
       Free;
@@ -1440,7 +1312,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Get(AURL,LocalFileName);
     finally
       Free;
@@ -1454,7 +1326,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Get(AURL,Response);
     finally
       Free;
@@ -1463,7 +1335,7 @@ end;
 
 
 class function TFPCustomHTTPClient.SimpleGet(const AURL: String): String;
- 
+
 begin
   With Self.Create(nil) do
     try
@@ -1522,7 +1394,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Post(URL,Response);
     finally
       Free;
@@ -1536,7 +1408,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Post(URL,Response);
     finally
       Free;
@@ -1550,7 +1422,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Post(URL,LocalFileName);
     finally
       Free;
@@ -1563,7 +1435,7 @@ class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Result:=Post(URL);
     finally
       Free;
@@ -1614,7 +1486,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Put(URL,Response);
     finally
       Free;
@@ -1627,7 +1499,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Put(URL,Response);
     finally
       Free;
@@ -1640,7 +1512,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Put(URL,LocalFileName);
     finally
       Free;
@@ -1652,7 +1524,7 @@ class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Result:=Put(URL);
     finally
       Free;
@@ -1704,7 +1576,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Delete(URL,Response);
     finally
       Free;
@@ -1717,7 +1589,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Delete(URL,Response);
     finally
       Free;
@@ -1730,7 +1602,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Delete(URL,LocalFileName);
     finally
       Free;
@@ -1742,7 +1614,7 @@ class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Result:=Delete(URL);
     finally
       Free;
@@ -1794,7 +1666,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Options(URL,Response);
     finally
       Free;
@@ -1807,7 +1679,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Options(URL,Response);
     finally
       Free;
@@ -1820,7 +1692,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Options(URL,LocalFileName);
     finally
       Free;
@@ -1832,7 +1704,7 @@ class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Result:=Options(URL);
     finally
       Free;
@@ -1843,7 +1715,7 @@ class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       HTTPMethod('HEAD', AURL, Nil, [200]);
       Headers.Assign(ResponseHeaders);
     Finally
@@ -1928,7 +1800,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1942,7 +1814,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1956,7 +1828,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1969,7 +1841,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1982,7 +1854,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1995,7 +1867,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -2074,7 +1946,7 @@ class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
 begin
   With Self.Create(nil) do
     try
-      KeepConnection := False;
+      RequestHeaders.Add('Connection: Close');
       FileFormPost(AURL,AFieldName,AFileName,Response);
     Finally
       Free;
-- 
2.12.0

Michael Van Canneyt

2017-03-02 18:30

administrator   ~0098574

Have you checked this patch ?
There is no way that this will be applied as-is.

Someone will need to redo the patch.

It destroys the KeepAlive (Connection:Close) support by sergio clecio.
It also destroys proxy support.

Juha Manninen

2017-03-02 18:50

reporter   ~0098578

Ok, I see the code was changed too much. Maybe Balázs can make minimal changes to fphttpclient and add only the needed extensions.

Anyway the long term goal must be to dump the forked code and use the one provided by FPC.

Balázs Székely

2017-03-02 22:29

reporter   ~0098579

Last edited: 2017-03-02 22:52

View 3 revisions

@Michael
To prevent confusion I attach my original modifications as unified-diff(fphttpclient.diff), made back in 2016 October. As you can see there is no dramatic change compared with the trunk from that time(r 34062). Basically all I did was to add a boolean variable FNeedToBreak. The name is self explanatory, when downloading large files you need a mechanism to break/exit. With the current implementation, the user has to wait until the download is completed, which is not very practical in my opinion.

Since then a lot has changed in trunk. If you agree, I can add the boolean again and we are good to go. If not please suggest a better approach.

@Juha
Let's say the modification needed for OPM gets into the trunk and will be available in future FPC releases. How do you plan to support OPM for user with FPC versions 3.0.0/3.0.2? I mean 3.0.2 is the newest release and will stay a while but does not contain the code needed for OPM. Ok it can be done with ifdef's still...

Balázs Székely

2017-03-02 22:29

reporter  

fphttpclient.diff (3,159 bytes)
Index: fphttpclient.pp
===================================================================
--- fphttpclient.pp	(revision 34062)
+++ fphttpclient.pp	(working copy)
@@ -18,6 +18,11 @@
   Todo:
   * Proxy support ?
   ---------------------------------------------------------------------}
+{
+  TFPHTTPClient does not implement a timeout/aborting mechanism(2016.10.01), which
+  is useful when downloading a large file for example. opkman_httpclient and opkman_downloader
+  fix this issue.
+}
 
 {$mode objfpc}{$H+}
 
@@ -90,6 +95,7 @@
     FBuffer : Ansistring;
     FUserName: String;
     FOnGetSocketHandler : TGetSocketHandlerEvent;
+    FNeedToBreak: Boolean;
     FProxy : TProxyData;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
@@ -287,7 +293,7 @@
     Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
     // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
     Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
-
+    Property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak;
   end;
 
 
@@ -312,6 +318,7 @@
     Property OnHeaders;
     Property OnGetSocketHandler;
     Property Proxy;
+    Property NeedToBreak;
   end;
 
   EHTTPClient = Class(EHTTP);
@@ -661,6 +668,8 @@
   Done:=False;
   CheckLF:=False;
   Repeat
+    if NeedToBreak then
+      Break;
     if Length(FBuffer)=0 then
       FillBuffer;
     if Length(FBuffer)=0 then
@@ -749,6 +758,8 @@
     P:=Pos(':',S);
     System.Delete(S,1,P);
     Repeat
+      if NeedToBreak then
+        Break;
       P:=Pos(';',S);
       If (P=0) then
         P:=Length(S)+1;
@@ -768,6 +779,8 @@
   StatusLine:=ReadString;
   Result:=ParseStatusLine(StatusLine);
   Repeat
+    if NeedToBreak then
+      Break;
     S:=ReadString;
     if (S<>'') then
       begin
@@ -959,9 +972,13 @@
   begin
     BufPos:=1;
     repeat
+      if NeedToBreak then
+        Break;
       // read ChunkSize
       ChunkSize:=0;
       repeat
+        if NeedToBreak then
+          Break;
         if ReadData(@c,1)<1 then exit;
         case c of
         '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
@@ -978,6 +995,8 @@
       if ChunkSize=0 then exit;
       // read data
       repeat
+        if NeedToBreak then
+          Break;
         l:=length(FBuffer)-BufPos+1;
         if l=0 then
           if not FetchData(l) then
@@ -1033,6 +1052,8 @@
       // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
       L:=L-LB;
       Repeat
+        if NeedToBreak then
+          Break;
         LB:=ReadBufLen;
         If (LB>L) then
           LB:=L;
@@ -1044,6 +1065,8 @@
       begin
       // No content-length, so we read till no more data available.
       Repeat
+        if NeedToBreak then
+          Break;
         R:=Transfer(ReadBufLen);
       until (R=0);
       end;
@@ -1174,6 +1197,8 @@
   RR:=False;
   M:=AMethod;
   Repeat
+    if FNeedToBreak then
+      Break;
     if Not AllowRedirect then
       DoMethod(M,L,Stream,AllowedResponseCodes)
     else
fphttpclient.diff (3,159 bytes)

Michael Van Canneyt

2017-03-03 00:13

administrator   ~0098582

Balázs,

I looked at your patch. I will do this myself, but in keeping with other mechanisms (TThread, TApplication) I will create a procedure Terminate, and a property Terminated.

Balázs Székely

2017-03-03 08:11

reporter   ~0098583

>I looked at your patch. I will do this myself, but in keeping with other mechanisms (TThread, TApplication) I will create a procedure Terminate, and a property Terminated.
Thank you!

Juha Manninen

2017-03-03 10:22

reporter   ~0098586

Sorry, I should have checked the recent changes before making a patch.
It is great if Michael can solve it in a clean way.

@Balázs
FPC versions can be supported with IFDEFs. It is especially easy because the forked units have different names. Good.
Lazarus supports 2 latest FPC release versions. When the change propagates there then we remove the forks.

Marco van de Voort

2017-03-03 12:06

manager   ~0098595

Hmm. If you break using that patch and reuse the component it will break again. Maybe fphttpclient needs some reset method (if not already)? It could also reset the request header, a regular faq item.

Michael Van Canneyt

2017-03-04 14:29

administrator   ~0098624

Implemented. I made it slightly more fine grained, and tried to avoid some exceptions in case of termination.

Please test and close if OK.

Juha Manninen

2017-03-06 14:24

reporter   ~0098685

Thank you.
It is now used also by the Lazarus online package manager.

Issue History

Date Modified Username Field Change
2017-03-02 15:59 Juha Manninen New Issue
2017-03-02 15:59 Juha Manninen File Added: 0001-fcl-web-Backport-changes-in-fphttpclient-used-in-OPM.patch
2017-03-02 18:30 Michael Van Canneyt Note Added: 0098574
2017-03-02 18:30 Michael Van Canneyt Assigned To => Michael Van Canneyt
2017-03-02 18:30 Michael Van Canneyt Status new => feedback
2017-03-02 18:50 Juha Manninen Note Added: 0098578
2017-03-02 18:50 Juha Manninen Status feedback => assigned
2017-03-02 22:29 Balázs Székely Note Added: 0098579
2017-03-02 22:29 Balázs Székely File Added: fphttpclient.diff
2017-03-02 22:51 Balázs Székely Note Edited: 0098579 View Revisions
2017-03-02 22:52 Balázs Székely Note Edited: 0098579 View Revisions
2017-03-03 00:13 Michael Van Canneyt Note Added: 0098582
2017-03-03 08:11 Balázs Székely Note Added: 0098583
2017-03-03 10:22 Juha Manninen Note Added: 0098586
2017-03-03 12:06 Marco van de Voort Note Added: 0098595
2017-03-04 14:29 Michael Van Canneyt Fixed in Revision => 35516
2017-03-04 14:29 Michael Van Canneyt Note Added: 0098624
2017-03-04 14:29 Michael Van Canneyt Status assigned => resolved
2017-03-04 14:29 Michael Van Canneyt Fixed in Version => 3.1.1
2017-03-04 14:29 Michael Van Canneyt Resolution open => fixed
2017-03-04 14:29 Michael Van Canneyt Target Version => 3.2.0
2017-03-06 14:24 Juha Manninen Note Added: 0098685
2017-03-06 14:24 Juha Manninen Status resolved => closed