* Fix bug ID #31470: allow termination

git-svn-id: trunk@35516 -

packages/fcl-web/src/base/fphttpclient.pp

@@ -89,6 +89,7 @@ Type
     FServerHTTPVersion: String;
     FSocket : TInetSocket;
     FBuffer : Ansistring;
+    FTerminated: Boolean;
     FUserName: String;
     FOnGetSocketHandler : TGetSocketHandlerEvent;
     FProxy : TProxyData;
@@ -166,6 +167,9 @@ Type
     Class Function IndexOfHeader(HTTPHeaders : TStrings; Const AHeader : String) : Integer;
     // Return value of header AHeader from httpheaders. Returns empty if it doesn't exist yet.
     Class Function GetHeader(HTTPHeaders : TStrings; Const AHeader : String) : String;
+    { Terminate the current request.
+      It will stop the client from trying to send and/or receive data after the current chunk is sent/received. }
+    Procedure Terminate;
     // Request Header management
     // Return index of header, -1 if not present.
     Function IndexOfHeader(Const AHeader : String) : Integer;
@@ -262,6 +266,8 @@ Type
     Procedure StreamFormPost(const AURL: string; FormData: TStrings; const AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
     // Simple form of Posting a file
     Class Procedure SimpleFileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
+    // Has Terminate been called ?
+    Property Terminated : Boolean Read FTerminated;
   Protected
     // Timeouts
     Property IOTimeout : Integer read FIOTimeout write SetIOTimeout;
@@ -676,8 +682,9 @@ begin
   FSentCookies:=FCookies;
   FCookies:=Nil;
   S:=S+CRLF;
-  FSocket.WriteBuffer(S[1],Length(S));
-  If Assigned(FRequestBody) then
+  if not Terminated then
+    FSocket.WriteBuffer(S[1],Length(S));
+  If Assigned(FRequestBody) and not Terminated then
     FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
 end;
 
@@ -689,11 +696,13 @@ function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
     R : Integer;
 
   begin
+    if Terminated then
+      Exit(False);
     SetLength(FBuffer,ReadBufLen);
     r:=FSocket.Read(FBuffer[1],ReadBufLen);
-    If r=0 Then
+    If (r=0) or Terminated Then
       Exit(False);
-    If r<0 then
+    If (r<0) then
       Raise EHTTPClient.Create(SErrReadingSocket);
     if (r<ReadBuflen) then
       SetLength(FBuffer,r);
@@ -746,7 +755,7 @@ begin
         Result:=True;
         end;
       end;
-  until Result;
+  until Result or Terminated;
 end;
 
 Function GetNextWord(Var S : String) : string;
@@ -807,7 +816,7 @@ function TFPCustomHTTPClient.ReadResponseHeaders: integer;
       C:=Trim(Copy(S,1,P-1));
       Cookies.Add(C);
       System.Delete(S,1,P);
-    Until (S='');
+    Until (S='') or Terminated;
   end;
 
 Const
@@ -827,8 +836,8 @@ begin
       If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
         DoCookies(S);
       end
-  Until (S='');
-  If Assigned(FOnHeaders) then
+  Until (S='') or Terminated;
+  If Assigned(FOnHeaders) and not Terminated then
     FOnHeaders(Self);
 end;
 
@@ -990,6 +999,9 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
     function FetchData(out Cnt: integer): boolean;
 
     begin
+      Result:=False;
+      If Terminated then
+        exit;
       SetLength(FBuffer,ReadBuflen);
       Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
       If Cnt<0 then
@@ -1038,17 +1050,20 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
         '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
         'a'..'f': ChunkSize:=ChunkSize*16+ord(c)-ord('a')+10;
         'A'..'F': ChunkSize:=ChunkSize*16+ord(c)-ord('A')+10;
-        else break;
+        else
+          break;
         end;
         if ChunkSize>1000000 then
           Raise EHTTPClient.Create(SErrChunkTooBig);
-      until false;
+      until Terminated;
       // read till line end
-      while (c<>#10) do
+      while (c<>#10) and not Terminated do
         if ReadData(@c,1)<1 then exit;
       if ChunkSize=0 then exit;
       // read data
       repeat
+        if Terminated then
+          exit;
         l:=length(FBuffer)-BufPos+1;
         if l=0 then
           if not FetchData(l) then
@@ -1064,14 +1079,18 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
           end;
       until ChunkSize=0;
       // read #13#10
-      if ReadData(@c,1)<1 then exit;
-      if c<>#13 then
-        Raise EHTTPClient.Create(SErrChunkLineEndMissing);
-      if ReadData(@c,1)<1 then exit;
-      if c<>#10 then
-        Raise EHTTPClient.Create(SErrChunkLineEndMissing);
-      // next chunk
-    until false;
+      if ReadData(@c,1)<1 then
+        exit;
+      if Not Terminated then
+        begin
+        if c<>#13 then
+          Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+        if ReadData(@c,1)<1 then exit;
+        if c<>#10 then
+          Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+        // next chunk
+        end;
+    until Terminated;
   end;
 
 Var
@@ -1112,14 +1131,14 @@ begin
           LB:=L;
         R:=Transfer(LB);
         L:=L-R;
-      until (L=0) or (R=0);
+      until (L=0) or (R=0) or Terminated;
       end
     else if (L<0) and (Not NoContentAllowed(ResponseStatusCode)) then
       begin
       // No content-length, so we read till no more data available.
       Repeat
         R:=Transfer(ReadBufLen);
-      until (R=0);
+      until (R=0) or Terminated;
       end;
     end;
 end;
@@ -1176,7 +1195,8 @@ begin
   ConnectToServer(CHost,CPort,AIsHttps);
   Try
     SendRequest(AMethod,AURI);
-    ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+    if not Terminated then
+      ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
   Finally
     DisconnectFromServer;
   End;
@@ -1199,15 +1219,20 @@ begin
     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);
+      if not Terminated then
+        SendRequest(AMethod,AURI);
+      if not Terminated then
+        begin
+        T := ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+        If Not T Then
+          ReconnectToServer(CHost,CPort,AIsHttps);
+        end;
     Finally
-      If HasConnectionClose Then
+      // On terminate, we close the request
+      If HasConnectionClose or Terminated Then
         DisconnectFromServer;
     End;
-  Until T;
+  Until T or Terminated;
 end;
 
 Procedure TFPCustomHTTPClient.DoMethod(Const AMethod, AURL: String;
@@ -1302,6 +1327,11 @@ begin
     end;
 end;
 
+procedure TFPCustomHTTPClient.Terminate;
+begin
+  FTerminated:=True;
+end;
+
 procedure TFPCustomHTTPClient.ResetResponse;
 
 begin
@@ -1322,6 +1352,8 @@ Var
   RR : Boolean; // Repeat request ?
 
 begin
+  // Reset Terminated
+  FTerminated:=False;
   L:=AURL;
   RC:=0;
   RR:=False;
@@ -1332,7 +1364,7 @@ begin
     else
       begin
       DoMethod(M,L,Stream,AllowedResponseCodes);
-      if IsRedirect(FResponseStatusCode) then
+      if IsRedirect(FResponseStatusCode) and not Terminated then
         begin
         Inc(RC);
         if (RC>MaxRedirects) then
@@ -1359,7 +1391,7 @@ begin
       end
     else
       RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'');
-  until not RR;
+  until Terminated or not RR ;
 end;
 
 procedure TFPCustomHTTPClient.Get(const AURL: String; Stream: TStream);