TidTcpserver 验证命令列表

Question

我正在努力保护我的 Tidtcpserver 免受未知命令的侵害

这就是我的验证命令功能的样子

 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;

添加此检查执行事件后，在少数客户端连接后，服务器应用程序冻结，需要重新启动，异常日志为空

这是我的服务器代码

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;

如果我从执行中删除 Verfieycmds，请正常检查服务器运行。我做错了什么？

Answer 1

没有理由为命令列表使用 TIdThreadSafeStringList。只有创建列表的线程才会访问它，因此为它使用锁是不必要的开销。

就此而言，没有理由为每个客户分配一个新列表。那只是在浪费内存。

您的命令以一种需要解码的方式编码，然后您才能验证它们。

尝试更像这样的东西：

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 验证命令列表

TidTcpserver Verify commands List

indy

indy10

delphi-10-seattle