Surcharge TIdTCPServer Indy

**XeGregory** · 22/06/2018, 12h53

Bonjour,

J'ai développé une petite application pour tester ma class "XServer",l'application consiste à créer dynamiquement des Bots (TIdTCPClient) puis leur faire envoyer des messages entre eux.

Bot5 --> Bot24
Bot11 --> Bot6
etc...

Nom : Sans titre 1.jpg
Affichages : 693
Taille : 77,5 Ko

Nom : Sans titre 1.jpg
Affichages : 693
Taille : 77,5 Ko

Le problème lorsque sur le serveur à atteint environ ~6000 messages le serveur ne répond plus, Côté client aucune expression n'est levée. j'en ai conclu que les bots sont toujours connectés au serveur, le serveur ne traite plus aucun messages pour X raison.

Test 1 : Nombre de message envoyés : 6288
Test 2 : Nombre de message envoyés : 6296
Test 3 : Nombre de message envoyés : 6361
Test 4 : Nombre de message envoyés : 6306

Je me suis rendu compte de ce problème avec le contrôle suivent :
Pour chaque message envoyé côté client j'incrémente une variable, Côté serveur pour chaque message traité incrémente une variable.
Si les deux variables sont identiques c'est que tout va bien coté serveur, le serveur traite bien les messages envoyés par les bots.

Lors du teste les variables sont identiques (Bot5 --> Bot24 , Coté Client +1, Coté Serveur +1), le serveur encaisse les messages sans problème, jusqu'à ce que le serveur atteigne environ ~6000 messages traités, la variable côté serveur ne s'incrémente plus, le serveur ne répond plus (Overload).

class "XServer" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
unit UXServer;
 
interface
 
uses
  System.SysUtils, System.Classes, IdTCPServer, IdTCPClient, IdBaseComponent, IdComponent,
  IdContext, IdCustomTCPServer, IdScheduler, IdSchedulerOfThread, IdIntercept,
  IdSchedulerOfThreadDefault, IdCompressionIntercept, IdGlobal, IdStack;
 
const
  MaxSlots = 30;
  DefaultTCPPort = 49650;
 
type { **  TXClient  ** }
  TConnexion = (TConnect, TDisconnect);
 
  TXClient = class
 
  private { Déclarations privées }
    XNickName: String;
    XId: Integer;
    XState: TConnexion;
 
  public { Déclarations publiques }
    { Constructor TClient }
    constructor Create(NickName: String; IdClient: Byte);
    { Pseudo Client }
    property NickName: String read XNickName;
    { ID Client }
    property Id: Integer read XId;
    { State Client }
    property State: TConnexion read XState write XState;
 
  end;
 
type { **  TXServer  ** }
  TXServer = class(TObject)
    { Serveur TCP }
    IdTCPServer: TIdTCPServer;
    { Thread Serveur }
    IdSchedulerOfThreadDefault: TIdSchedulerOfThreadDefault;
 
    { Serveur Execute }
    procedure IdTCPServerExecute(AContext: TIdContext);
    { Déconnexion Client }
    procedure IdTCPServerDisconnect(AContext: TIdContext);
 
  private { Déclarations privées }
    { Clients }
    XClients: array [1 .. MaxSlots] of TXClient;
    { Message Privé }
    procedure SendPrivate(NickName, StrData: String);
    { Gestion des messages }
    procedure XMessage(AContext: TIdContext; StrData: String);
    { Deconnexion de tous les clients }
    procedure DisconnectAllXClient;
 
  public { Déclarations publiques }
    { Compteur Message Server --> Client Bot }
    CtpServerToClientSend: Cardinal;
    { Constructor TXServer }
    constructor Create();
    { Destructor TXServer }
    destructor Destroy(); override;
 
  end;
 
implementation
 
{ Serveur Execute }
procedure TXServer.IdTCPServerExecute(AContext: TIdContext);
begin
  with AContext.Connection.IOHandler do
  begin
    Sleep(1);
 
    if not InputBufferIsEmpty then
    begin
      DefStringEncoding := IndyTextEncoding_UTF8;
      XMessage(AContext, ReadLn);
    end;
  end;
end;
 
{ Déconnexion Client }
procedure TXServer.IdTCPServerDisconnect(AContext: TIdContext);
var
  XClient: TXClient;
begin
  XClient := TXClient(AContext.Data);
 
  if Assigned(XClient) then
  begin
    XClient.XState := TDisconnect;
    AContext.Data := nil;
    FreeAndNil(XClients[XClient.XId]);
  end;
end;
 
{ Message Privé }
procedure TXServer.SendPrivate(NickName, StrData: String);
var
  AContext: TList;
  XClient: TXClient;
  I: Integer;
begin
  AContext := IdTCPServer.Contexts.LockList;
 
  for I := 0 to AContext.Count - 1 do
  begin
    XClient := TXClient(TIdContext(AContext.Items[I]).Data);
 
    if (XClient.XNickName = NickName) and (Assigned(XClient)) and
      (XClient.State = TConnect) then
    begin
      TIdContext(AContext.Items[I]).Connection.IOHandler.WriteLn(StrData);
      Inc(CtpServerToClientSend); { +1 }
      Break;
    end;
  end;
 
  IdTCPServer.Contexts.UnlockList;
end;
 
{ Gestion des messages }
procedure TXServer.XMessage(AContext: TIdContext; StrData: String);
 
{ Connexion au serveur : @Bot5 }
  procedure ConnectXClient(StrData: String);
  var
    Id: Integer;
  begin
 
    Id := 1;
    while (Id <= MaxSlots) and Assigned(XClients[Id]) do
    begin
      Inc(Id);
    end;
 
    XClients[Id] := TXClient.Create(StrData, Id);
    AContext.Data := XClients[Id];
  end;
 
var
  Action: Char;
  IdBot, SendToBotNick, StrMessage: String;
begin
  Action := StrData[1];
  Delete(StrData, 1, 1);
 
  case Action of
    { Connexion au serveur : @Bot5 }
    '@':
      ConnectXClient(StrData);
 
    { Message privé : ~003Bot20,Salut ! }
    '~':
      begin
        IdBot := Copy(StrData, 0, 3);
        SendToBotNick := Copy(StrData, 4, Pos(',', StrData) - 4);
        StrMessage := Copy(StrData, Pos(',', StrData) + 1, Length(StrData));
        { Bot20~003,Salut ! }
        SendPrivate(SendToBotNick, '~' + IdBot + StrMessage);
      end;
  end;
end;
 
{ Déconnexion de tous les clients }
procedure TXServer.DisconnectAllXClient;
var
  AContext: TList;
  I: Integer;
begin
  AContext := IdTCPServer.Contexts.LockList;
 
  for I := 0 to AContext.Count - 1 do
  begin
    TIdContext(AContext.Items[I]).Connection.IOHandler.Close;
    TIdContext(AContext.Items[I]).Connection.Disconnect;
  end;
 
  IdTCPServer.Contexts.UnlockList;
end;
 
{ Constructor TXServer }
constructor TXServer.Create;
begin
  inherited Create;
 
  CtpServerToClientSend := 0;
 
  IdSchedulerOfThreadDefault := TIdSchedulerOfThreadDefault.Create(nil);
  IdSchedulerOfThreadDefault.ThreadPriority := tpHigher;
 
  IdTCPServer := TIdTCPServer.Create(nil);
  with IdTCPServer do
  begin
    Bindings.Clear;
    TIdStack.IncUsage;
    Bindings.Add.IP := GStack.LocalAddress; { IP Local }
    TIdStack.DecUsage;
    Bindings.Add.Port := DefaultTCPPort; { 49650 }
    TerminateWaitTime := 2500;
 
    Scheduler := IdSchedulerOfThreadDefault;
 
    OnExecute := IdTCPServerExecute;
    OnDisconnect := IdTCPServerDisconnect;
  end;
end;
 
{ Destructor TXServer }
destructor TXServer.Destroy();
begin
  DisconnectAllXClient;
 
  IdTCPServer.Contexts.Clear;
  IdTCPServer.Active := False;
 
  FreeAndNil(IdTCPServer);
  FreeAndNil(IdSchedulerOfThreadDefault);
 
  inherited Destroy;
end;
 
{ Constructor TXClient }
constructor TXClient.Create(NickName: String; IdClient: Byte);
begin
  inherited Create;
 
  XNickName := NickName;
  XId := IdClient;
  XState := TConnect;
end;
 
end.

Code Source : ServerBot.zip

Merci

**ShaiLeTroll** · 22/06/2018, 13h47

A la place du Sleep, il n'y a pas un WaitFor ? ah non il est pourri ce WaitFor *, j'utiliserais plus CheckForDataOnSource
Bien plus fiable et rapide, imagine que tu as plein de message qui arrive, tu attends à chaque itération 1 ms pour les traiter alors qu'avec CheckForDataOnSource tant que la file TCP contient des choses à lire pour ReadLn, cela rend la main tout de suite

ReadLn ? Tu envoie que du mode texte et avec des retours charriots ?
(*) Pourri ce WaitFor quoi que dans ton cas avec le ReadLn, tu peux faire un WaitFor du RetourCharriot
Si il ne trouve pas le retour charriot, ça boucle dans le vide (du moins par défaut jusqu'à ce qu'il récupère 16Ko)
C'est vrai que je préfère lire en binaire et gérer moi même le découpage des messages (le client peut envoyer plusieurs messages très vite et tu reçois d'un coup, il faut alors découper, si cela a excédé le tampon, faut même conserver le relicat pour le concaténer à l'itération suivante de lecture

Je n'ai pas mes codes de 2009 où j'ai utilisé TIdTCPServer, je ne l'ai jamais apprécié, dès que j'ai pu, je suis retourné en TServerSocket en mode blocking avec un thread par connexion
D'ailleurs, je ne traite JAMAIS le message dans la fonction de lecture
Je stocke le buffer dans une ThreadList
Un autre thread effectue le traitement, cela évite d'engorger le tampon TCP pendant que tu fais le relais
Et je pousse même le vice selon les cas à mettre aussi l'envoie dans un thread\FIFO pour ne pas engorger le thread de traitement (dans ton cas du simple parsage, dans le mien j'ai en plus de la DB)

Si tu es curieux : j'ai une version de mon TSLTRemoteMessenger qui tourne depuis 4 ans en PROD, pendant des mois en Service Windows ... sachant que le code existe depuis 2003 dans de plus ancienne version (supportant plus de 100000messages reçus par jour et bien 50000 envoyés, derrière c'est presque 500000 requêtes SQL en 8h)

**XeGregory** · 22/06/2018, 16h07

ReadLn ? Tu envoie que du mode texte et avec des retours charriots ?

Oui que du texte, ReadLn : ~003Bot20,Salut !, SendPrivate : Bot20~003,Salut !

J'ai tester d’augmenté le temps t'attente entre chaque envoie de message coté clients de 10 millisecondes à 250 millisecondes.
L'un comme l'autre le résultat est toujours le même, lorsque le serveur atteigne environ ~6000 messages traités, le serveur ne répond plus.

Test : Nombre de message envoyés : 6221, le serveur ne répond plus.

J'ai fait un teste en m’étant juste en commentaire la ligne "TIdContext(AContext.Items[I]).Connection.IOHandler.WriteLn(StrData);" de la procedure "SendPrivate".
Côté client je suis repassé à 1 message tous les 10 millisecondes, Le serveur encaisse les messages sans problème.

Test : Nombre de message envoyés : plus de 30000, (Avec un arrêt manuelle du serveur).

Serveur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
{ Serveur Execute }
procedure TXServer.IdTCPServerExecute(AContext: TIdContext);
begin
  with AContext.Connection.IOHandler do
  begin
    CheckForDataOnSource(10);
 
    if not InputBufferIsEmpty then
      XMessage(AContext, ReadLn);
  end;
end;
 
{ Connexion Client }
procedure TXServer.IdTCPServerConnect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;
 
{ Déconnexion Client }
procedure TXServer.IdTCPServerDisconnect(AContext: TIdContext);
var
  XClient: TXClient;
begin
  XClient := TXClient(AContext.Data);
 
  if Assigned(XClient) then
  begin
    XClient.XState := TDisconnect;
    AContext.Data := nil;
    FreeAndNil(XClients[XClient.XId]);
  end;
end;
 
{ Message Privé }
procedure TXServer.SendPrivate(NickName, StrData: String);
var
  AContext: TList;
  XClient: TXClient;
  I: Integer;
begin
  AContext := IdTCPServer.Contexts.LockList;
 
  for I := 0 to AContext.Count - 1 do
  begin
    XClient := TXClient(TIdContext(AContext.Items[I]).Data);
 
    if (XClient.XNickName = NickName) and (Assigned(XClient)) and
      (XClient.State = TConnect) then
    begin
      // TIdContext(AContext.Items[I]).Connection.IOHandler.WriteLn(StrData);
      Inc(CtpServerToClientSend); { +1 }
      Break;
    end;
  end;
 
  IdTCPServer.Contexts.UnlockList;
end;
 
{ Gestion des messages }
procedure TXServer.XMessage(AContext: TIdContext; StrData: String);
 
{ Connexion au serveur : @Bot5 }
  procedure ConnectXClient(StrData: String);
  var
    Id: Integer;
  begin
 
    Id := 1;
    while (Id <= MaxSlots) and Assigned(XClients[Id]) do
    begin
      Inc(Id);
    end;
 
    XClients[Id] := TXClient.Create(StrData, Id);
    AContext.Data := XClients[Id];
  end;
 
var
  Action: Char;
  IdBot, SendToBotNick, StrMessage: String;
begin
  Action := StrData[1];
  Delete(StrData, 1, 1);
 
  case Action of
    { Connexion au serveur : @Bot5 }
    '@':
      ConnectXClient(StrData);
 
    { Message privé : ~003Bot20,Salut ! }
    '~':
      begin
        IdBot := Copy(StrData, 0, 3);
        SendToBotNick := Copy(StrData, 4, Pos(',', StrData) - 4);
        StrMessage := Copy(StrData, Pos(',', StrData) + 1, Length(StrData));
        { Bot20~003,Salut ! }
        SendPrivate(SendToBotNick, '~' + IdBot + StrMessage);
      end;
  end;
end;

J'ai testé aussi de cette façon sans passer par la procédure (XMessage --> SendPrivate).

Test : Nombre de message envoyés : 6856, le serveur ne répond plus.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
{ Serveur Execute }
procedure TXServer.IdTCPServerExecute(AContext: TIdContext);
begin
  with AContext.Connection.IOHandler do
  begin
    CheckForDataOnSource(10);
 
    if not InputBufferIsEmpty then
    // XMessage(AContext, ReadLn);
    begin
      WriteLn(ReadLn);
      Inc(CtpServerToClientSend); { +1 }
    end;
  end;
end;

Ce que je ne comprends pas, c'est pourquoi sa plante à environ ~6000 messages traités, si le serveur était bancal, le plantage serais aléatoire

**XeGregory** · 22/06/2018, 20h36

Après quelques teste, je viens de m’apercevoir que plus la taille du message est importante moins le serveur encaisse les messages

Message : ******************...

Coté Client :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
{ RandomStrSend }
function TFServer.RandomStrSend: String;
var
  LenStr: Cardinal;
  StrSend: String;
begin
  LenStr := 200;
  StrSend := EmptyStr;
 
  while Length(StrSend) < LenStr do
    Insert('*', StrSend, 1);
  { Message : ************ }
  Result := StrSend;
end;

Test 1 : Taille du message : 50, Nombre de message envoyés : 11228
Test 2 : Taille du message : 100, Nombre de message envoyés : 5554
Test 3 : Taille du message : 150, Nombre de message envoyés : 3582
Test 4 : Taille du message : 200, Nombre de message envoyés : 2852

**Andnotor** · 23/06/2018, 00h30

Envoyé par XeGregory

J'ai fait un teste en m’étant juste en commentaire la ligne "TIdContext(AContext.Items[I]).Connection.IOHandler.WriteLn(StrData);" de la procedure "SendPrivate".
Côté client je suis repassé à 1 message tous les 10 millisecondes, Le serveur encaisse les messages sans problème.

C'est donc que AContext.Items[I] n'est plus valide (le client s'est déconnecté) ce qui génère une exception et puisque UnlockList n'est pas protégé par un bloc try..finally, c'est le deadlock sur le prochain LockList.

Ceci aussi n'est pas correct :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
while (Id <= MaxSlots) and Assigned(XClients[Id]) do
begin
  Inc(Id);
end;
 
XClients[Id] := TXClient.Create(StrData, Id);

Si MaxSlots sont déjà assignés, tu autorises tout de même un XClients[MaxSlot +1] => violation d'accès.

Une chaîne est à base 1, donc IdBot := Copy(StrData, 1, 3);

Surcharge TIdTCPServer Indy

Web & réseau Delphi

Discussions similaires

Partager

Partager