TidTcpserver Verify commands List

Question

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 ?

Why are you using `TIdThreadSafeStringList`? You are giving each client its own **local** list (which is a waste of memory if the actual commands never change) so it doesn't need to be protected with a lock (unless you plan on having other threads alter a client's commands dynamically). If not, then use `TStringList` instead. I suggest getting rid of the list completely, just hard-code the values in `Verfieycmds()` directly. Or better, get rid of `Verfieycmds()`, it is redundant anyway. `OnExecute` has to process client commands anyway, so just disconnect if a given command is not processed. — Remy Lebeau, Apr 22 '17 at 17:44
And BTW, `Verfieycmds()` is returning True even if the requested command is not actually found. You gave an erroneous `CommandFound := True;` after your search loop exits. And why are you freeing objects from the command list's `Objects[]` property? You are not storing any objects in there, so there is nothing to free. — Remy Lebeau, Apr 22 '17 at 17:44
yes i listen to your advice , i did not use Tstringlist but i created a case of string function . no freeze now , case of string function is thread safe right ? by the way i do the verification because there is unauthorized access to my tidtcpserver that try to flood the server with unknown commands very fast and thats makes the server not response and needs to restart . thats why i think of listing the commands and if the command not listed then disconnect the bad client . — Vlark.Lopin, Apr 22 '17 at 22:38
using a verification function won't prevent flooding, all it serves is to force a double lookup for legitimate users. It is not worth it — Remy Lebeau, Apr 22 '17 at 22:45
@RemyLebeau this is not a ddos attack , i mean the bad client is connecting to my TidTcpserver and start sending commands using `writeln ` and that makes the tidTcpserver stop from listening and need restart — Vlark.Lopin, Apr 23 '17 at 04:28
that is not how `TIdTCPServer` works. One client flooding it with commands would not prevent other clients from continuing to work OK, the server would not need to be restarted. And like I said, your verify function is redundant and unnecessary for what you need. — Remy Lebeau, Apr 23 '17 at 04:48
agree because still the server stopped from Listening when this happened , what i should do i really don't know. you refer to disconnection if the command is not processed how can i achieve that if the server received the command how the it will know if its being processed it reads it any way — Vlark.Lopin, Apr 23 '17 at 06:06

Remy Lebeau · Accepted Answer · 2017-04-23T15:50:35.783

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;

TidTcpserver Verify commands List

1 Answers1