* Implement Idle timeout for accepting connections

git-svn-id: trunk@33729 -

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

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