One option might be to implement a custom TIdScheduler
class that derives from one of the TIdSchedulerofThread...
components and override its virtual AcquireYarn()
method to either:
raise an EAbort
exception if the scheduler's ActiveYarns
list has reached the max allowed number of connections. This might cause too tight a loop in TIdTCPServer
listening threads, though. To mitigate that, you could put a small timer in the method and only raise the exception if the list remains maxed out for a short period of time.
block the calling thread (the TIdTCPServer
listening thread) until the ActiveYarns
has fewer yarns than your max connection limit, then call the inherited
method to return a new TIdYarn
object normally.
For example:
type
TMyScheduler = class(TIdSchedulerOfThreadDefault)
public
function AcquireYarn: TIdYarn; override;
end;
function TMyScheduler.AcquireYarn: TIdYarn;
begin
if not ActiveYarns.IsCountLessThan(SomeLimit) then
begin
Sleep(1000);
if not ActiveYarns.IsCountLessThan(SomeLimit) then
Abort;
end;
Result := inherited;
end;
Then assign a single instance of this class to the Scheduler
property of all the servers. TIdTCPServer
calls AcquireYarn()
before accepting a new client connection.
Another option, for Windows only, would be to derive a new TIdStack
class from TIdStackWindows
and override its virtual Accept()
method to use Winsock's WSAAccept()
function instead of its accept()
function. WSAAccept()
allows you to assign a callback function that decides whether a new client is accepted or rejected based on criteria passed to the callback (QOS, etc). That callback could check a global counter you maintain for how many active connections are running (or just sum up all of the servers' active Contexts
counts), and then return CF_REJECT
if the limit has been reached, otherwise return CF_ACCEPT
. You could then use the SetStackClass()
function in the IdStack
unit to assign your class as the active Stack for all Indy socket connections.
For example:
type
TMyStack = class(TIdStackWindows)
public
function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
end;
function MyAcceptCallback(lpCallerId: LPWSABUF; lpCallerData: LPWSABUF; lpSQOS, pGQOS: LPQOS; lpCalleeId, lpCalleeData: LPWSABUF; g: PGROUP; dwCallbackData: DWORD_PTR): Integer; stdcall;
begin
if NumActiveConnections >= SomeLimit then
Result := CF_REJECT
else
Result := CF_ACCEPT;
end;
function TMyStack.Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
var
LSize: Integer;
LAddr: SOCKADDR_STORAGE;
begin
LSize := SizeOf(LAddr);
//Result := IdWinsock2.accept(ASocket, IdWinsock2.PSOCKADDR(@LAddr), @LSize);
Result := IdWinsock2.WSAAccept(ASocket, IdWinsock2.PSOCKADDR(@LAddr), @LSize, @MyAcceptCallback, 0);
if Result <> INVALID_SOCKET then begin
case LAddr.ss_family of
Id_PF_INET4: begin
VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
VIPVersion := Id_IPv4;
end;
Id_PF_INET6: begin
VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
VPort := ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
VIPVersion := Id_IPv6;
end;
else begin
CloseSocket(Result);
Result := INVALID_SOCKET;
IPVersionUnsupported;
end;
end;
end;
end;
initialization
SetStackClass(TMyStack);
This way, Indy will never see any rejected client connections at all, and you do not have to worry about implementing any other hacks inside of TIdTCPServer
or its various dependencies. Everything will work normally and simply block as expected whenever TIdStack.Accept()
does not return an accepted client.