I Am trying to protect my Tidtcpserver from unknown commands
This is how my Verify commands function looks like
function TConnection.Verfieycmds(const CMSTOV: String): BOOLEAN;
var
CMDSTOVERFIYE : Tstringlist;
I : integer;
CommandFound : Boolean;
begin
Result := False;
CommandFound := False;
if Commandlist <> nil then
begin
CMDSTOVERFIYE := Commandlist.Lock;
try
for I := 0 to CMDSTOVERFIYE.Count - 1 do
begin
if CMSTOV = CMDSTOVERFIYE[I] then
begin
CommandFound := True;
end;
end;
CommandFound := True;
Result := CommandFound;
finally
Commandlist.Unlock;
end;
end;
end;
after adding this check on execute event and after few clients connect the server application freezed and need to be restarted and the exception log were empty
here is my server code
type
TConnection = class(TIdServerContext)
private
{Private}
public
{Public}
OutboundCache: TIdThreadSafeStringList;
Commandlist: TIdThreadSafeStringList;
LastSendRecv: TIdTicks;
Name: String;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
type
TServobj = class(TForm)
TcpServer: TIdTCPServer;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure TcpServerConnect(AContext: TIdContext);
procedure TcpServerDisconnect(AContext: TIdContext);
procedure TcpServerExecute(AContext: TIdContext);
procedure FormCloseQuery(Sender: TObject; var CanClose: BOOLEAN);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TcpServerListenException(AThread: TIdListenerThread;
AException: Exception);
private
{ Private declarations }
LastUniqueID: Dword;
procedure HandleExceptions(Sender: TObject; E: Exception);
procedure UpdateBindings;
public
{ Public declarations }
end;
var
Servobj: TServobj;
implementation
uses
dmoudle;
{$R *.dfm}
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil);
begin
inherited;
OutboundCache := TIdThreadSafeStringList.Create;
Commandlist := TIdThreadSafeStringList.Create;
Commandlist.Add('Command1');
Commandlist.Add('Command2');
Commandlist.Add('Command3');
Commandlist.Add('Command4');
Commandlist.Add('Command5');
Commandlist.Add('Command6');
Commandlist.Add('Command7');
Commandlist.Add('Command8');
Commandlist.Add('Command9');
Commandlist.Add('Command10');
Commandlist.Add('Command11');
Commandlist.Add('Command12');
end;
destructor TConnection.Destroy;
var
Cache: TStringList;
Commadcaches : TStringList;
I: integer;
begin
if OutboundCache <> nil then
begin
Cache := OutboundCache.Lock;
try
for I := 0 to Cache.Count - 1 do
Cache.Objects[I].Free;
finally
OutboundCache.Unlock;
end;
OutboundCache.Free;
end;
if Commandlist <> nil then
begin
Commadcaches := Commandlist.Lock;
try
for I := 0 to Commadcaches.Count - 1 do
Commadcaches.Objects[I].Free;
finally
Commandlist.Unlock;
end;
Commandlist.Free;
end;
inherited;
end;
procedure TServobj.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Startercommand : String;
Params: array [1 .. 200] of String;
Cache, OutboundCmds: TStringList;
ParamsCount, P: integer;
I: integer;
S: String;
DECODES : String;
UConnected : Boolean;
Len: Integer;
begin
Try
UConnected := AContext.Connection.Connected;
Except
UConnected := False;
End;
If Not UConnected Then
begin
AContext.Connection.Disconnect;
exit;
end;
Len := AContext.Connection.IOHandler.InputBuffer.Size;
If Len >= 200000 then
begin
AContext.Connection.Disconnect;
exit;
end;
Connection := AContext as TConnection;
// check for pending outbound commands...
OutboundCmds := nil;
try
Cache := Connection.OutboundCache.Lock;
try
if Cache.Count > 0 then
begin
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
end;
finally
Connection.OutboundCache.Unlock;
end;
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
AContext.Connection.IOHandler.Writeln(OutboundCmds.Strings[I],
IndyTextEncoding_UTF8);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
AContext.Connection.IOHandler.LargeStream := true;
AContext.Connection.IOHandler.Write(MS, 0, true);
end;
end;
Connection.LastSendRecv := Ticks64;
end;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
OutboundCmds.Objects[I].Free;
end;
end;
OutboundCmds.Free;
end;
// check for a pending inbound command...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if GetElapsedTicks(Connection.LastSendRecv) >= 60000 then
AContext.Connection.Disconnect;
Exit;
end;
end;
Startercommand := Decode64(AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8), IndyTextEncoding_UTF8);
Command := Startercommand;
{HERE I START TO CHECK COMMAND LIST}
if (command <> 'ISACTIVE') then
begin
if Connection.Verfieycmds(Command) <> true then
begin
AContext.Connection.Disconnect;
Exit;
end;
end;
{HERE I START TO CHECK COMMAND LIST}
Connection.LastSendRecv := Ticks64;
if Command = '' then
begin
AContext.Connection.Disconnect;
Exit;
end;
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
S := AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8);
DECODES := Decode64(S, IndyTextEncoding_UTF8);
ParamsCount := 0;
while (DECODES <> '') and (ParamsCount < 200) do
begin
Inc(ParamsCount);
P := Pos(Sep, DECODES);
if P = 0 then
Params[ParamsCount] := DECODES
else
begin
Params[ParamsCount] := Copy(DECODES, 1, P - 1);
Delete(DECODES, 1, P + 5);
end;
end;
end;
if Command = 'Broadcastanymessage' then
begin
if ParamsCount <> 3 then
begin
AContext.Connection.Disconnect;
Exit;
end;
//do something
end;
end;
if i remove the Verfieycmds from the execute check the server running normally . what i am doing wrong ?
There is no reason to use a TIdThreadSafeStringList for the commands list. Only the thread that creates the list will ever be accessing it, so using a lock for it is unnecessary overhead.
And there is no reason to allocate a new list for each client, for that matter. That is just wasting memory.
Your commands are encoded in a manner that requires decoding before you can then validate them.
Try something more like this instead:
type
TConnection = class(TIdServerContext)
private
function HasInboundData: Boolean;
procedure SendOutboundCache;
public
OutboundCache: TIdThreadSafeStringList;
LastSendRecv: TIdTicks;
// ...
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
type
TServobj = class(TForm)
TcpServer: TIdTCPServer;
//...
procedure TcpServerConnect(AContext: TIdContext);
//...
procedure TcpServerExecute(AContext: TIdContext);
procedure FormCreate(Sender: TObject);
//...
private
//...
end;
var
Servobj: TServobj;
implementation
uses
dmoudle;
{$R *.dfm}
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
OutboundCache := TIdThreadSafeStringList.Create;
LastSendRecv := Ticks64;
end;
destructor TConnection.Destroy;
var
Cache: TStringList;
I: integer;
begin
if OutboundCache <> nil then
begin
Cache := OutboundCache.Lock;
try
for I := 0 to Cache.Count - 1 do
Cache.Objects[I].Free;
finally
OutboundCache.Unlock;
end;
OutboundCache.Free;
end;
inherited;
end;
function TConnection.HasInboundData: Boolean;
begin
if Connection.IOHandler.InputBufferIsEmpty then
begin
Connection.IOHandler.CheckForDataOnSource(100);
Connection.IOHandler.CheckForDisconnect;
if Connection.IOHandler.InputBufferIsEmpty then
begin
if GetElapsedTicks(LastSendRecv) >= 60000 then
Connection.Disconnect;
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure TConnection.SendOutboundCache;
var
Cache, OutboundCmds: TStringList;
MS: TMemoryStream;
I: integer;
begin
OutboundCmds := nil;
try
Cache := OutboundCache.Lock;
try
if Cache.Count = 0 then
Exit;
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
finally
OutboundCache.Unlock;
end;
for I := 0 to OutboundCmds.Count - 1 do
begin
Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
Connection.IOHandler.LargeStream := true;
Connection.IOHandler.Write(MS, 0, true);
end;
end;
LastSendRecv := Ticks64;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
OutboundCmds.Objects[I].Free;
end;
end;
OutboundCmds.Free;
end;
end;
procedure TServobj.FormCreate(Sender: TObject);
begin
TcpServer.ContextClass := TConnection;
end;
procedure TServobj.TcpServerConnect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8
end;
const
ValidCmds: array[0..13] of String = (
'ISACTIVE',
'Broadcastanymessage',
'Command1',
'Command2',
'Command3',
'Command4',
'Command5',
'Command6',
'Command7',
'Command8',
'Command9',
'Command10',
'Command11',
'Command12'
);
procedure TServobj.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command, Decoded: String;
Params: array[1..200] of String;
ParamsCount, P, I, WhichCmd: integer;
begin
Connection := AContext as TConnection;
// check for pending outbound commands...
Connection.SendOutboundCache;
// check for a pending inbound command...
if not Connection.HasInboundData then
Exit;
Command := Decode64(AContext.Connection.IOHandler.ReadLn, IndyTextEncoding_UTF8);
ReceiveParams := False;
ReceiveStream := False;
if Command <> '' then
begin
if Command[1] = '1' then // command with params
begin
Delete(Command, 1, 1);
ReceiveParams := true;
end
else if Command[1] = '2' then // command + memorystream
begin
Delete(Command, 1, 1);
ReceiveStream := true;
end
else if Command[1] = '3' then // command with params + memorystream
begin
Delete(Command, 1, 1);
ReceiveParams := true;
ReceiveStream := true;
end;
end;
WhichCmd := PosInStrArray(Command, ValidCmds);
if WhichCmd = -1 then
begin
AContext.Connection.Disconnect;
Exit;
end;
if ReceiveParams then // params is incomming
begin
Decoded := Decode64(AContext.Connection.IOHandler.ReadLn, IndyTextEncoding_UTF8);
ParamsCount := 0;
while (Decoded <> '') and (ParamsCount < 200) do
begin
Inc(ParamsCount);
P := Pos(Sep, Decoded);
if P = 0 then
Params[ParamsCount] := Decoded
else
begin
Params[ParamsCount] := Copy(Decoded, 1, P - 1);
Delete(Decoded, 1, P + Length(Sep));
end;
end;
end;
Connection.LastSendRecv := Ticks64;
case WhichCmd of
// process commands as needed...
1: begin // Broadcastanymessage
if ParamsCount <> 3 then
begin
AContext.Connection.Disconnect;
Exit;
end;
//do something
end;
// ...
end;
end;