IP Black List TcpServer - delphi

How i can limit the connections per ip? i've tried this code how to block unknown clients in indy (Delphi) but if my server is flooded i can't connect. the code from Remy just prevent CPU to use 100% and use more ram. but the connection from flood still alive on tcpserver and i can't connect to server. so my question is, how i can limit the connection before onconnect, something on accept using tcpserver? maybe hook accept function and try limit the connection ?

How i can limit the connections per ip?
You already know the answer to that, as that is exactly what the other code is doing.
if my server is flooded i can't connect.
The purpose of the other code is simply to limit a client IP address to a max of 10 simultaneous connections, not to prevent flooding or lower CPU/RAM usage. You can't stop unwanted clients from connecting to your server, unless you deactivate the server, or set its MaxConnections property. Outside of that, about all you can do is disconnect unwanted clients as soon as possible, which you can do in the server's OnConnect event. But if you are getting flooded, that is going to take time to process, especially if you are continuously locking and unlocking the server's Contexts list, which will end up serializing the server's internal threading.
Flood management really needs to be handled by a firewall or router/load balancer, not in the server app itself. If this is not acceptable to you, then at least on Windows only, an option might be to write a custom TIdServerIOHandlerStack-derived component that overrides the virtual Accept() method to call WinSock's WSAAccept() function, which offers a callback you can use to reject connections before they leave the accept queue, and thus they will not be seen by TIdTCPServer. For example:
type
TMyServerIOHandler = class(TIdServerIOHandlerStack)
public
function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler; override;
end;
function MyConditionFunc(lpCallerId, lpCallerData: LPWSABUF; lpSQOS, lpGQOS: LPQOS; lpCalleeId, lpCalleeData: LPWSABUF; g: PGROUP dwCallbackData: DWORD_PTR): Integer; stdcall;
begin
if (the address stored in lpCallerId is blocked) then
Result := CF_REJECT
else
Result := CF_ACCEPT;
end;
type
TIdSocketHandleAccess = class(TIdSocketHandle)
end;
function TMyServerIOHandler.Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
var
LIOHandler: TIdIOHandlerSocket;
LBinding: TIdSocketHandle;
LAcceptedSocket: TIdStackSocketHandle;
begin
Result := nil;
LIOHandler := TIdIOHandlerStack.Create(nil);
try
LIOHandler.Open;
while not AListenerThread.Stopped do
begin
if ASocket.Select(250) then
begin
LBinding := LIOHandler.Binding;
LBinding.Reset;
LAcceptedSocket := WSAAccept(ASocket.Handle, nil, nil, #MyConditionFunc, 0);
if LAcceptedSocket <> Id_INVALID_SOCKET then
begin
TIdSocketHandleAccess(LBinding).SetHandle(LAcceptedSocket);
LBinding.UpdateBindingLocal;
LBinding.UpdateBindingPeer;
LIOHandler.AfterAccept;
Result := LIOHandler;
LIOHandler := nil;
Break;
end;
end;
end;
finally
FreeAndNil(LIOHandler);
end;
end;
Then you can assign an instance of TMyServerIOHandler to the TIdTCPServer.IOHandler property before activating the server.

Related

Check remote port access using Delphi - Telnet style

I deploy my application in environments heavily stricken with firewalls. Frequently I find myself using Telnet to check if a port is open and accessible in the network.
Now I would like to implement an equivalent functionality of the command, Telnet [domainname or ip] [port], in Delphi.
Is it adequate that I just attempt to open and close a TCP/IP socket without sending or receiving any data?
Is there any risk that I might crash the arbitrary application/service listening on the other end?
Here's my code:
function IsPortActive(AHost : string; APort : Word):boolean;
var IdTCPClient : TIdTCPClient;
begin
IdTCPClient := TIdTCPClient.Create(nil);
try
try
IdTCPClient.Host := AHost;
IdTCPClient.Port := APort;
IdTCPClient.Connect;
except
//Igonre exceptions
end;
finally
result := IdTCPClient.Connected;
IdTCPClient.Disconnect;
FreeAndNil(IdTCPClient);
end;
end;
If you just want to check whether the port is open, then you can use this:
function IsPortActive(AHost : string; APort : Word): boolean;
var
IdTCPClient : TIdTCPClient;
begin
Result := False;
try
IdTCPClient := TIdTCPClient.Create(nil);
try
IdTCPClient.Host := AHost;
IdTCPClient.Port := APort;
IdTCPClient.Connect;
Result := True;
finally
IdTCPClient.Free;
end;
except
//Ignore exceptions
end;
end;
But that only tells you if any server app has opened the port. If you want to make sure that YOUR server app opened the port, then you will have to actually communicate with the server and make sure its responses are what you are expecting. For this reason, many common server protocols provide an initial greeting so clients can identify the type of server they are connected to. You might consider adding a similar greeting to your server, if you are at liberty to make changes to your communication protocol.
Simply opening a connection to the server does not impose any risk of crashing the server, all it does is momentarily occupy a slot in the server's client list. However, if you actually send data to the server, and the server app you are connected to is not your app, then you do run a small risk if the server cannot handle arbitrary data that does not conform it its expected protocol. But that is pretty rare. Sending a small command is not uncommon and usually pretty safe, you will either get back a reply (which may be in a format that does not conform to your protocol, so just assume failure), or you may not get any reply at all (like if the server is waiting for more data, or simply is not designed to return a reply) in which case you can simply time out the reading and assume failure.

TIdTcpServer connection limiting

I want to restrict the number of incoming connections that a TIdTcpServer can take, but the rule I need to apply is a little complex, so I don't think the MaxConnections property will work for me.
I have an application running N servers, each using a different protocol on a different port. I need to limit the total number of clients across all N servers. So for example, with 16 servers, and 16 clients allowed, I would allow one client on each, or 16 all on a single server.
It's possible I could manipulate the MaxConnections dynamically to fix this (e.g. set them all to zero when I determine we're 'full', and back to 16 or whatever when we're not full, but this feels a little too tricksy.
Is there some kind of virtual IsConnectionAllowed method that I can override with my own logic, or a suitable place in the connection process where I can raise an exception if I determine the limit has been exceeded?
Create a new component - TIdTCPServerCollection for example - which is the "owner" of all server components.
In this component, declare a thread-safe property which stores the available - currently unused - connection count.
In the server connect and disconnect logic, decrement / increment this variable, and set MaxConnections to reflect the new limit.
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.

Indy, Acces Violatio when too many connections

I have three questions:
is it possible to destroy IdTCPServer by to many connection?
I tried to test my application and when I have several connections - it works very good (even several days) but when sometimes number of connection increases application gives acess violation. I wrote application similates 50 clients sending data constantly (with only sleep(200)). And in this situation IdTCPServer gives exceptions?
My application reseives information from clients by onExecute event and modyfies databases table using
TidNotify and TIdSync classes. I believe it protects crosses connections threads?
Sending information to clients is doing by TTimer (it is only now, I'll change it to other thread).
Have I use in this situation special protection or something like that is enough:
type
PClient = ^TClient;
TClient = record
Activity_time:TDateTime;
AContext: TIdContext;
end;
...
list := server.Contexts.LockList;
try
for i := 0 to list.Count - 1 do
with TIdContext(list[i]) do
begin
if SecondsBetween(now(), PClient(data)^.activity_time) > 6 then
begin
Connection.IOHandler.Close;
Continue;
end;
try
Connection.IOHandler.writeln('E:');
Except
Connection.IOHandler.Close;
end;
end;
finally
server.Contexts.UnlockList;
end;
2.Is a simple way to refuse connection when server is to busy (I think my database isn't complicated (100 rows, only one row is modyfied by one connection) but maybe here is a way to keep stability of server?
3.I know that this question was repeating many times but I didn't find satisfying answer: how to protect application to avoid message exception: "Connection closed gracefully" and "Connection reset by peer"?
Thank You for all advices
is it possible to destroy IdTCPServer by to many connection?
You are asking the wrong question, because you are not actually destroying TIdTCPServer itself, you are simply closing idle connections from an outside thread. That kind of logic can be (and should be) handled inside of the OnExecute event instead, where it is safest to access the connection, eg:
type
PClient = ^TClient;
TClient = record
Activity_time: TDateTime;
Heartbeat_time: TDateTime;
AContext: TIdContext;
end;
procedure TForm1.serverConnect(AContext: TIdContext);
var
Client: PClient;
begin
New(Client);
Client^.Activity_time := Now();
Client^.Heartbeat_time := Client^.Activity_time;
AContext.Data := TObject(Client);
end;
procedure TForm1.serverDisconnect(AContext: TIdContext);
var
Client: PClient;
begin
Client := PClient(AContext.Data);
AContext.Data := nil;
if Client <> nil then Dispose(Client);
end;
procedure TForm1.serverExecute(AContext: TIdContext);
var
Client: PClient;
dtNow: TDateTime;
begin
Client := PClient(AContext.Data);
dtNow := Now();
if SecondsBetween(dtNow, Client^.Activity_time) > 6 then
begin
AContext.Connection.Disconnect;
Exit;
end;
if SecondsBetween(dtNow, Client^.Heartbeat_time) > 2 then
begin
AContext.Connection.IOHandler.WriteLn('E:');
Client^.Heartbeat_time := dtNow;
end;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if not AContext.Connection.IOHandler.CheckForDataOnSource(100) then
Exit;
end;
// process incoming data as needed ...
Client^.Activity_time := Now();
end;
Is a simple way to refuse connection when server is to busy (I think my database isn't complicated (100 rows, only one row is modyfied by one connection) but maybe here is a way to keep stability of server?
The current architecture does not allow for refusing connections from being accepted. You can let the server accept connections normally and then close accepted connections when needed. You can do that in the OnConnect event, or you can set the server's MaxConnection property to a low non-zero number to allow the server to auto-disconnect new connections for you without wasting resources creating new TIdContext objects and threads for them.
Another option is to call the server's StopListening() method when the server is busy, so that new connections cannot reach the server anymore, and then call the server's StartListening() method when you are ready to accept new clients again. Existing clients who are already connected should not be affected, though I have not actually tried that myself yet.
I know that this question was repeating many times but I didn't find satisfying answer: how to protect application to avoid message exception: "Connection closed gracefully" and "Connection reset by peer"?
You should not avoid them. Let them happen, they are normal errors. If they are happening inside of the server's events, just let the server handle them normally for you. That is how TIdTCServer is designed to be used. If they are happening outside of the server's events, such as in your timer, then just wrap the socket operation(s) in a try/except block and move on.

What's the best way to ping many network devices in parallel?

I poll a lot of devices in network (more than 300) by iterative ping.
The program polls the devices sequentially, so it's slow.
I'd like to enhance the speed of polling.
There some ways to do this in Delphi 7:
Each device has a thread doing ping. Manage threads manually.
Learn and use Indy 10. Need examples.
Use overlapped I/O based on window messages.
Use completion ports based on events.
What is faster, easier? Please, provide some examples or links for example.
Flooding the network with ICMP is not a good idea.
You might want to consider some kind of thread pool and queue up the ping requests and have a fixed number of threads doing the requests.
Personally I would go with IOCP. I'm using that very successfully for the transport implementation in NexusDB.
If you want to perform 300 send/receive cycles using blocking sockets and threads in parallel, you end up needing 300 threads.
With IOCP, after you've associated the sockets with the IOCP, you can perform the 300 send operations, and they will return instantly before the operation is completed. As the operations are completed, so called completion packages will be queued to the IOCP. You then have a pool of threads waiting on the IOCP, and the OS wakes them up as the completion packets come in. In reaction to completed send operations you can then perform the receive operations. The receive operations also return instantly and once actually completed get queued to the IOCP.
The real special thing about an IOCP is that it knows which threads belong to it and are currently processing completion packages. And the IOCP only wakes up new threads if the total number of active threads (not in a kernel mode wait state) is lower than the concurrency number of the IOCP (by default that equals the number of logical cores available on the machine). Also, if there are threads waiting for completion packages on the IOCP (which haven't been started yet despite completion packages being queued because the number of active threads was equal to the concurrancy number), the moment one of the threads that is currently processing a completion package enters a kernel mode wait state for any reason, one of the waiting threads is started.
Threads returning to the IOCP pick up completion packages in LIFO order. That is, if a thread is returning to the IOCP and there are completion packages still waiting, that thread directly picks up the next completion package, instead of being put into a wait state and the thread waiting for the longest time waking up.
Under optimal conditions, you will have a number of threads equal to the number of available cores running concurrently (one on each core), picking up the next completion package, processing it, returning to the IOCP and directly picking up the next completion package, all without ever entering a kernel mode wait state or a thread context switch having to take place.
If you would have 300 threads and blocking operations instead, not only would you waste at least 300 MB address space (for the reserved space for the stacks), but you would also have constant thread context switches as one thread enters a wait state (waiting for a send or receive to complete) and the next thread with a completed send or receive waking up. – Thorsten Engler 12 hours ago
Direct ICMP access is deprecated on windows. Direct access to the ICMP protocol on Windows is controlled. Due to malicious use of ICMP/ping/traceroute style raw sockets, I believe that on some versions of Windows you will need to use Windows own api. Windows XP, Vista, and Windows 7, in particular, don't let user programs access raw sockets.
I have used the canned-functionality in ICMP.dll, which is what some Delphi ping components do, but a comment below alerted me to the fact that this is considered "using an undocumented API interface".
Here's a sample of the main delphi ping component call itself:
function TICMP.ping: pIcmpEchoReply;
{var }
begin
// Get/Set address to ping
if ResolveAddress = True then begin
// Send packet and block till timeout or response
_NPkts := _IcmpSendEcho(_hICMP, _Address,
_pEchoRequestData, _EchoRequestSize,
#_IPOptions,
_pIPEchoReply, _EchoReplySize,
_TimeOut);
if _NPkts = 0 then begin
result := nil;
status := CICMP_NO_RESPONSE;
end else begin
result := _pIPEchoReply;
end;
end else begin
status := CICMP_RESOLVE_ERROR;
result := nil;
end;
end;
I believe that most modern Ping component implementations are going to be based on a similar bit of code to the one above, and I have used it to run this ping operation in a background thread, without any probems. (Demo program included in link below).
Full sample source code for the ICMP.DLL based demo is here.
UPDATE A more modern IPHLPAPI.DLL sample is found at About.com here.
Here's an article from Delphi3000 showing how to use IOCP to create a thread pool. I am not the author of this code, but the author's information is in the source code.
I'm re-posting the comments and code here:
Everyone by now should understand what
a thread is, the principles of threads
and so on. For those in need, the
simple function of a thread is to
separate processing from one thread to
another, to allow concurrent and
parallel execution. The main principle
of threads is just as simple, memory
allocated which is referenced between
threads must be marshalled to ensure
safety of access. There are a number
of other principles but this is really
the one to care about.
And on..
A thread safe queue will allow
multiple threads to add and remove,
push and pop values to and from the
queue safely on a First on First off
basis. With an efficient and well
written queue you can have a highly
useful component in developing
threaded applications, from helping
with thread safe logging, to
asynchronous processing of requests.
A thread pool is simply a thread or a
number of threads which are most
commonly used to manage a queue of
requests. For example a web server
which would have a continuous queue of
requests needing to be processed use
thread pools to manage the http
requests, or a COM+ or DCOM server
uses a thread pool to handle the rpc
requests. This is done so there is
less impact from the processing of one
request to another, say if you ran 3
requests synchronously and the first
request took 1 minute to complete, the
second two requests would not complete
for at least 1 minute adding on top
there own time to process, and for
most of the clients this is not
acceptable.
So how to do this..
Starting with the queue!!
Delphi does provides a TQueue object
which is available but is
unfortunately not thread safe nor
really too efficient, but people
should look at the Contnrs.pas file to
see how borland write there stacks and
queues. There are only two main
functions required for a queue, these
are add and remove/push and pop.
Add/push will add a value, pointer or
object to the end of a queue. And
remove/pop will remove and return the
first value in the queue.
You could derive from TQueue object
and override the protected methods and
add in critical sections, this will
get you some of the way, but I would
want my queue to wait until new
requests are in the queue, and put the
thread into a state of rest while it
waits for new requests. This could be
done by adding in Mutexes or signaling
events but there is an easier way. The
windows api provides an IO completion
queue which provides us with thread
safe access to a queue, and a state of
rest while waiting for new request in
the queue.
Implementing the Thread Pool
The thread pool is going to be very
simple and will manage x number of
threads desired and pass each queue
request to an event provided to be
processed. There is rarely a need to
implement a TThread class and your
logic to be implemented and
encapsulated within the execute event
of the class, thus a simple
TSimpleThread class can be created
which will execute any method in any
object within the context of another
thread. Once people understand this,
all you need to concern yourself with
is allocated memory.
Here is how it is implemented.
TThreadQueue and TThreadPool
implementation
(* Implemented for Delphi3000.com Articles, 11/01/2004
Chris Baldwin
Director & Chief Architect
Alive Technology Limited
http://www.alivetechnology.com
*)
unit ThreadUtilities;
uses Windows, SysUtils, Classes;
type
EThreadStackFinalized = class(Exception);
TSimpleThread = class;
// Thread Safe Pointer Queue
TThreadQueue = class
private
FFinalized: Boolean;
FIOQueue: THandle;
public
constructor Create;
destructor Destroy; override;
procedure Finalize;
procedure Push(Data: Pointer);
function Pop(var Data: Pointer): Boolean;
property Finalized: Boolean read FFinalized;
end;
TThreadExecuteEvent = procedure (Thread: TThread) of object;
TSimpleThread = class(TThread)
private
FExecuteEvent: TThreadExecuteEvent;
protected
procedure Execute(); override;
public
constructor Create(CreateSuspended: Boolean; ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
end;
TThreadPoolEvent = procedure (Data: Pointer; AThread: TThread) of Object;
TThreadPool = class(TObject)
private
FThreads: TList;
FThreadQueue: TThreadQueue;
FHandlePoolEvent: TThreadPoolEvent;
procedure DoHandleThreadExecute(Thread: TThread);
public
constructor Create( HandlePoolEvent: TThreadPoolEvent; MaxThreads: Integer = 1); virtual;
destructor Destroy; override;
procedure Add(const Data: Pointer);
end;
implementation
{ TThreadQueue }
constructor TThreadQueue.Create;
begin
//-- Create IO Completion Queue
FIOQueue := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
FFinalized := False;
end;
destructor TThreadQueue.Destroy;
begin
//-- Destroy Completion Queue
if (FIOQueue <> 0) then
CloseHandle(FIOQueue);
inherited;
end;
procedure TThreadQueue.Finalize;
begin
//-- Post a finialize pointer on to the queue
PostQueuedCompletionStatus(FIOQueue, 0, 0, Pointer($FFFFFFFF));
FFinalized := True;
end;
(* Pop will return false if the queue is completed *)
function TThreadQueue.Pop(var Data: Pointer): Boolean;
var
A: Cardinal;
OL: POverLapped;
begin
Result := True;
if (not FFinalized) then
//-- Remove/Pop the first pointer from the queue or wait
GetQueuedCompletionStatus(FIOQueue, A, Cardinal(Data), OL, INFINITE);
//-- Check if we have finalized the queue for completion
if FFinalized or (OL = Pointer($FFFFFFFF)) then begin
Data := nil;
Result := False;
Finalize;
end;
end;
procedure TThreadQueue.Push(Data: Pointer);
begin
if FFinalized then
Raise EThreadStackFinalized.Create('Stack is finalized');
//-- Add/Push a pointer on to the end of the queue
PostQueuedCompletionStatus(FIOQueue, 0, Cardinal(Data), nil);
end;
{ TSimpleThread }
constructor TSimpleThread.Create(CreateSuspended: Boolean;
ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
begin
FreeOnTerminate := AFreeOnTerminate;
FExecuteEvent := ExecuteEvent;
inherited Create(CreateSuspended);
end;
procedure TSimpleThread.Execute;
begin
if Assigned(FExecuteEvent) then
FExecuteEvent(Self);
end;
{ TThreadPool }
procedure TThreadPool.Add(const Data: Pointer);
begin
FThreadQueue.Push(Data);
end;
constructor TThreadPool.Create(HandlePoolEvent: TThreadPoolEvent;
MaxThreads: Integer);
begin
FHandlePoolEvent := HandlePoolEvent;
FThreadQueue := TThreadQueue.Create;
FThreads := TList.Create;
while FThreads.Count < MaxThreads do
FThreads.Add(TSimpleThread.Create(False, DoHandleThreadExecute, False));
end;
destructor TThreadPool.Destroy;
var
t: Integer;
begin
FThreadQueue.Finalize;
for t := 0 to FThreads.Count-1 do
TThread(FThreads[t]).Terminate;
while (FThreads.Count > 0) do begin
TThread(FThreads[0]).WaitFor;
TThread(FThreads[0]).Free;
FThreads.Delete(0);
end;
FThreadQueue.Free;
FThreads.Free;
inherited;
end;
procedure TThreadPool.DoHandleThreadExecute(Thread: TThread);
var
Data: Pointer;
begin
while FThreadQueue.Pop(Data) and (not TSimpleThread(Thread).Terminated) do begin
try
FHandlePoolEvent(Data, Thread);
except
end;
end;
end;
end.
As you can see it's quite straight
forward, and with this you can
implement very easily any queuing of
requests over threads and really any
type of requirement that requires
threading can be done using these
object and save you a lot of time and
effort.
You can use this to queue requests
from one thread to multiple threads,
or queue requests from multiple
threads down to one thread which makes
this quite a nice solution.
Here are some examples of using these
objects.
Thread safe logging
To allow multiple
threads to asynchronously write to a
log file.
uses Windows, ThreadUtilities,...;
type
PLogRequest = ^TLogRequest;
TLogRequest = record
LogText: String;
end;
TThreadFileLog = class(TObject)
private
FFileName: String;
FThreadPool: TThreadPool;
procedure HandleLogRequest(Data: Pointer; AThread: TThread);
public
constructor Create(const FileName: string);
destructor Destroy; override;
procedure Log(const LogText: string);
end;
implementation
(* Simple reuse of a logtofile function for example *)
procedure LogToFile(const FileName, LogString: String);
var
F: TextFile;
begin
AssignFile(F, FileName);
if not FileExists(FileName) then
Rewrite(F)
else
Append(F);
try
Writeln(F, DateTimeToStr(Now) + ': ' + LogString);
finally
CloseFile(F);
end;
end;
constructor TThreadFileLog.Create(const FileName: string);
begin
FFileName := FileName;
//-- Pool of one thread to handle queue of logs
FThreadPool := TThreadPool.Create(HandleLogRequest, 1);
end;
destructor TThreadFileLog.Destroy;
begin
FThreadPool.Free;
inherited;
end;
procedure TThreadFileLog.HandleLogRequest(Data: Pointer; AThread: TThread);
var
Request: PLogRequest;
begin
Request := Data;
try
LogToFile(FFileName, Request^.LogText);
finally
Dispose(Request);
end;
end;
procedure TThreadFileLog.Log(const LogText: string);
var
Request: PLogRequest;
begin
New(Request);
Request^.LogText := LogText;
FThreadPool.Add(Request);
end;
As this is logging to a file it will
process all requests down to a single
thread, but you could do rich email
notifications with a higher thread
count, or even better, process
profiling with what’s going on or
steps in your program which I will
demonstrate in another article as this
one has got quite long now.
For now I will leave you with this,
enjoy.. Leave a comment if there's
anything people are stuck with.
Chris
Do you need a response from every machine on the network, or are these 300 machines just a subset of the larger network?
If you need a response from every machine, you could consider using a broadcast address or multicast address for your echo request.
Please give a try on "chknodes" parallel ping for Linux which will send a single ping to all nodes of your network. It will do also dns reverse lookup and request http response if specified so. It's written completely in bash i.e. you can easily check it or modify it to your needs. Here is a printout of help:
chknodes -h
chknodes ---- fast parallel ping
chknodes [-l|--log] [-h|--help] [-H|--http] [-u|--uninstall] [-v|--version] [-V|--verbose]
-l | --log Log to file
-h | --help Show this help screen
-H | --http Check also http response
-n | --names Get also host names
-u | --uninstall Remove installation
-v | --version Show version
-V | --verbose Show each ip address pinged
You need to give execute right for it (like with any sh/bash script) in order to run it:
chmod +x chknodes
On the first run i.e.
./chknodes
it will suggest to install itself to /usr/local/bin/chknodes, after that giving just
chknodes
will be enough. You can find it here:
www.homelinuxpc.com/download/chknodes

Howto determine if connection is still alive with Indy?

I use Indy for TCP communication (D2009, Indy 10).
After evaluating a client request, I want to send the answer to the client. I therefore store the TIdContext, like this (pseudocode)
procedure ConnectionManager.OnIncomingRequest (Context : TIdContext);
begin
Task := TTask.Create;
Task.Context := Context;
ThreadPool.AddTask (Task);
end;
procedure ThreadPool.Execute (Task : TTask);
begin
// Perform some computation
Context.Connection.IOHandler.Write ('Response');
end;
But what if the client terminates the connection somewhere between the request and the answer being ready for sending? How can I check if the context is still valid? I tried
if Assigned (Context) and Assigned (Context.Connection) and Context.Connection.Connected then
Context.Connection.IOHandler.Write ('Response');
but it does not help. In some cases the program just hangs and if I pause execution I can see that the current line is the one with the if conditions.
What happens here? How can I avoid trying to send using dead connections?
Okay, I found a solution. Instead of storing the TIdContext I use the context list provided by TIdTcpServer:
procedure ThreadPool.Execute (Task : TTask);
var
ContextList : TList;
Context : TIdContext;
FoundContext : Boolean;
begin
// Perform some computation
FoundContext := False;
ContextList := FIdTCPServer.Contexts.LockList;
try
for I := 0 to ContextList.Count-1 do
begin
Context := TObject (ContextList [I]) as TIdContext;
if (Context.Connection.Socket.Binding.PeerIP = Task.ClientInfo.IP) and
(Context.Connection.Socket.Binding.PeerPort = Task.ClientInfo.Port) then
begin
FoundContext := True;
Break;
end;
end;
finally
FIdTCPServer.Contexts.UnlockList;
end;
if not FoundContext then
Exit;
// Context is a valid connection, send the answer
end;
That works for me.
If the client closes the connection, the client machine/network card dies or you have some other network problem between you and the client, you might not know about it until the next time you try to write to the connection.
You could use a heartbeat. Occasionally send a message to the client with a short timeout to see if the connection is still valid. This way, you'll know sooner if there has been an unexpected disconnect. You could wrap it in a "CheckConnection" function and call it before sending your response.

Resources