paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 17:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

fphttpclient: remove OnIdle and add protected methods so that the feature can be added in a descendant

Browse Source
This commit is contained in:
Ondrej Pokorny 2021-09-01 22:01:29 +02:00 committed by Michael Van Canneyt
parent 67b08734cf
commit 008214ca15
2 changed files with 88 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19,7 +19,7 @@ unit fphttpclient;
interface
uses
Classes, SysUtils, ssockets, httpdefs, uriparser, base64, sslsockets, DateUtils;
Classes, SysUtils, ssockets, httpdefs, uriparser, base64, sslsockets;
Const
// Socket Read buffer size
@ -74,7 +74,6 @@ Type
FKeepConnectionReconnectLimit: Integer;
FMaxChunkSize: SizeUInt;
FMaxRedirects: Byte;
FOnIdle: TNotifyEvent;
FOnDataReceived: TDataEvent;
FOnDataSent: TDataEvent;
FOnHeaders: TNotifyEvent;
@ -133,10 +132,6 @@ Type
Function ProxyActive : Boolean;
// Override this if you want to create a custom instance of proxy.
Function CreateProxyData : TProxyData;
// Called before data is read.
Procedure DoBeforeDataRead; virtual;
// Called when the client is waiting for the server.
Procedure DoOnIdle;
// Called whenever data is read.
Procedure DoDataRead; virtual;
// Called whenever data is written.
@ -145,6 +140,10 @@ Type
Function ParseStatusLine(AStatusLine : String) : Integer;
// Construct server URL for use in request line.
function GetServerURL(URI: TURI): String;
// Read raw data from socket
Function ReadFromSocket(var Buffer; Count: Longint): Longint; virtual;
// Write raw data to socket
Function WriteToSocket(const Buffer; Count: Longint): Longint; virtual;
// Read 1 line of response. Fills FBuffer
function ReadString(out S: String): Boolean;
// Write string
@ -300,6 +299,8 @@ Type
// Has Terminate been called ?
Property Terminated : Boolean Read FTerminated;
Protected
// Socket
Property Socket : TInetSocket read FSocket;
// Timeouts
Property IOTimeout : Integer read FIOTimeout write SetIOTimeout;
Property ConnectTimeout : Integer read FConnectTimeout write SetConnectTimeout;
@ -353,8 +354,6 @@ Type
Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
// Called whenever data is read from the connection.
Property OnDataReceived : TDataEvent Read FOnDataReceived Write FOnDataReceived;
// Called when the client is waiting for the server
Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdle;
// Called whenever data is written to the connection.
Property OnDataSent : TDataEvent Read FOnDataSent Write FOnDataSent;
// Called when headers have been processed.
@ -390,7 +389,6 @@ Type
Property OnPassword;
Property OnDataReceived;
Property OnDataSent;
Property OnIdle;
Property OnHeaders;
Property OnGetSocketHandler;
Property Proxy;
@ -700,24 +698,13 @@ begin
FreeAndNil(FSocket);
end;
procedure TFPCustomHTTPClient.DoBeforeDataRead;
var
BreakUTC: TDateTime;
function TFPCustomHTTPClient.ReadFromSocket(var Buffer; Count: Longint): Longint;
begin
// Use CanRead to keep the client responsive in case the server needs a lot of time to respond.
// The request can be terminated in OnIdle - therefore it makes sense only if FOnIdle is set
If not Assigned(FOnIdle) Then
Exit;
if IOTimeout>0 then
BreakUTC := IncMilliSecond(NowUTC, IOTimeout);
while not Terminated and not FSocket.CanRead(10) and (FSocket.LastError=0) do
begin
DoOnIdle;
if (IOTimeout>0) and (CompareDateTime(NowUTC, BreakUTC)>0) then // we exceeded the timeout -> read error
Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
end;
if FSocket.LastError<>0 then
Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
Result:=FSocket.Read(Buffer,Count)
end;
function TFPCustomHTTPClient.WriteToSocket(const Buffer; Count: Longint): Longint;
begin
Result:=FSocket.Write(Buffer,Count)
end;
function TFPCustomHTTPClient.AllowHeader(var AHeader: String): Boolean;
@ -811,11 +798,10 @@ function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
R : Integer;
begin
DoBeforeDataRead;
if Terminated then
Exit(False);
SetLength(FBuffer,ReadBufLen);
r:=FSocket.Read(FBuffer[1],ReadBufLen);
r:=ReadFromSocket(FBuffer[1],ReadBufLen);
If (r=0) or Terminated Then
Exit(False);
If (r<0) then
@ -884,7 +870,7 @@ begin
T:=0;
Repeat
r:=FSocket.Write(S[t+1],Length(S)-t);
r:=WriteToSocket(S[t+1],Length(S)-t);
inc(t,r);
DoDataWrite;
Until Terminated or (t=Length(S)) or (r<=0);
@ -919,7 +905,7 @@ begin
begin
T:=0;
Repeat
w:=FSocket.Write(PByte(Buffer)[t],i-t);
w:=WriteToSocket(PByte(Buffer)[t],i-t);
FRequestDataWritten:=FRequestDataWritten+w;
DoDataWrite;
inc(t,w);
@ -1153,10 +1139,9 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
Function Transfer(LB : Integer) : Integer;
begin
DoBeforeDataRead;
if Terminated then
Exit(0);
Result:=FSocket.Read(FBuffer[1],LB);
Result:=ReadFromSocket(FBuffer[1],LB);
If Result<0 then
Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
if (Result>0) then
@ -1187,11 +1172,10 @@ Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
begin
Result:=False;
DoBeforeDataRead;
If Terminated then
exit;
SetLength(FBuffer,ReadBuflen);
Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
Cnt:=ReadFromSocket(FBuffer[1],length(FBuffer));
If Cnt<0 then
Raise EHTTPClientSocketRead.Create(SErrReadingSocket);
SetLength(FBuffer,Cnt);
@ -1392,12 +1376,6 @@ begin
End;
end;
procedure TFPCustomHTTPClient.DoOnIdle;
begin
If Assigned(FOnIdle) Then
FOnIdle(Self);
end;
Procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI;
const AMethod: string; AStream: TStream;
const AAllowedResponseCodes: array of Integer;

166
packages/fcl-web/src/base/fphttpclientasyncpool.pas
View File

@ -180,7 +180,6 @@ type
procedure OnDataReceived(Sender: TObject; const aContentLength, aCurrentPos: Int64);
procedure OnDataSent(Sender: TObject; const aContentLength, aCurrentPos: Int64);
procedure OnIdle(Sender: TObject);
// the ExecOn* methods call their DoOn* counterparts - do the synchronisation here
procedure ExecOnInit;
@ -253,6 +252,7 @@ type
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function CreatePool: TFPCustomHTTPClientPool; virtual;
function CreateRequestThread(aRequest: TFPHTTPClientAsyncPoolRequest; aClient: TFPHTTPClient): TFPHTTPClientAsyncPoolRequestThread; virtual;
function CreateWaitForAllRequestsThread(const aOnAllDone: TNotifyEvent; const aSynchronizeOnAllDone: Boolean;
const aOwner: TComponent; const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolWaitForAllThread; virtual;
@ -366,6 +366,7 @@ begin
inherited OwnerDestroyed;
fOwner := nil;
fOnAllDone := nil;
end;
{ TFPHTTPClientAsyncPoolThread }
@ -601,6 +602,11 @@ begin
InterlockedIncrement(fBlockRequestsCounter);
end;
function TFPCustomHTTPClientAsyncPool.CreatePool: TFPCustomHTTPClientPool;
begin
Result := TFPCustomHTTPClientPool.Create(Self);
end;
function TFPCustomHTTPClientAsyncPool.CreateRequestThread(aRequest: TFPHTTPClientAsyncPoolRequest;
aClient: TFPHTTPClient): TFPHTTPClientAsyncPoolRequestThread;
begin
@ -618,7 +624,7 @@ constructor TFPCustomHTTPClientAsyncPool.Create(AOwner: TComponent);
begin
fWorkingThreads := TThreadList.Create;
fWaitingQueue := TList.Create;
fHttpPool := TFPCustomHTTPClientPool.Create(Self);
fHttpPool := CreatePool;
fDoOnAbortedFinishSynchronizedCS := TCriticalSection.Create;
inherited Create(AOwner);
@ -986,12 +992,6 @@ begin
OnDataReceivedSend(Sender, pdDataSent, aContentLength, aCurrentPos);
end;
procedure TFPHTTPClientAsyncPoolRequestThread.OnIdle(Sender: TObject);
begin
if Terminated then
(Sender as TFPCustomHTTPClient).Terminate;
end;
procedure TFPHTTPClientAsyncPoolRequestThread.OwnerDestroyed;
begin
inherited;
@ -1026,47 +1026,19 @@ begin
end;
procedure TFPHTTPClientAsyncPoolRequestThread.ExecOnFinish;
var
xUnlocked: Boolean;
begin
xUnlocked := False;
LockProperties;
try
if Request.SynchronizeOnFinish then
begin
UnlockProperties;
xUnlocked := True;
Synchronize(@DoOnFinish)
end
else
DoOnFinish;
finally
if not xUnlocked then
UnlockProperties;
end;
if Request.SynchronizeOnFinish then
Synchronize(@DoOnFinish)
else
DoOnFinish;
end;
procedure TFPHTTPClientAsyncPoolRequestThread.ExecOnInit;
var
xUnlocked: Boolean;
begin
xUnlocked := False;
LockProperties;
try
if not Assigned(Request.OnInit) then
Exit;
if Request.SynchronizeOnInit then
begin
UnlockProperties;
xUnlocked := True;
Synchronize(@DoOnInit);
end else
DoOnInit;
finally
if not xUnlocked then
UnlockProperties;
end;
if Request.SynchronizeOnInit then
Synchronize(@DoOnInit)
else
DoOnInit;
end;
procedure TFPHTTPClientAsyncPoolRequestThread.ExecOnProgress(const aDirection: TFPHTTPClientPoolProgressDirection;
@ -1079,61 +1051,63 @@ procedure TFPHTTPClientAsyncPoolRequestThread.Execute;
begin
// don't LockProperties here - Request.Headers/ContentType/URLData/Method/URL/ResponseStream/AllowedResponseCodes are read-only
try
fClient.ConnectTimeout := Request.ConnectTimeout;
fClient.IOTimeout := Request.IOTimeout;
fClient.RequestHeaders.Text := Request.Headers;
if Request.ContentType<>'' then
fClient.AddHeader(fClient.RequestHeaders, HeaderContentType, Request.ContentType);
if Length(Request.URLData)>0 then
fClient.RequestBody := TBytesStream.Create(Request.URLData);
ExecOnInit;
fClient.OnDataReceived := @OnDataReceived;
fClient.OnDataSent := @OnDataSent;
fClient.OnIdle := @OnIdle;
if Terminated then
begin
fResult.MethodResult := mrAbortedByClient;
Exit;
end;
try
fClient.HTTPMethod(Request.Method, Request.URL, fResult.ResponseStream, Request.AllowedResponseCodes);
finally
fClient.RequestBody.Free;
fClient.RequestBody := nil;
fClient.ConnectTimeout := Request.ConnectTimeout;
fClient.IOTimeout := Request.IOTimeout;
fClient.RequestHeaders.Text := Request.Headers;
if Request.ContentType<>'' then
fClient.AddHeader(fClient.RequestHeaders, HeaderContentType, Request.ContentType);
if Length(Request.URLData)>0 then
fClient.RequestBody := TBytesStream.Create(Request.URLData);
ExecOnInit;
fClient.OnDataReceived := @OnDataReceived;
fClient.OnDataSent := @OnDataSent;
if Terminated then
begin
fResult.MethodResult := mrAbortedByClient;
Exit;
end;
try
fClient.HTTPMethod(Request.Method, Request.URL, fResult.ResponseStream, Request.AllowedResponseCodes);
finally
fClient.RequestBody.Free;
fClient.RequestBody := nil;
end;
fResult.ResponseStream.Position := 0;
if Terminated then
begin
fResult.MethodResult := mrAbortedByClient;
end else
begin
fResult.MethodResult := mrSuccess;
fResult.ResponseStatusCode := fClient.ResponseStatusCode;
fResult.ResponseStatusText := fClient.ResponseStatusText;
fResult.ResponseHeaders.Assign(fClient.ResponseHeaders);
end;
except
on E: TObject do
begin
if Terminated then // client terminated the connection -> it has priority above mrAbortedWithException
fResult.MethodResult := mrAbortedByClient
else
fResult.MethodResult := mrAbortedWithException;
fResult.ExceptionClass := E.ClassType;
if E is Exception then
fResult.ExceptionMessage := Exception(E).Message;
end;
end;
fResult.ResponseStream.Position := 0;
if Terminated then
begin
fResult.MethodResult := mrAbortedByClient;
end else
begin
fResult.MethodResult := mrSuccess;
fResult.ResponseStatusCode := fClient.ResponseStatusCode;
fResult.ResponseStatusText := fClient.ResponseStatusText;
fResult.ResponseHeaders.Assign(fClient.ResponseHeaders);
finally
try
Pool.ReleaseClient(Request.URL, fClient);
fClient := nil; // do not use fClient - it doesn't belong here anymore
ExecOnFinish;
except
end;
except
on E: TObject do
begin
if Terminated then // client terminated the connection -> it has priority above mrAbortedWithException
fResult.MethodResult := mrAbortedByClient
else
fResult.MethodResult := mrAbortedWithException;
fResult.ExceptionClass := E.ClassType;
if E is Exception then
fResult.ExceptionMessage := Exception(E).Message;
end;
end;
try
Pool.ReleaseClient(Request.URL, fClient);
fClient := nil; // do not use fClient - it doesn't belong here anymore
ExecOnFinish;
except
end;
end;