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.
Related
Until now, I was calling the following function every second :
function TForm1.ListeConnecteMaj():Boolean;
var
i : integer;
List : TIdContextList;
Client : TSimpleClient;
begin
List := TCPServer1.Contexts.LockList;
try
NbSConnect := List.Count;
for i := 0 to List.Count -1 do
begin
Client := List[i];
..... // getting information from Client
end;
finally
TCPServeur1.Contexts.UnlockList;
end;
end;
As I need to support hundreds of simultaneaous connections, I want to reduce as much as possible the duration of the LockList.
I've tried this. It works but is it really safe ?
function TForm1.ListeConnecteMaj():Boolean;
var
i : integer;
List : TIdContextList;
Client : TSimpleClient;
begin
List := TCPServer.Contexts.LockList;
TCPServeur.Contexts.UnlockList;
try
NbSConnect := List.Count;
for i := 0 to List.Count -1 do
begin
Client := List[i];
..... // getting information from Client
end;
finally
end;
end;
It works but is it really safe?
No, it is not thread-safe.
You can safely use List reference acquired by LockList until you call UnlockList. The moment you call UnlockList, list will no longer be protected and any List access after that point can cause concurrency issues.
Your original code is the proper way to use LockList/UnlockList.
As #DalijaPrasnikar's answer explains, your proposal is not safe, no. As soon as the list is unlocked, the server is able to freely modify the contents of the list as clients connect and disconnect, which will cause concurrency issues with your code.
I would suggest a different approach - rather than polling the client list every second, I would use the OnConnect and OnDisconnect events to add/remove elements from your UI as needed whenever the client list changes. If you are trying to track status updates per client during socket operations, you can post notifications to the main UI thread as they happen.
Thanks for your answers.
Following this CheckQueue exemple would it be possible to do the following :
replace " List := TCPServer.Contexts.LockList;" with " List.Assign(TCPServer.Contexts.LockList); "
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.
(Using Delphi 2009) I'm trying to write a simple network connection monitor using Indy TidIcmpClient. The idea is to ping an address, then inside an attached TidIcmpClient.OnReply handler test how much data was returned. If the reply contains > 0 bytes then I know the connection succeeded but if either the TidIcmpClient timed out or the reply contains 0 bytes I will assume the link is down
I'm having difficulty understanding the logic of TidIcmpClient as there is no 'OnTimeout' event.
Two sub questions...
Does TidIcmpClient.OnReply get called anyway, either (a) when data is received OR (b) when the timeout is reached, whichever comes first?
How can I distinguish a zero byte reply because of a timeout from a real reply within the timeout period that happens to contain zero bytes (or can't this happen)?
In other words is this sort of code OK or do I need to do something else to tell if it timed out or not
procedure TForm1.IdIcmpClient1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);
begin
if IdIcmpClient1.ReplyStatus.BytesReceived = 0 then
//we must have timed out, link is down
else
//got some data, connection is up
end;
procedure DoPing;
begin
IdIcmpClient1.ReceiveTimeout := 200;
IdIcmpClient1.Host := '8.8.8.8';
IdIcmpClient1.Ping;
end;
When Ping() exits, the ReplyStatus property contains the same information that is passed to the AReplyStatus parameter of the OnReply event (you are ignoring that parameter). Ping() simply calls the OnReply handler right before exiting, passing it the ReplyStatus property, so you don't actually need to use the OnReply event in your example. All that is doing is breaking up your code unnecessarily.
procedure DoPing;
begin
IdIcmpClient1.ReceiveTimeout := 200;
IdIcmpClient1.Host := '8.8.8.8';
IdIcmpClient1.Ping;
// process IdIcmpClient1.ReplyStatus here as needed...
end;
That being said, you are not processing the ReplyStatus data correctly. The BytesReceived field can be greater than 0 even if the ping fails. As its name implies, it simply reports how many bytes were actually received for the ICMP response. ICMP defines many different kinds of responses. The ReplyStatusType field will be set to the type of response actually received. There are 20 values defined:
type
TReplyStatusTypes = (rsEcho,
rsError, rsTimeOut, rsErrorUnreachable,
rsErrorTTLExceeded,rsErrorPacketTooBig,
rsErrorParameter,
rsErrorDatagramConversion,
rsErrorSecurityFailure,
rsSourceQuench,
rsRedirect,
rsTimeStamp,
rsInfoRequest,
rsAddressMaskRequest,
rsTraceRoute,
rsMobileHostReg,
rsMobileHostRedir,
rsIPv6WhereAreYou,
rsIPv6IAmHere,
rsSKIP);
If the ping is successful, the ReplyStatusType will be rsEcho, and the ReplyData field will contain the (optional) data that was passed to the ABuffer parameter of Ping(). You might also want to pay attention to the FromIpAddress and ToIpAddress fields as well, to make sure the response is actually coming from the expected target machine.
If a timeout occurs, the ReplyStatusType will be rsTimeOut instead.
Try this:
procedure DoPing;
begin
IdIcmpClient1.ReceiveTimeout := 200;
IdIcmpClient1.Host := '8.8.8.8';
IdIcmpClient1.Ping;
if IdIcmpClient1.ReplyStatus.ReplyStatusType = rsEcho then
begin
// got some data, connection is up
end
else if IdIcmpClient1.ReplyStatus.ReplyStatusType = rsTimeout then
begin
// have a timeout, link is down
end
else
begin
// some other response, do something else...
end;
end;
IdIcmpClient companent has OnReply event. This event has AReplyStatus param as type TReplyStatus. TReplyStatus has ReplyStatusType property. This property's type is TReplyStatusTypes. TReplyStatusTypes has rsTimeOut value. So add code to OnReply event and check timeout or other error.
procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
const AReplyStatus: TReplyStatus);
begin
if AReplyStatus.ReplyStatusType = rsTimeOut then
begin
//do someting on timeout.
end;
end;
In our Delphi XE4 application we are using an OmniThreadPool with MaxExecuting=4 to improve the efficiency of a certain calculation. Unfortunately we are having trouble with intermittent access violations (see for example the following MadExcept bug report http://ec2-72-44-42-247.compute-1.amazonaws.com/BugReport.txt). I was able to construct the following example which demonstrates the problem. After running the following console application, an access violation in System.SyncObjs.TCriticalSection.Acquire usually occurs within a minute or so. Can anybody tell me what I am doing wrong in the following code, or show me another way of achieving the desired result?
program OmniPoolCrashTest;
{$APPTYPE CONSOLE}
uses
Winapi.Windows, System.SysUtils,
DSiWin32, GpLists,
OtlSync, OtlThreadPool, OtlTaskControl, OtlComm, OtlTask;
const
cTimeToWaitForException = 10 * 60 * 1000; // program exits if no exception after 10 minutes
MSG_CALLEE_FINISHED = 113; // our custom Omni message ID
cMaxAllowedParallelCallees = 4; // enforced via thread pool
cCalleeDuration = 10; // 10 miliseconds
cCallerRepetitionInterval = 200; // 200 milliseconds
cDefaultNumberOfCallers = 10; // 10 callers each issuing 1 call every 200 milliseconds
var
gv_OmniThreadPool : IOmniThreadPool;
procedure OmniTaskProcedure_Callee(const task: IOmniTask);
begin
Sleep(cCalleeDuration);
task.Comm.Send(MSG_CALLEE_FINISHED);
end;
procedure PerformThreadPoolTest();
var
OmniTaskControl : IOmniTaskControl;
begin
OmniTaskControl := CreateTask(OmniTaskProcedure_Callee).Schedule(gv_OmniThreadPool);
WaitForSingleObject(OmniTaskControl.Comm.NewMessageEvent, INFINITE);
end;
procedure OmniTaskProcedure_Caller(const task: IOmniTask);
begin
while not task.Terminated do begin
PerformThreadPoolTest();
Sleep(cCallerRepetitionInterval);
end;
end;
var
CallerTasks : TGpInterfaceList<IOmniTaskControl>;
i : integer;
begin
gv_OmniThreadPool := CreateThreadPool('CalleeThreadPool');
gv_OmniThreadPool.MaxExecuting := cMaxAllowedParallelCallees;
CallerTasks := TGpInterfaceList<IOmniTaskControl>.Create();
for i := 1 to StrToIntDef(ParamStr(1), cDefaultNumberOfCallers) do begin
CallerTasks.Add( CreateTask(OmniTaskProcedure_Caller).Run() );
end;
Sleep(cTimeToWaitForException);
for i := 0 to CallerTasks.Count-1 do begin
CallerTasks[i].Terminate();
end;
CallerTasks.Free();
end.
You have here an example of hard-to-find Task controller needs an owner problem. What happens is that the task controller sometimes gets destroyed before the task itself and that causes the task to access memory containing random data.
Problematic scenario goes like this ([T] marks task, [C] marks task controller):
[T] sends the message
[C] receives the message and exits
[C] is destroyed
new task [T1] and controller [C1] are created
[T] tries to exit; during that it accesses the shared memory area which was managed by [C] but was then destroyed and overwritten by the data belonging to [C1] or [T1]
In the Graymatter's workaround, OnTerminated creates an implicit owner for the task inside the OmniThreadLibrary which "solves" the problem.
The correct way to wait on the task to complete is to call taskControler.WaitFor.
procedure OmniTaskProcedure_Callee(const task: IOmniTask);
begin
Sleep(cCalleeDuration);
end;
procedure PerformThreadPoolTest();
var
OmniTaskControl : IOmniTaskControl;
begin
OmniTaskControl := CreateTask(OmniTaskProcedure_Callee).Schedule(gv_OmniThreadPool);
OmniTaskControl.WaitFor(INFINITE);
end;
I will look into replacing shared memory record with reference-counted solution which would prevent such problems (or at least make them easier to find).
It looks like your termination message is causing the problem. Removing the message and the WaitForSingleObject stopped the AV. In my tests just adding a .OnTerminated(procedure begin end) before the .Schedule also did enough to change the flow and to stop the error. So the code in that case would look like this:
procedure PerformThreadPoolTest();
var
OmniTaskControl : IOmniTaskControl;
begin
OmniTaskControl := CreateTask(OmniTaskProcedure_Callee).OnTerminated(procedure begin end).Schedule(gv_OmniThreadPool);
WaitForSingleObject(OmniTaskControl.Comm.NewMessageEvent, INFINITE);
end;
It looks to me like this might be the problem. otSharedInfo_ref has a property called MonitorLock. This is used to block changes to otSharedInfo_ref. If for some reason otSharedInfo_ref is freed while the acquire is waiting then you are likely to get some very weird behavior
The code as it stands looks like this:
procedure TOmniTask.InternalExecute(calledFromTerminate: boolean);
begin
...
// with internal monitoring this will not be processed if the task controller owner is also shutting down
sync := nil; // to remove the warning in the 'finally' clause below
otSharedInfo_ref.MonitorLock.Acquire;
try
sync := otSharedInfo_ref.MonitorLock.SyncObj;
if assigned(otSharedInfo_ref.Monitor) then
otSharedInfo_ref.Monitor.Send(COmniTaskMsg_Terminated,
integer(Int64Rec(UniqueID).Lo), integer(Int64Rec(UniqueID).Hi));
otSharedInfo_ref := nil;
finally sync.Release; end;
...
end; { TOmniTask.InternalExecute }
If otSharedInfo_ref.MonitorLock.Acquire is busy waiting and the object behind otSharedInfo_ref is freed then we end up in a very nasty place. Changing the code to this stopped the AV that was happening in InternalExecute:
procedure TOmniTask.InternalExecute(calledFromTerminate: boolean);
var
...
monitorLock: TOmniCS;
...
begin
...
// with internal monitoring this will not be processed if the task controller owner is also shutting down
sync := nil; // to remove the warning in the 'finally' clause below
monitorLock := otSharedInfo_ref.MonitorLock;
monitorLock.Acquire;
try
sync := monitorLock.SyncObj;
if assigned(otSharedInfo_ref) and assigned(otSharedInfo_ref.Monitor) then
otSharedInfo_ref.Monitor.Send(COmniTaskMsg_Terminated,
integer(Int64Rec(UniqueID).Lo), integer(Int64Rec(UniqueID).Hi));
otSharedInfo_ref := nil;
finally sync.Release; end;
...
end; { TOmniTask.InternalExecute }
I did start getting AV's in the OmniTaskProcedure_Callee method then on the "task.Comm.Send(MSG_CALLEE_FINISHED)" line so it's still not fixed but this should help others/Primoz to further identify what is going on. In the new error, task.Comm is often unassigned.
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.