Recent

Author Topic: [Synapse]Multythreaded TCP Server example.  (Read 43110 times)

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: [Synapse]Multythreaded TCP Server example.
« Reply #15 on: February 17, 2016, 06:24:08 pm »
Hello,
I have implemented a version of this Multithreaded Server, and I am experimenting a problem in this procedure:

procedure TThreadManager.clearFinishedThreads;
var
   i: Integer;
begin
   for i := 0 to FThreadList.Count - 1 do
         begin
           if (TTCPThread(FThreadList) <> nil) then
           begin
             if (TTCPThread(FThreadList.items).isDone = TRUE) then
             begin
                 TTCPThread(FThreadList).WaitFor;
                 TTCPThread(FThreadList).Free;
             end
           end
         end
end;

It does seem that it is unable to properly find the Thread (finished) that needs to be freed. It loops on each pointer in the FthreadList but is unable to find the one that is done and thus it never terminates it.  As far I could understand, this doesn't trigger:

if (TTCPThread(FThreadList.items).isDone = TRUE)

I am unable to find out if this is supposed to work, but putting a breakpoint here never gets true for any thread.

That's the reason why the counter in the example never decrements, because the counter is a related to the number of items of the FThreadList (that never gets the relevant element removed).

Could you kindly tell me what is wrong?
Thanks in advance.

Giuseppe Marullo
1) Is the FThreadlist of type TTcpThread? I do not have synapse at this time but I doubt it. Stop casting when its not needed eg
Code: Pascal  [Select][+][-]
  1. if (FThreadList <> nil) then
2) Is the FthreadList.Items of type TTcpThread? Doubt it again, the common knowledge of the framework in general, is that items is either a list or an array type property which is not a object by it self. Consider your self lucky the app should have crashed. Use FThreadList.items ee
Code: Pascal  [Select][+][-]
  1. if TTCPThread(FThreadList.items[i]).isDone = TRUE then

3) You check on a single thread and them you go and free the complete list? how about change the loop's inner code to
Code: Pascal  [Select][+][-]
  1.     TTCPThread(FThreadList.items[i]).WaitFor;
  2.     TTCPThread(FThreadList.items[i]).Free;
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

rvk

  • Hero Member
  • *****
  • Posts: 4329
Re: [Synapse]Multythreaded TCP Server example.
« Reply #16 on: February 17, 2016, 06:31:10 pm »
@taazz, xardomain is doing all that.
But because the code isn't tagged with code, it isn't very clear (and [ i ] is filtered out as italic)
This is the code that's in the post:

Code: Pascal  [Select][+][-]
  1. procedure TThreadManager.clearFinishedThreads;
  2. var
  3.         i: Integer;
  4. begin
  5.         for i := 0 to FThreadList.Count - 1 do
  6.          begin
  7.            if (TTCPThread(FThreadList[i]) <> nil) then
  8.            begin
  9.              if (TTCPThread(FThreadList.items[i]).isDone = TRUE) then
  10.              begin
  11.                  TTCPThread(FThreadList[i]).WaitFor;
  12.                  TTCPThread(FThreadList[i]).Free;
  13.              end
  14.            end
  15.          end
  16. end;

The only thing I'm missing is setting the FThreadList[ i ] to nil when the thread is freed. Otherwise you end up doing this again when clearFinishedThreads is called again on a freed thread.
Code: Pascal  [Select][+][-]
  1. if (TTCPThread(FThreadList.items).isDone = TRUE) then
  2. begin
  3.   TTCPThread(FThreadList[i]).WaitFor;
  4.   TTCPThread(FThreadList[i]).Free;
  5.   FThreadList[i] := nil;
  6. end;
  7.  

Although using FThreadList.Items[ i ] would be clearer than using FThreadList[ i ], they should be the same.
« Last Edit: February 17, 2016, 06:40:37 pm by rvk »

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: [Synapse]Multythreaded TCP Server example.
« Reply #17 on: February 17, 2016, 06:50:52 pm »
@taazz, xardomain is doing all that.
But because the code isn't tagged with code, it isn't very clear (and [ i ] is filtered out as italic)
This is the code that's in the post:

Code: Pascal  [Select][+][-]
  1. procedure TThreadManager.clearFinishedThreads;
  2. var
  3.    i: Integer;
  4. begin
  5.    for i := 0 to FThreadList.Count - 1 do
  6.          begin
  7.            if (TTCPThread(FThreadList[i]) <> nil) then
  8.            begin
  9.              if (TTCPThread(FThreadList.items[i]).isDone = TRUE) then
  10.              begin
  11.                  TTCPThread(FThreadList[i]).WaitFor;
  12.                  TTCPThread(FThreadList[i]).Free;
  13.              end
  14.            end
  15.          end
  16. end;

The only thing I'm missing is setting the FThreadList[ i ] to nil when the thread is freed. Otherwise you end up doing this again when clearFinishedThreads is called again on a freed thread.
Code: Pascal  [Select][+][-]
  1. if (TTCPThread(FThreadList.items).isDone = TRUE) then
  2. begin
  3.   TTCPThread(FThreadList).WaitFor;
  4.   TTCPThread(FThreadList).Free;
  5.   FThreadList[i] := nil;
  6. end;
  7.  
thanks rvk, I got weird out with all this italics but I am too bored to think it over I guess ;) . Well from a quick look around the srv unit, there is no logic to define when the thread is done, unless there is some code that I missed that property will always be false and rightfully so, there is no standard that defines when a tcp process is done every protocol on top of tcp has its own "is done" logic. In this case the user has to write a TTcpThread descendant override the ProcessingData method and in there if the data have the done marker on them set the done_ protected variable to true, in a thread safe manner.
« Last Edit: February 17, 2016, 06:53:03 pm by taazz »
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

xardomain

  • New Member
  • *
  • Posts: 12
Re: [Synapse]Multythreaded TCP Server example.
« Reply #18 on: February 17, 2016, 11:47:51 pm »
Fist of all, sorry for the mess about italics.
I assume that the Thread (one of the several I have, tied to a TCP connection) will stop executing.
When the code runs, I assume that looping on the list would at certain point meet the element(i) of the list that In reality is a pointer to that Thread.
Now, why this construct will never be true for that element?

Code: Pascal  [Select][+][-]
  1. (TTCPThread(FThreadList.items[i]).isDone = TRUE)
  2.  

Is correct way to test if a Thread which is pointed by
Code: Pascal  [Select][+][-]
  1. FThreadList.Items[i]
should be freed?

Thanks in advance.

Giuseppe Marullo
« Last Edit: February 17, 2016, 11:50:47 pm by xardomain »

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: [Synapse]Multythreaded TCP Server example.
« Reply #19 on: February 18, 2016, 02:55:56 am »
For the sake of clarity I'm going to refer to the client side threads as consumers and to the server side threads as listeners.

Fist of all, sorry for the mess about italics.
I assume that the Thread (one of the several I have, tied to a TCP connection) will stop executing.

So how does a consumer knows that it has read all the data the listener provides and can now be terminated? Is the listener based on a specific protocol that defines a end of transmission marker?Is it a non stopping stream of data (internet radion for example) that might never end unless the consumer terminates the connection? Do you have any information on the subject?

When the code runs, I assume that looping on the list would at certain point meet the element(i) of the list that In reality is a pointer to that Thread.
Now, why this construct will never be true for that element?
In the unit provided here there is a framework that manages data transfer through tcp for you but has no knowledge of the interpretation of that data. You need to code in that.
Code: Pascal  [Select][+][-]
  1. (TTCPThread(FThreadList.items[i]).isDone = TRUE)
  2.  

Is correct way to test if a Thread which is pointed by
Code: Pascal  [Select][+][-]
  1. FThreadList.Items[i]
should be freed?
Yes and no. Yes its the correct property to use. No you do not check it your self, it is already part of the loop, you need to set to it to true to allow the consumer to exit its loop. If you have already set the free on terminate property to true also, it should automatically free the consumer for you when you set the protected field "Done_" to true your self.
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

xardomain

  • New Member
  • *
  • Posts: 12
Re: [Synapse]Multythreaded TCP Server example.
« Reply #20 on: February 18, 2016, 12:01:20 pm »
Thanks Taazz for your time.

Keep in mind that my complete program is different, but it is based on this example. So we could talk specifically about this example that never "frees" any element from the ThreadList.

> Yes its the correct property to use.
Ok, but this test never works. Why? How could I detect that I need to free the corresponding thread that is ended?

>No you do not check it your self, it is already part of the loop, you need to set to it to true to allow the >consumer to exit its loop.
Ok, I think I mostly understand this, but I would like to free the Thread from this loop, and keep the FreeOnTerminate to false.

If I connect two telnet sessions on it, it keeps updating the number of threads and says it has two.

If I disconnect one, and then reconnect another one, it keeps saying I have three, not two.

>If you have already set the free on terminate property to true also, it should automatically free the >consumer for you when you set the protected field "Done_" to true your self.
I tried also this, I don't need to perform anything special after the thread is finished but I would rather do outside and explicitly, and BTW it didn't work either, this cleaning loop fails to detect that the Thread could be freed (or it has already freed itself) and thus the list never gets the chance to lower the number of elements.

At the moment, there is not the part that deletes the element in the list, but it doesn't matter because the condition is never verified, either if the Thread is freed before or not.

If you could be so kind to test the example for yourself, it would be pretty clear that the number never decrements.

Thanks in advance.

Giuseppe Marullo

rvk

  • Hero Member
  • *****
  • Posts: 4329
Re: [Synapse]Multythreaded TCP Server example.
« Reply #21 on: February 18, 2016, 12:35:08 pm »
Keep in mind that my complete program is different, but it is based on this example. So we could talk specifically about this example that never "frees" any element from the ThreadList.
Ok, so we established that this example never frees any elements.

Quote
Ok, but this test never works. Why? How could I detect that I need to free the corresponding thread that is ended?
Like taazz already explained... you should build in tests to set the _done when you determine the connection is (or can be) ended. As it stands now the thread doesn't even check the "normal" TThread.Terminated in a while loop in TThread.Execute. It only checks for isDone. So if you want to terminate the thread from the outside with TThread.Terminate you also need to implement the check for TThread.Terminated (which is not in the example).

Quote
Ok, I think I mostly understand this, but I would like to free the Thread from this loop, and keep the FreeOnTerminate to false.
You have much bigger problems than the FreeOnTerminate. As long as the thread/connection doesn't terminate it all doesn't matter. Once you fixed that you could keep FreeOnTerminate on false and call the clearFinishedThreads. Actually, because the threads are in a list you want to clean them up yourself because otherwise you can't check on isDone because the thread might already be finished and freed.

But there is another problem with the example. When you fix the isDone the clearFinishedThreads will free the thread but it will not remove the thread-pointer from the TList. It doesn't even set the pointer to nil. So at least the FThreadList[ i ] := nil; should be added but even then there will be an "empty" element in the TList. If you really want to remove it from the TList you need to delete the TList.Item[ i ]. (If you do so remember to do "for i := FThreadList.Count - 1 downto 0 do" otherwise the indexes of the TList gets screwed up.)

Quote
If I connect two telnet sessions on it, it keeps updating the number of threads and says it has two.
If I disconnect one, and then reconnect another one, it keeps saying I have three, not two.
That's because the TList elements (TTCPThread) are never removed from the TThreadManager. They are just freed (and not even set to nil what I consider a bug).

Quote
>If you have already set the free on terminate property to true also, it should automatically free the >consumer for you when you set the protected field "Done_" to true your self.
I tried also this, I don't need to perform anything special after the thread is finished but I would rather do outside and explicitly, and BTW it didn't work either, this cleaning loop fails to detect that the Thread could be freed (or it has already freed itself) and thus the list never gets the chance to lower the number of elements.

Quote
At the moment, there is not the part that deletes the element in the list, but it doesn't matter because the condition is never verified, either if the Thread is freed before or not.
It was already said you needed to build in this verification yourself.

Quote
If you could be so kind to test the example for yourself, it would be pretty clear that the number never decrements.
Why test this example if we've already established that the threads are not removed from the list.

If you want us to help with a more complete example where you also build in the verification of when the thread may end and setting of the _done you might want to post that code. Using this example for further discussion seems kinda pointless because we've already established the problems with it.

zgabrovski

  • New Member
  • *
  • Posts: 18
Re: [Synapse]Multythreaded TCP Server example.
« Reply #22 on: May 30, 2017, 06:20:56 pm »
Here id the code, that correct handle 'ThreadsCount':

Code: Pascal  [Select][+][-]
  1. procedure TThreadManager.clearFinishedThreads;
  2. var
  3.         i: Integer;
  4. begin
  5.         for i := 0 to FThreadList.Count - 1 do begin
  6.     if (TTCPThread(FThreadList[i]) <> nil) and TTCPThread(FThreadList[i]).isDone() then
  7.        begin
  8.          TTCPThread(FThreadList[i]).WaitFor;
  9.          TTCPThread(FThreadList[i]).Free;
  10.          FThreadList[i] := nil;
  11.        end;
  12.  
  13.     end;
  14.  
  15. i := 0;
  16. while i < FThreadList.Count do begin
  17.   if FThreadList[ i ] = nil then
  18.     FThreadList.Delete( i )
  19.   else
  20.     inc( i );
  21.   end;
  22.  
  23. end;

Ericktux

  • Full Member
  • ***
  • Posts: 208
Re: [Synapse]Multythreaded TCP Server example.
« Reply #23 on: March 05, 2018, 03:28:44 am »
Thanks for sharing friends, here I made a change for whoever serves.

Server:
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes,
  9.   SysUtils,
  10.   LResources,
  11.   Forms,
  12.   Dialogs,
  13.   StdCtrls,
  14.   ExtCtrls,
  15.   Graphics,
  16.   nxNetwork;  // add this unit
  17.  
  18. // All communication can be masked with key.
  19. // If client doesn't have same key as server he will be
  20. // immediately disconnected.
  21. const Key = 'test';
  22.  
  23. type
  24.  
  25.   { TForm1 }
  26.  
  27.   TForm1 = class(TForm)
  28.     Button1: TButton;
  29.     Button2: TButton;
  30.     Label1: TLabel;
  31.     Memo1: TMemo;
  32.     procedure Button1Click(Sender: TObject);
  33.     procedure Button2Click(Sender: TObject);
  34.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  35.     procedure FormCreate(Sender: TObject);
  36.   private
  37.     // Abstract base classes can be created as TCP or UDP
  38.     //client: TClient;
  39.     server: TServer;
  40.     procedure ServerEvent(sender: TConnection; event: TConnectionEvent; ID: integer);
  41.     procedure ServerData(sender: TConnection; data: PByte; size,ID: integer);
  42.  
  43.   public
  44.     { public declarations }
  45.   end;
  46.  
  47. var
  48.   Form1: TForm1;
  49.  
  50. implementation
  51.  
  52. {$R *.lfm}
  53.  
  54. { TForm1 }
  55.  
  56. procedure TForm1.ServerData(sender: TConnection; data: PByte; size,ID: integer);
  57. var s: string;
  58. begin
  59.   if server=nil then exit;
  60.   setlength(s,size);
  61.   move(data[0],s[1],size);
  62.   memo1.Lines.Add(format('Client(%d)> [%s]',[ID,s]));
  63.   //ShowMessage('hi');
  64. end;
  65.  
  66. procedure TForm1.ServerEvent(sender: TConnection; event: TConnectionEvent; ID: integer);
  67. begin
  68.   if server=nil then exit;
  69.   if event=ceError then
  70.     memo1.Lines.Add(format('<#%d Error(%d): %s>',
  71.       [ID,server.LastError,server.LastErrorMsg]))
  72.   else
  73.     memo1.Lines.Add(format('<#%d: %s>',
  74.       [ID,server.EventToStr(event)]));
  75. end;
  76.  
  77. procedure TForm1.FormCreate(Sender: TObject);
  78. begin
  79.   server:=TTCPServer.CreateTCPServer('5400');
  80.   server.onEvent:=@ServerEvent; server.onData:=@ServerData;
  81.   server.Mask:=Key;
  82.   //server.Connect;
  83. end;
  84.  
  85. procedure TForm1.Button1Click(Sender: TObject);
  86. var s: string;
  87. begin
  88.   if not server.Opened then exit;
  89.   s:='test';
  90.   memo1.Lines.Add(s);
  91.   TTCPServer(server).SendString(-1,s);
  92. end;
  93.  
  94. procedure TForm1.Button2Click(Sender: TObject);
  95. begin
  96.   server.Connect;
  97. end;
  98.  
  99. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  100. begin
  101.   if server<>nil then server.Free;
  102.   server:=nil;
  103.  
  104.   while ServerThreads+ClientThreads>0 do begin
  105.     application.ProcessMessages;
  106.     sleep(10);
  107.   end;
  108. end;
  109.  
  110. end.

Client:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes,
  9.   SysUtils,
  10.   LResources,
  11.   Forms,
  12.   Dialogs,
  13.   StdCtrls,
  14.   ExtCtrls,
  15.   Graphics,
  16.   nxNetwork;  // add this unit
  17.  
  18. // All communication can be masked with key.
  19. // If client doesn't have same key as server he will be
  20. // immediately disconnected.
  21. const Key = 'test';
  22.  
  23. type
  24.  
  25.   { TForm1 }
  26.  
  27.   TForm1 = class(TForm)
  28.     Button1: TButton;
  29.     Button2: TButton;
  30.     Label1: TLabel;
  31.     Memo2: TMemo;
  32.     procedure Button1Click(Sender: TObject);
  33.     procedure Button2Click(Sender: TObject);
  34.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  35.     procedure FormCreate(Sender: TObject);
  36.   private
  37.     // Abstract base classes can be created as TCP or UDP
  38.     client: TClient;
  39.     procedure ClientEvent(sender: TConnection; event: TConnectionEvent; ID: integer);
  40.     procedure ClientData(sender: TConnection; data: PByte; size,ID: integer);
  41.   public
  42.     { public declarations }
  43.   end;
  44.  
  45. var
  46.   Form1: TForm1;
  47.  
  48. implementation
  49.  
  50. {$R *.lfm}
  51.  
  52. { TForm1 }
  53.  
  54. procedure TForm1.ClientData(sender: TConnection; data: PByte; size,ID: integer);
  55. var s: string;
  56. begin
  57.   if client=nil then exit;
  58.   setlength(s,size);
  59.   move(data[0],s[1],size);
  60.   Memo2.Lines.Add(format('Server> [%s]',[s]));
  61. end;
  62.  
  63. procedure TForm1.ClientEvent(sender: TConnection; event: TConnectionEvent; ID: integer);
  64. begin
  65.   if client=nil then exit;
  66.   if event=ceError then
  67.     Memo2.Lines.Add(format('<Error(%d): %s>',[client.LastError,client.LastErrorMsg]))
  68.   else
  69.     Memo2.Lines.Add(format('<%s>',[client.EventToStr(event)]));
  70. end;
  71.  
  72. procedure TForm1.FormCreate(Sender: TObject);
  73. begin
  74.   client:=TClient.CreateTCPClient('127.0.0.1','5400');
  75.   client.onEvent:=@ClientEvent; client.onData:=@ClientData;
  76.   client.Mask:=Key;
  77.   {client.Host:='127.0.0.1';
  78.   client.Connect;}
  79. end;
  80.  
  81. procedure TForm1.Button1Click(Sender: TObject);
  82. var s: string;
  83. begin
  84.  
  85.   if not client.Opened then exit;
  86.   s:='test';
  87.   Memo2.Lines.Add(s);
  88.   client.SendString(s);
  89. end;
  90.  
  91. procedure TForm1.Button2Click(Sender: TObject);
  92. begin
  93.   client.Host:='127.0.0.1';
  94.   client.Connect;
  95. end;
  96.  
  97. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  98. begin
  99.   if client<>nil then client.Free;
  100.   client:=nil;
  101.  
  102.   while ServerThreads+ClientThreads>0 do begin
  103.     application.ProcessMessages;
  104.     sleep(10);
  105.   end;
  106. end;
  107.  
  108. end.

NOTE:
Project > options project > parsing
Disable "Use Ansistrings (-sh, {$H+})"


thank you very much to the author of the code
« Last Edit: March 05, 2018, 03:30:39 am by Ericktux »

rvk

  • Hero Member
  • *****
  • Posts: 4329
Re: [Synapse]Multythreaded TCP Server example.
« Reply #24 on: March 05, 2018, 11:08:08 am »
NOTE:
Project > options project > parsing
Disable "Use Ansistrings (-sh, {$H+})"
Is that really necessary?
In both source-codes you enable the AnsiString again with {$H+} at the top, so disabling it in Option doesn't do much. It's still overridden by the {$H+}.

But for the code it really doesn't matter, because although {$H+} switches to Ansistring, an Ansistring is 1-based. So the first character is on S[1] which is the same as for ShortStrings (which is why the code still works).

Thaddy

  • Hero Member
  • *****
  • Posts: 10524
Re: [Synapse]Multythreaded TCP Server example.
« Reply #25 on: March 05, 2018, 11:15:49 am »
Indeed... Only difference is that a real shortstring is not reference counted and therefor more safe to use in a thread... Which isn't used in the example code.

Steph

  • Newbie
  • Posts: 2
Re: [Synapse]Multythreaded TCP Server example.
« Reply #26 on: January 22, 2020, 03:43:42 pm »
Hello,
Just back with Pascal after a very long time without any programming.
I try to test your very interesting examples of TCP communication but I get a"Acces Violation" message
as I start to connect the server or the client app.
Any idea ?  My OS is Windows 7 Pro - 32
Thank you

howardpc

  • Hero Member
  • *****
  • Posts: 3553
Re: [Synapse]Multythreaded TCP Server example.
« Reply #27 on: January 22, 2020, 03:57:09 pm »
Without a compilable example of your code that gives rise to the error it is not possible to do more than guess.

Steph

  • Newbie
  • Posts: 2
Re: [Synapse]Multythreaded TCP Server example.
« Reply #28 on: January 22, 2020, 07:26:00 pm »
Yes of course. This is the code Ericktux posted on 03/05/2018.
I just changed the "Key" constant to make some tests with a client app.
I tried some other appsand  I don't have any problems so I really don't undersatnd what happens.
Thank you

MorbidFractal

  • Jr. Member
  • **
  • Posts: 97
Re: [Synapse]Multythreaded TCP Server example.
« Reply #29 on: June 29, 2020, 10:17:12 pm »
Synapse uses blocking sockets. Once you have created one it will not die or be killed unless it has processed a requested response until some sort of hardcoded timeout in the order of 900 seconds has expired. The number 900 is in the source but the problem lies outside of it.

 

TinyPortal © 2005-2018