paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 11:49:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

httpserver: add KeepConnectionIdleTimeout property and OnKeepConnectionIdle event. Fix KeepConnectionTimeout to match the meaning from the comment and the name

Browse Source
This commit is contained in:
Ondrej Pokorny 2022-11-03 08:14:52 +01:00
parent 342524c312
commit c5f4fe2882
1 changed files with 60 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
packages/fcl-web/src/base/fphttpserver.pp
View File

@ -25,7 +25,7 @@ uses
Const
ReadBufLen = 4096;
DefaultKeepConnectionTimeout = 50; // Ms
DefaultKeepConnectionIdleTimeout = 50; // Ms
Type
TFPHTTPConnection = Class;
@ -76,6 +76,7 @@ Type
FKeepAlive : Boolean;
function GetKeepConnections: Boolean;
function GetKeepConnectionTimeout: Integer;
function GetKeepConnectionIdleTimeout: Integer;
procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String);
function ReadString: String;
Function GetLookupHostNames : Boolean;
@ -96,6 +97,8 @@ Type
Procedure SetBusy;
// Actually handle request
procedure DoHandleRequest; virtual;
// Called when KeepConnection is idle.
procedure DoKeepConnectionIdle; virtual;
// Read request headers
Function ReadRequestHeaders : TFPHTTPConnectionRequest;
// Check if we have keep-alive and no errors occurred
@ -106,7 +109,10 @@ Type
Property Busy : Boolean Read FBusy;
// The server supports HTTP 1.1 connection: keep-alive
Property KeepConnections : Boolean read GetKeepConnections;
// time-out for keep-alive: how many ms should the server keep the connection alive after a request has been handled
// Idle time-out for keep-alive: after how many ms should the connection fire the OnKeepConnectionIdle event
Property KeepConnectionIdleTimeout: Integer read GetKeepConnectionIdleTimeout;
// Time-out for keep-alive: how many ms should the server keep the connection alive after a request has been handled.
// After this timeout the keep-alive connection is forcefully closed.
Property KeepConnectionTimeout: Integer read GetKeepConnectionTimeout;
Public
Type
@ -299,8 +305,10 @@ Type
FAfterSocketHandlerCreated: TSocketHandlerCreatedEvent;
FCertificateData: TCertificateData;
FKeepConnections: Boolean;
FKeepConnectionIdleTimeout: Integer;
FKeepConnectionTimeout: Integer;
FOnAcceptIdle: TNotifyEvent;
FOnKeepConnectionIdle: TNotifyEvent;
FOnAllowConnect: TConnectQuery;
FOnGetSocketHandler: TGetSocketHandlerEvent;
FOnRequest: THTTPServerRequestHandler;
@ -356,6 +364,8 @@ Type
procedure DoAcceptError(Sender: TObject; ASocket: Longint; E: Exception; var ErrorAction: TAcceptErrorAction);
// Called when accept is idle. Will check for new requests.
procedure DoAcceptIdle(Sender: TObject);
// Called when KeepConnection is idle.
procedure DoKeepConnectionIdle(Sender: TObject);
// Create a connection handling object.
function CreateConnection(Data : TSocketStream) : TFPHTTPConnection; virtual;
// Create a connection handler object depending on threadmode
@ -401,7 +411,10 @@ Type
Property Port : Word Read FPort Write SetPort Default 80;
// Set to true if you want to support HTTP 1.1 connection: keep-alive - only available for threaded server
Property KeepConnections: Boolean read FKeepConnections write FKeepConnections;
// time-out for keep-alive: how many ms should the server keep the connection alive after a request has been handled
// Idle time-out for keep-alive: after how many ms should the connection fire the OnKeepConnectionIdle event
Property KeepConnectionIdleTimeout: Integer read FKeepConnectionIdleTimeout write FKeepConnectionIdleTimeout;
// Time-out for keep-alive: how many ms should the server keep the connection alive after a request has been handled.
// After this timeout the keep-alive connection is forcefully closed.
Property KeepConnectionTimeout: Integer read FKeepConnectionTimeout write FKeepConnectionTimeout;
// Max connections on queue (for Listen call)
Property QueueSize : Word Read FQueueSize Write SetQueueSize Default 5;
@ -419,6 +432,8 @@ Type
Property OnUnexpectedError : TRequestErrorHandler Read FOnUnexpectedError Write FOnUnexpectedError;
// Called when there are no connections waiting.
Property OnAcceptIdle : TNotifyEvent Read FOnAcceptIdle Write SetIdle;
// Called when there are no requests waiting in a keep-alive connection.
Property OnKeepConnectionIdle : TNotifyEvent Read FOnKeepConnectionIdle Write FOnKeepConnectionIdle;
// If >0, when no new connection appeared after timeout, OnAcceptIdle is called.
Property AcceptIdleTimeout : Cardinal Read FAcceptIdleTimeout Write SetAcceptIdleTimeout;
published
@ -452,6 +467,7 @@ Type
Property OnAcceptIdle;
Property AcceptIdleTimeout;
Property KeepConnections;
Property KeepConnectionIdleTimeout;
Property KeepConnectionTimeout;
end;
@ -1065,7 +1081,7 @@ end;
function TFPHTTPConnection.RequestPending: Boolean;
begin
Result:=(Not IsUpgraded) and Socket.CanRead(KeepConnectionTimeout);
Result:=(Not IsUpgraded) and Socket.CanRead(KeepConnectionIdleTimeout);
end;
constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream);
@ -1157,6 +1173,12 @@ begin
end;
end;
procedure TFPHTTPConnection.DoKeepConnectionIdle;
begin
if Assigned(FServer) then
FServer.DoKeepConnectionIdle(Self);
end;
function TFPHTTPConnection.GetKeepConnections: Boolean;
begin
if Assigned(FServer) then
@ -1165,6 +1187,16 @@ begin
Result := False;
end;
function TFPHTTPConnection.GetKeepConnectionIdleTimeout: Integer;
begin
if Assigned(FServer) then
Result := FServer.KeepConnectionIdleTimeout
else
Result := 0;
if Result=0 then
Result := KeepConnectionTimeout; // when there is KeepConnectionTimeout set, limit KeepConnectionIdleTimeout with its value
end;
function TFPHTTPConnection.GetKeepConnectionTimeout: Integer;
begin
if Assigned(FServer) then
@ -1205,13 +1237,28 @@ end;
procedure TFPHTTPConnectionThread.Execute;
var
AttemptsLeft: Integer;
begin
try
// Always handle first request
Connection.HandleRequest;
While not Terminated and Connection.AllowNewRequest do
if (Connection.KeepConnectionIdleTimeout>0) and (Connection.KeepConnectionTimeout>0) then
AttemptsLeft := Connection.KeepConnectionTimeout div Connection.KeepConnectionIdleTimeout
else
AttemptsLeft := -1; // infinitely
While not Terminated and Connection.AllowNewRequest and (AttemptsLeft<>0) do
begin
if Connection.RequestPending then
Connection.HandleRequest;
Connection.HandleRequest
else // KeepConnectionIdleTimeout was reached without a new request -> idle
begin
if AttemptsLeft>0 then
Dec(AttemptsLeft);
if AttemptsLeft<>0 then
Connection.DoKeepConnectionIdle;
end;
end;
except
on E : Exception do
Connection.HandleUnexpectedError(E);
@ -1280,6 +1327,12 @@ begin
end;
end;
procedure TFPCustomHttpServer.DoKeepConnectionIdle(Sender: TObject);
begin
if Assigned(OnKeepConnectionIdle) then
OnKeepConnectionIdle(Sender);
end;
function TFPCustomHttpServer.GetHostName: string;
begin
Result:=FCertificateData.HostName;
@ -1541,7 +1594,7 @@ begin
FServerBanner := 'FreePascal';
FCertificateData:=CreateCertificateData;
FKeepConnections:=False;
FKeepConnectionTimeout:=DefaultKeepConnectionTimeout;
FKeepConnectionIdleTimeout:=DefaultKeepConnectionIdleTimeout;
end;