idtcpserver network flood

[Madammar]

hi , i am facing some kind of ddos attack on my idtcpserver port

my firewall works really fine on my ubuntu machine to block those bad ips and drop there packets

but why tidtcpserver application gets unresponsive while such attack is happened ?

i dont have any none thread safe access in my code

here is the full server code

Code:

unit servrfrm;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.SyncObjs, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent,
 IdCustomTCPServer, IdTCPServer, IdThreadSafe, IdYarn, idGlobal, IdTCPConnection,
 IdContext, IdSocketHandle, Vcl.StdCtrls, Vcl.ExtCtrls, DateUtils, StrUtils;


type
 TConnection = class(TIdServerContext)
 private
 IP: String;
 Connected: TDateTime;


 public
 OutboundCache: TIdThreadSafeStringList;
 //create connection
 constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
 destructor Destroy; override;

 //sending methods
 procedure SendCommandWithParams(const Command: String);



 end;

type
 Trsrvfrm = class(TForm)
   TcpServer: TIdTCPServer;
   Panel1: TPanel;
   Edit1: TEdit;
   Button1: TButton;
   Button2: TButton;
   Memo1: TMemo;
   procedure TcpServerConnect(AContext: TIdContext);
   procedure TcpServerExecute(AContext: TIdContext);
   procedure Button1Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure TcpServerDisconnect(AContext: TIdContext);
 private
   procedure UpdateBindings;
   { Private declarations }
 public
   { Public declarations }
 end;

var
 rsrvfrm: Trsrvfrm;

implementation
uses constants;
{$R *.dfm}


{ TConnection }

constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
 AList: TIdContextThreadList);
begin
 inherited;
 OutboundCache := TIdThreadSafeStringList.Create;
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;



procedure TConnection.SendCommandWithParams(const Command : String);
var
scmd : string;
begin

scmd := '1'+Command;


OutboundCache.Add(scmd);

end;





procedure Trsrvfrm.Button1Click(Sender: TObject);
begin
TcpServer.ContextClass := TConnection;

UpdateBindings;
TcpServer.Active := true;
end;

procedure Trsrvfrm.Button2Click(Sender: TObject);
begin
TcpServer.Active := False;
end;


procedure Trsrvfrm.UpdateBindings;
var
 Binding: TIdSocketHandle;
begin
 TcpServer.DefaultPort := StrToInt(Edit1.Text);
 TcpServer.Bindings.Clear;
 Binding := TcpServer.Bindings.Add;
 Binding.IP := '0.0.0.0';
 Binding.Port := StrToInt(Edit1.Text);
end;

procedure Trsrvfrm.FormDestroy(Sender: TObject);
begin
TcpServer.Active := False;
TcpServer.Destroy;
end;

procedure Trsrvfrm.TcpServerConnect(AContext: TIdContext);
var
CLIENTCONN: TConnection;
begin
CLIENTCONN := AContext as TConnection;
CLIENTCONN.Connection.IOHandler.MaxLineLength := Maxint;
CLIENTCONN.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
CLIENTCONN.Connection.Socket.UseNagle := False;
CLIENTCONN.IP := AContext.Binding.PeerIP;
CLIENTCONN.Connected := Now;







end;

procedure Trsrvfrm.TcpServerDisconnect(AContext: TIdContext);
var
CLIENTCONN: TConnection;
begin
CLIENTCONN := AContext as TConnection;

end;

procedure Trsrvfrm.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
cmdhandle : string;
Startercommand : String;
Params: array [1 .. 200] of String;
Cache, OutboundCmds: TStringList;
ParamsCount, P: integer;
ReceiveParams: BOOLEAN;
I: integer;
DECODES : String;

begin

sleep(10);

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);
end;

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
Exit;
end;
end;



Startercommand := AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8);

Command := Startercommand;



if Command = '' then
begin
AContext.Connection.Disconnect;
Exit;
end;

ReceiveParams := False;


//Command Type

if Command[1] = '1' then // command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := true;
end;


if ReceiveParams = true then // params is incomming
begin
DECODES := Command;

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);
end;
end;
end;

cmdhandle := Params[1];



if cmdhandle = '' then
begin
AContext.Connection.Disconnect;
Exit;
end;



if cmdhandle = 'Ping' then
begin
Connection.SendCommandWithParams('pong' + sep);
end;


end;

end.

what could be the problem with in the code ?

[rlebeau]

my firewall works really fine on my ubuntu machine to block those bad ips and drop there packets

If that were true, you would not be having a problem with your TIdTCPServer app, as the flood traffic would not reach it in the first place.

why tidtcpserver application gets unresponsive while such attack is happened ?

In what way exactly?  If the flood traffic were not reaching the TIdTCPServer, then it wouldn't be doing anything to make it become unresponsive.

here is the full server code

I don't see anything in that code that can cause the app to become unresponsive.  However, the code can be simplified a bit:

Code:

type
 TConnection = class(TIdServerContext)
 private
   ...
 public
   HasPendingOutbound: Boolean;
   OutboundCache: TIdThreadSafeStringList;
   ...
    // sending methods
    procedure SendCommand(const Command: String);
    procedure SendCommandWithParams(const Command, Params: String);
    ...
 end;

procedure TConnection.SendCommand(const Command : String);
begin
 with OutboundCache.Lock do
 try
   Add(Command);
   HasPendingOutbound := True;
 finally
   OutboundCache.Unlock;
 end;
end;

procedure TConnection.SendCommandWithParams(const Command, Params: String);
begin
  SendCommand('1' + Command + Sep + Params);
end;

procedure Trsrvfrm.TcpServerExecute(AContext: TIdContext);
var
 Connection: TConnection;
 Command, Temp: String;
 Params: array [1 .. 200] of String;
 Cache, OutboundCmds: TStringList;
 ParamsCount, I: integer;
begin
 Connection := AContext as TConnection;

 // check for pending outbound commands...
 if Connection.HasPendingOutbound then
 begin
   OutboundCmds := TStringList.Create;
   try
     Cache := Connection.OutboundCache.Lock;
     try
       OutboundCmds.Assign(Cache);
       Cache.Clear;
       Connection.HasPendingOutbound := False;
     finally
       Connection.OutboundCache.Unlock;
     end;

     for I := 0 to OutboundCmds.Count - 1 do
       AContext.Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
   finally
     OutboundCmds.Free;
   end;
 end;

 // check for a pending inbound command...
 if AContext.Connection.IOHandler.InputBufferIsEmpty then
 begin
   AContext.Connection.IOHandler.CheckForDataOnSource(10);
   AContext.Connection.IOHandler.CheckForDisconnect;
   if AContext.Connection.IOHandler.InputBufferIsEmpty then
     Exit;
 end;

 Command := AContext.Connection.Socket.ReadLn;

 if Command <> '' then
 begin
   //Command Type
   if Command[1] = '1' then // command with params
   begin
     Temp := Copy(Command, 2, MaxInt);
     Command := Fetch(Temp, Sep);
     ParamsCount := 0;
     while (Temp <> '') and (ParamsCount < 200) do
     begin
       Inc(ParamsCount);
       Params[ParamsCount] := Fetch(Temp, Sep);
     end;
   end;
 end;

 if Command = '' then
 begin
   AContext.Connection.Disconnect;
   Exit;
 end;

 if Command = 'Ping' then
   AContext.Connection.IOHandler.WriteLn('pong');
end;