Why My server application freeze after several clients connected? - indy

Question

i am using indy TidTcpserver inside my server application its working good but some times after 10 clients connected my server application got a deadlock and stop from response here is my server execute and broadcast protocol codes
Tcp server execute
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Connection := Pointer(AContext.Data);
MS := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
MS.Position := 0;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
p := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then //stream is incomming
begin
Size := AContext.Connection.Socket.ReadInt64;
AContext.Connection.Socket.ReadStream(MS, Size, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
usrnm := Params[1];
passwd := params[2];
if not userexists(usrnm, passwd) then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
begin
userslq.Close;
userslq.SQL.Clear;
userslq.SQL.Add('SELECT * FROM `users` WHERE `username` = "'+ trim(usrnm) +'" AND `password` = "' + trim(passwd) + '"');
userslq.Open;
if NOT userslq.IsEmpty then
begin
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
userslq.Close;
end;
userslq.Close;
userslq.SQL.Clear;
userslq.SQL.Add('UPDATE `users` SET `lastlogin` = :Date, `timeslogin`=(`timeslogin`+1) WHERE `users`.`username` = :uname;');
userslq.ParamByName('uname').AsString := trim(usrnm);
userslq.ParamByName('Date').AsDate := Now;
userslq.ExecSQL;
userslq.Close;
end;
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
AddConnectionToListView(Connection);
end;
if Command = 'TEXTMESSAGE' then
begin
BroadCastTextMessage(Params[1], Connection.UniqueID, Connection.Name, Connection.IP);
end;
if Command = 'DISCONNECTED' then
begin
DeleteConnectionFromList(Connection.UniqueID);
DeleteConnectionFromListView(Connection.UniqueID);
end;
MS.Free;
end;
broadcast Protocol and used procedures
procedure TfMain.AddConnectionToListView(Connection: TConnection);
begin
with lwConnections.Items.Add do
begin
Caption := Connection.Name;
SubItems.Add(Connection.IP);
SubItems.Add(FormatDateTime('hh:mm:ss', Connection.Connected));
SubItems.Add(IntToStr(Connection.UniqueID));
end;
end;
procedure TfMain.DeleteConnectionFromListView(UniqueID: DWord);
var
I: Integer;
begin
for I := 0 to lwConnections.Items.Count - 1 do
begin
if lwConnections.Items.Item[I].SubItems.Strings[2] = IntToStr(UniqueID) then
begin
lwConnections.Items.Delete(I);
Break;
end;
end;
end;
procedure TfMain.DeleteConnectionFromList(UniqueID: DWord);
var
I, Pos: Integer;
begin
Pos := -1;
for I := 0 to Connections.Count - 1 do
begin
if TConnection(Connections.Items[I]).UniqueID = UniqueID then
begin
Pos := I;
Break;
end;
end;
if Pos <> -1 then
Connections.Delete(Pos);
end;
procedure TfMain.BroadCastTextMessage(const TextMessage: String; const FromUniqueID: DWord;
const FromName: string; const dip: string);
var
I: Integer;
Connection: TConnection;
begin
for I := 0 to Connections.Count - 1 do
begin
Connection := Connections.Items[I];
if Connection.UniqueID <> FromUniqueID then
SendCommandWithParams(Connection, 'TEXTMESSAGE', FromName + Sep + TextMessage + Sep + dip + Sep);
end;
end;
procedure TfMain.SendCommandWithParams(Connection: TConnection; Command, Params:String);
var
PackedParams: TPackedParams;
begin
if not TIdContext(Connection.Thread).Connection.Socket.Connected then
Exit;
TCPServer.Contexts.LockList;
try
PackedParams.Params := ShortString(Params);
with TIdContext(Connection.Thread).Connection.Socket do
begin
WriteLn('1' + Command);
Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
on connect server event
procedure Tfmain.TcpServerConnect(AContext: TIdContext);
var
Connection : TConnection;
begin
Connection := TConnection.Create;
Connection.IP := AContext.Connection.Socket.Binding.PeerIP;
Connection.Connected := Now;
Connection.UniqueID := GetTickCount;
if Connection.UniqueID = LastUniqueID then
Connection.UniqueID := GetTickCount + 1000;
LastUniqueID := Connection.UniqueID;
Connection.Thread := AContext;
AContext.Data := Connection;
end;
Updated
by following remy answer and his great details i started to do synchronize but in remy answer i am confused about TCriticalSection also i will have to rewrite the client code to be able to do same as his code doing , so i had to go with thread synchronize first here is example of what i did by following remy code i did some manage and removed database temporarily to avoid confusing here is the code of trying synchronization UI inside server execute
if Command = 'LOGIN' then
begin
if Password <> Params[1] then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
AddConnectionToListView(Connection);// this is not safe i know and thats what makes me confused so in this procedure call i do same as remy doing
end;
procedure TfMain.AddConnectionToListView(Connection: TConnection);
begin
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
Item := lwConnections.Items.Add;
try
Item.Caption := Connection.Name;
Item.SubItems.Add(Connection.IP);
Item.SubItems.Add(FormatDateTime('hh:mm:ss', Connection.Connected));
Item.SubItems.Add(IntToStr(Connection.UniqueID));
except
Item.Delete;
raise;
end;
end
);
end;
is this correct to synchronize ? whats makes me confused is this thread synchronize by itself ? i mean there is no thread class to execute and synchronize is this correct way ?
Updates about synchronize
Remy answer helps me i thanks him too much , but iam trying to understand thus synchronize part i found some ways on google as example include
idsync in my uses
and call it like this as example
uses
idsync;
// and in server execute i call TiDNotify To synchronize what ever i want ?
procedure TfMain.DeleteConnectionFromListView;
var
I: Integer;
begin
for I := 0 to lwConnections.Items.Count - 1 do
begin
if lwConnections.Items.Item[I].SubItems.Strings[2] = IntToStr(linetToID) then
begin
DeleteConnectionFromList(linetToID);
lwConnections.Items.Delete(I);
Break;
end;
end;
end;
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Connection := Pointer(AContext.Data);
MS := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
MS.Position := 0;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
p := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then //stream is incomming
begin
Size := AContext.Connection.Socket.ReadInt64;
AContext.Connection.Socket.ReadStream(MS, Size, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
if Password <> Params[1] then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
TIdNotify.NotifyMethod(Connection.AddToListView);
end;
if Command = 'TEXTMESSAGE' then
begin
BroadCastTextMessage(Params[1], Connection.UniqueID);
end;
if Command = 'GETLIST' then
begin
SendClientsListTo(Connection.UniqueID);
end;
if Command = 'DISCONNECTED' then
begin
linetToID := Connection.UniqueID;// fmain private string variable
TIdNotify.NotifyMethod(DeleteConnectionFromListView);
end;
MS.Free;
end;

Answer 1

TIdTCPServer is a multi-threaded component. Its OnExecute event is triggered in the context of a worker thread. But your TAKEMYINFO and DISCONNECTED command handlers are directly accessing UI controls without synchronizing with the main UI thread. That can easily cause deadlocks (amongst other problems, including crashes, killing the UI, etc). You MUST sync!
Also, is userexists() thread-safe? Is userslq? Your use of the Connections list is definitely not thread-safe.
Why is SendCommandWithParams() locking the server's Contexts list, especially when called by OnExecute? You don't need to do that. You should be locking it in BroadCastTextMessage() instead.
Try something more like this:
type
TConnnection = class(TIdServerContext)
private
WriteLock: TCriticalSection;
public
Name: String;
IP: String;
Connected: TDateTime;
UniqueID: Dword;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
procedure AddToListView;
procedure DeleteFromListView;
procedure BroadcastTextMessage(const TextMessage: String);
procedure SendCommandWithParams(const Command, Params: String);
procedure SendLn(const S: String);
function UserExists(const User, Passwd: string): Boolean;
procedure UpdateLastLogin(const User: String);
end;
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
WriteLock := TCriticalSection.Create;
end;
destructor TConnection.Destroy;
begin
WriteLock.Free;
inherited;
end;
procedure TConnection.AddToListView;
var
LName: string;
LIP: string;
LConnected: TDateTime;
LUniqueID: Dword;
begin
// in case the client disconnects and destroys this object before
// TThread.Queue() can update the ListView, capture the values so
// this object's fields are not accessed directly...
//
LName := Self.Name;
LIP := Self.IP;
LConnected := Self.Connected;
LUniqueID := Self.UniqueID;
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
if (fMain = nil) or (fMai.lwConnections = nil) then Exit;
Item := fMain.lwConnections.Items.Add;
try
Item.Data := Self;
Item.Caption := LName;
Item.SubItems.Add(LIP);
Item.SubItems.Add(FormatDateTime('hh:mm:ss', LConnected));
Item.SubItems.Add(IntToStr(LUniqueID));
except
Item.Delete;
raise;
end;
end
);
end;
procedure TConnection.DeleteFromListView;
begin
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
if (fMain = nil) or (fMai.lwConnections = nil) then Exit;
Item := fMain.lwConnections.FindData(0, Self, True, False);
if Item <> nil then Item.Delete;
end
);
end;
procedue TConnection.BroadCastTextMessage(const TextMessage: String);
var
List: TList; // or TIdContextList if using a modern Indy version
I: Integer;
Connection: TConnection;
begin
List := Server.Contexts.LockList;
try
for I := 0 to List.Count - 1 do
begin
Connection := TConnection(List.Items[I]);
if Connection <> Self then
begin
try
Connection.SendCommandWithParams('TEXTMESSAGE', FromName + Sep + TextMessage + Sep + dip + Sep);
except
end;
end;
finally
Server.Contexts.UnlockList;
end;
end;
procedure TConnection.SendCommandWithParams(const Command, Params: String);
var
PackedParams: TPackedParams;
begin
PackedParams.Params := ShortString(Params);
WriteLock.Enter;
try
with Connection.Socket do
begin
WriteLn('1' + Command);
Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
finally
WriteLock.Leave;
end;
end;
procedure TConnection.SendLn(const S: String);
begin
WriteLock.Enter;
try
Connection.Socket.WriteLn(S);
finally
WriteLock.Leave;
end;
end;
function TConnection.UserExists(const User, Passwd: string): Boolean;
var
Exists: Boolean;
begin
// if you give each client its own DB connection, or use
// a thread-safe DB pool, you don't have to sync this ...
//
TThread.Synchronize(nil,
procedure
if (fMain = nil) or (fMai.userslq = nil) then Exit;
with fMain.userslq do
begin
Close;
SQL.Text := 'SELECT * FROM `users` WHERE `username` = :uname AND `password` = :passwd;';
ParamByName('uname').AsString := Trim(User);
ParamByName('passwd').AsString := Trim(Passwd);
Open;
try
Exists := not IsEmpty;
finally
Close;
end;
end;
end
);
Result := Exists;
end;
procedure TConnection.UpdateLastLogin(const User: String);
begin
// if you give each client its own DB connection, or use
// a thread-safe DB pool, you don't have to sync this ...
//
TThread.Synchronize(nil,
procedure
if (fMain = nil) or (fMai.userslq = nil) then Exit;
with fMain.userslq do
begin
Close;
SQL.Text := 'UPDATE `users` SET `lastlogin` = :Date, `timeslogin`=(`timeslogin`+1) WHERE `users`.`username` = :uname;';
ParamByName('uname').AsString := Trim(User);
ParamByName('Date').AsDate := Now;
ExecSQL;
Close;
end;
end
);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
// set this before activating the server
TCPServer.ContextClass := TConnection;
end;
procedure TfMain.TCPServerConnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
Connection.Name := '';
Connection.IP := AContext.Binding.PeerIP;
Connection.Connected := Now;
Connection.UniqueID := ...;
end;
procedure TfMain.TCPServerDisconnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
Connection.DeleteFromListView;
end;
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
S: String;
begin
Connection := AContext as TConnection;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command = '' then Exit;
ReceiveParams := False;
ReceiveStream := False;
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveStream := True;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
S := String(PackedParams.Params);
ParamsCount := 0;
while (S <> '') and (ParamsCount < 10) do
begin
Inc(ParamsCount);
p := Pos(Sep, S);
if p = 0 then
Params[ParamsCount] := S
else
begin
Params[ParamsCount] := Copy(S, 1, P - 1);
Delete(S, 1, P + 4);
end;
end;
end;
MS := nil;
try
if ReceiveStream then //stream is incomming
begin
MS := TMemoryStream.Create;
AContext.Connection.Socket.LargeStream := True;
AContext.Connection.Socket.ReadStream(MS, -1, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
if ParamsCount <> 2 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
if not Connection.UserExists(Params[1], Params[2]) then
begin
Connection.SendLn('INVALIDPASSWORD');
Exit;
end;
Connection.UpdateLastLogin(Params[1]);
Connection.SendCommandWithParams('SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end
else if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
if ParamsCount <> 1 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
Connection.Name := Params[1];
Connection.AddToListView;
end
else if Command = 'TEXTMESSAGE' then
begin
if ParamsCount <> 1 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
Connection.BroadCastTextMessage(Params[1]);
end
else if Command = 'DISCONNECTED' then
begin
AContext.Connection.Disconnect;
Exit;
end;
finally
MS.Free;
end;
end;