paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 06:59:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug ID #31470: allow termination

Browse Source 
git-svn-id: trunk@35516 -
This commit is contained in:
michael 2017-03-04 13:14:26 +00:00
parent d2b1232f33
commit 236e56dee0
1 changed files with 62 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
packages/fcl-web/src/base/fphttpclient.pp
View File

@ -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);