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

* Implement Idle timeout for accepting connections

Browse Source 
git-svn-id: trunk@33729 -
This commit is contained in:
michael 2016-05-21 09:43:31 +00:00
parent a03999cb79
commit e39a964239
1 changed files with 28 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -101,8 +101,10 @@ Type
TFPCustomHttpServer = Class(TComponent)
Private
FAcceptIdleTimeout: Cardinal;
FAdminMail: string;
FAdminName: string;
FOnAcceptIdle: TNotifyEvent;
FOnAllowConnect: TConnectQuery;
FOnRequest: THTTPServerRequestHandler;
FOnRequestError: TRequestErrorHandler;
@ -116,7 +118,9 @@ Type
FThreaded: Boolean;
FConnectionCount : Integer;
function GetActive: Boolean;
procedure SetAcceptIdleTimeout(AValue: Cardinal);
procedure SetActive(const AValue: Boolean);
procedure SetIdle(AValue: TNotifyEvent);
procedure SetOnAllowConnect(const AValue: TConnectQuery);
procedure SetAddress(const AValue: string);
procedure SetPort(const AValue: Word);
@ -175,6 +179,10 @@ Type
Property OnRequest : THTTPServerRequestHandler Read FOnRequest Write FOnRequest;
// Called when an unexpected error occurs during handling of the request. Sender is the TFPHTTPConnection.
Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
// Called when there are no connections waiting.
Property OnAcceptIdle : TNotifyEvent Read FOnAcceptIdle Write SetIdle;
// If >0, when no new connection appeared after timeout, OnAcceptIdle is called.
Property AcceptIdleTimeout : Cardinal Read FAcceptIdleTimeout Write SetAcceptIdleTimeout;
published
//aditional server information
property AdminMail: string read FAdminMail write FAdminMail;
@ -192,6 +200,8 @@ Type
property Threaded;
Property OnRequest;
Property OnRequestError;
Property OnAcceptIdle;
Property AcceptIdleTimeout;
end;
EHTTPServer = Class(EHTTP);
@ -638,6 +648,14 @@ begin
Result:=Assigned(FServer);
end;
procedure TFPCustomHttpServer.SetAcceptIdleTimeout(AValue: Cardinal);
begin
if FAcceptIdleTimeout=AValue then Exit;
FAcceptIdleTimeout:=AValue;
If Assigned(FServer) then
FServer.AcceptIdleTimeOut:=AValue;
end;
procedure TFPCustomHttpServer.StopServerSocket;
begin
FServer.StopAccepting(True);
@ -659,6 +677,13 @@ begin
StopServerSocket;
end;
procedure TFPCustomHttpServer.SetIdle(AValue: TNotifyEvent);
begin
FOnAcceptIdle:=AValue;
if Assigned(FServer) then
FServer.OnIdle:=AValue;
end;
procedure TFPCustomHttpServer.SetOnAllowConnect(const AValue: TConnectQuery);
begin
if FOnAllowConnect=AValue then exit;
@ -771,6 +796,8 @@ begin
FServer.OnConnectQuery:=OnAllowConnect;
FServer.OnConnect:=@DOConnect;
FServer.OnAcceptError:=@DoAcceptError;
FServer.OnIdle:=OnAcceptIdle;
FServer.AcceptIdleTimeOut:=AcceptIdleTimeout;
end;
procedure TFPCustomHttpServer.StartServerSocket;
@ -800,7 +827,7 @@ begin
FServerBanner := 'Freepascal';
end;
Procedure TFPCustomHttpServer.WaitForRequests;
procedure TFPCustomHttpServer.WaitForRequests;
Var
FLastCount,ACount : Integer;