Can't reconnect to a socket lazarus / 38-Networking and Web Programming ---------------------------------------------------------------------- geraldholdsworth · 2023-10-24 14:51 Hi all, With lots of help from the kind people on here, I've written the attached class. Works well...except when I have a client that is connected and the application severs the connection. It then can't reconnect. I.e., I have start and stop buttons - the start button creates the server class to listen for incoming connections and the stop button terminates and free's it. If I click stop, then start again it won't reconnect (presumably as a socket is still open somewhere). It's fine if the client does the terminating, but not the server. Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit TCPServer; {$MODE objfpc}{$H+}{$M+} interface uses  Classes,BlckSock,S ynSock,LCLIntf,LCLType,SysUtils,Sockets; const datetimeformat='dd/mm/y yyy hh:nn:ss.zz'; //Date and Time format to use DefaultPort   = 4100;               //Default port to listen on function GetMyIPAddr: String; //Gets the local IP address type  TClient = record //To return a client list   IP,Host: String;  end;   TClientList = array of TClient; //The client list definition   TTCPServer = class(TThread) //Server thread definition  type   TTCPClient = class(TThread) //Client thread definition - a sub class   private    FSocket       : TTCPBlockSocket;    FSockNum      : TSocket;    FLogTime,    FLog        : TStringList;    FCS           : TCriticalSection;    FOwner      : TTCPServer;    FCtrlChrs     : Boolean;    FResponse,    FSubResponse  : String;    procedure AddToLog(Output: String);   public    Constructor Create (HSock: TSocket);    Destructor Destroy; override;    procedure Execute; override;   published    function Fetch(out Time,Msg: String): Boolean;    property ControlChars  : Boolean                     write FCtrlChrs;    property Owner       : TTCPServer                  write FOwner;    property Socket        : TTCPBlockSocket read FSocket;    property FirstResponse : String                    write FResponse;    property SubseResponse : String                    write FSubResponse;   end;  private   FPort       : LongInt;   FSocket       : TTCPBlockSocket;   FClients      : array of TTCPClient;   FCtrlChrs     : Boolean;   FResponse,   FSubResponse  : String;   procedure AddClient(ClientSocket: TSocket);   function GetNumberOfClients: Integer;   function GetClientList: TClientList;  public   Constructor Create;   Destructor Destroy; override;   procedure Execute; override;  published   function Fetch(out Time,Host,Msg: String): Boolean;   procedure RemoveClient(Client: TTCPClient);   property ClientCount  : Integer     read GetNumberOfClients;   property ClientList   : TClientList read GetClientList;   property ControlChars : Boolean     read FCtrlChrs    write FCtrlChrs;   property Port         : LongInt     read FPort      write FPort;   property FirstResponse: String      read FResponse  write FResponse;   property SubseResponse: String      read FSubResponse write FSubResponse;   property Terminated;  end; implemen tation {-------------------------------------------------------------- -----------------Gets the local IP address - This is not part of the c lass------------------------------------------------------------------ -------------}function GetMyIPAddr: String; procedure GetIP(var buf: array of Char); //I didn't write this const  CN_GDNS_ADDR='127.0.0.1';  CN_GDNS_PORT=53; var  S       : String;  Sock    : LongInt;  HostAddr: TSockAddr;  L       : Integer;  IPAddr  : TInetSockAddr; begin  Sock:=fpSocket(AF_INET,SOCK_DGRAM,0);  Assert(Sock<>-1);  IPAddr.Sin_family     :=AF_INET;  IPAddr.Sin_port     :=HtoNS(CN_GDNS_PORT);  IPAddr.Sin_addr.s_addr:=StrToHostAddr(CN_GDNS_ADDR).s_addr;  if fpConnect(Sock,@IPAddr,SizeOf(IPAddr))=0 then  begin   try    L:=SizeOf(HostAddr);    if fpGetSockName(Sock,@HostAddr,@l)=0 then    begin     S:=NetAddrToStr(HostAddr.sin_addr);     StrPCopy(PChar(buf),S);    end;    finally    end;  end; end;var Index: Integer; IP   : String;begin //Set up the buffer IP:='000.000.000.000'; //Get the IP address into this buffer GetIP(IP[1]); //Initialise the return variable Result:=''; //Initialise the counter Index:=1; //Remove any control characters while(Index<=Length(IP))and(Ord(IP[Index])>31)and(O rd(IP[Index])<127)do begin  Result:=Result+IP[Index];//Add valid characters to the return variable  inc(Index); //Next character end;end; { TTCPServer } {----------------------------------- --------------------------------------------Creates the overall thread ---------------------------------------------------------------------- ---------}constructor TTCPServer.Create;begin inherited Create(True); //Create, but don't start, the thread //Create the socket FSocket:=TTCPBlockSocket.Create; //Initilise the client list SetLength(FClients,0); //Defaults FPort       :=DefaultPort; FCtrlChrs   :=False; FResponse   :='Hello!'; FSubRespon se:='OK';end; {------------------------------------------------------- ------------------------Destroys the thread--------------------------- ----------------------------------------------------}destructor TTCPServer.Destroy;begin //Terminate any remaning clients while Length(FClients)>0 do FClients[0].Terminate; //Free up the socket if FSocket<>nil then FSocket.Free; inherited Destroy;end; {-------------- -----------------------------------------------------------------Runs when the thread starts------------------------------------------------ -------------------------------}procedure TTCPServer.Execute;begin //Create the socket FSocket.CreateSocket; FSocket.SetLinger(True,10000); //Timeout 10 secs //No specific IP address, as we're just listening FSocket.Bind('0.0.0.0',IntToStr(FPort)); FSocket.Listen; //Start listening repeat  if not Terminated then   if FSocket.CanRead(1000) then //Check if we can read (timeout is 1sec)  AddClient(FSocket.Accept); //Something there? Create a client and start chatting until(Terminated)or(FSocket.LastError<>0); //Until an error or we are closed if Terminated then FSocket.CloseSocket; FSocket .Free; FSocket:=nil;end; {-------------------------------------------- -----------------------------------Create and add a client thread to the list-------------------------------------------------------------- -----------------}procedure TTCPServer.AddClient(ClientSocket: TSocket);var L     : Integer; Client: TTCPClient;begin //Create the client thread, but do not start Client                :=TTCPClient.Create(ClientSocket); Client.Owner          :=Self; Client.FirstResponse  :=FResponse; Client.SubseResponse  :=FSubResponse; Client.FreeOnTerminate:=True; //So it will get freed up when we stop it //Add to the end of the client list L:=Length(FClients); SetLength(FClients,L+1); FClients[L]         :=Client; //Start it FClients[L].Start;end; {----------------------- --------------------------------------------------------Remove a client from the list (this is called by the client, not the server)--- ---------------------------------------------------------------------- ------}procedure TTCPServer.RemoveClient(Client: TTCPClient);var Cntr, Index: Integer;begin Index:=0; //Are there any to remove? if Length(FClients)>0 then begin  //Find the client we want to remove  while(IndexClient)do inc(Index);  if Index0 then begin  Index:=0;  //Go through each client and find the first with a message  while(Index0 then  //Add them to the list  for Index:=0 to Length(FClients)-1 do  begin   //Both IP address and port   Result[Index].IP  :=FClients[Index].Socket.GetRemoteSinIP;   Result[I ndex].Host:=IntToStr(FClients[Index].Socket.GetRemoteSinPort);  end;end; { TTCPServer.TTCPClient } {---------------------------------- ---------------------------------------------Create the client thread- ---------------------------------------------------------------------- --------}constructor TTCPServer.TTCPClient.Create(HSock: TSocket);begin inherited Create(True); //Create but do not start //Make a note of the socket number FSockNum:=HSock; //Setup the critical section InitializeCriticalSection(FCS); //Create the two logs - one for the messages and one for the times FLog:=TStringList.Create; FLogTime:=TStringList.Create; //So the resource is freed when terminated FreeOnTerminate:=True; //Defaults FCtrlChrs   :=False; FResponse   :='Hello!'; FSubResponse:='OK';end; {------------ -------------------------------------------------------------------Fre es the resource------------------------------------------------------- ------------------------}destructor TTCPServer.TTCPClient.Destroy;begin if FSocket<>nil then FSocket.Free; //Remove the client from the server's list FOwner.RemoveClient(Self); //Close down the critial section Delet eCriticalSection(FCS); FLog.Free; FLogTime.Free; inherited Destroy;end ; {------------------------------------------------------------------- ------------Runs when started----------------------------------------- --------------------------------------}procedure TTCPServer.TTCPClient.Execute;var Msg: String; Rsp: Boolean;begin //Create the connection FSocket:=TTCPBlockSocket.Create; try  //Set the socket number to the one talking to us  FSocket.Socket:=FSockNum;  FSocket.GetSins;  //Report the connection  AddToLog('Connected');  //Send an initial response  FSocket.SendString(FResponse);  //Make a note that this is the initial response  Rsp:=True;  repeat   //Make sure we're still running   if not Terminated then   begin    //Get the message    Msg:=FSocket.RecvPacket(1000); //Timeout is 1 sec    //Any errors?    if FSocket.LastError=0 then    begin     //If we haven't send a message, then send one     if not Rsp then begin      FSocket.SendString(FSubResponse);      //and make a note of it so we don't send another response      Rsp:=False;     end;     //Add the time and message to the log     AddToLog(Msg);    end;   end;   //Until we are closed or there is an error  until(Terminated)or((FSoc ket.LastError<>0)and(FSocket.LastError<>60));  if Terminated then FSocket.CloseSocket;  //Report the disconnection  if FSocket.LastError=0 then AddToLog('Disconnected')  else AddToLog(FSocket.LastErrorDesc); finally  //Close the connection  FSocket.Free;  FSocket:=nil; end;end; {------------------------------- ------------------------------------------------Adds the time and message to the log---------------------------------------------------- ---------------------------}procedure TTCPServer.TTCPClient.AddToLog(Output: String);var I        : Integer; Temp     : String;begin if Length(Output)>0 then begin  //Remove any control characters  if not FCtrlChrs then  begin   Temp:=Output;   Output:='';   for I:=1 to Length(Temp) do    if(ord(Temp[I])>31)and(ord(Temp[I])<127)then Output:=Output+Temp[I];  end;  //Add to the main log  EnterCriticalSection(FCS); //So things don't get corrupted  try   //Add the message   FLog.Add(Output);   //And the time   FLogTime.Add(FormatDateTime(datetimeformat,Now));  finally   //Finish up   LeaveCriticalSection(FCS);  end; end;end; {--- ---------------------------------------------------------------------- ------Fetch the first message from the stack-------------------------- -----------------------------------------------------}function TTCPServer.TTCPClient.Fetch(out Time,Msg: String): Boolean;begin Result:=False; EnterCriticalSection(FCS); try  if FLog.Count>0 then  begin   //Retreive   Msg :=FLog[0];   Time:=FLogTime[0];   //Then remove   FLog.Delete(0);   FLogTime.Delete(0);   //Return a positive result   Result:=True;  end; finally  LeaveCriticalSection(FCS); end;end; end.And the start and stop buttons: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i {---------- ---------------------------------------------------------------------S tart logging - button and menu item----------------------------------- --------------------------------------------}procedure TMainForm.btnStartClick(Sender: TObject);begin //Enable/disable controls btnStop.Enabled      :=True; btnStart.Enabled     :=False; btnConfig.Enabled    :=False; menuStop.Enabled     :=btnStop.Enabled; menuStart.Enabled    :=btnStart.Enabled; menuConfig ure.Enabled:=btnConfig.Enabled; Log.ColumnClickSorts :=False; //Set the last active flag LastActive:=True; //And save to the registry SaveRegistry; //Shut down the autostart timer AutoStart.Enabled:=False; //Add an entry to the display log only WriteToLog('Log Started',logDispOnly); //And start up the timer to refresh the log RefreshLog.Enabled:=True; //Open the log if OpenLog then begin  //Create the TCP server thread  FServer:=TTCPServer.Create;  FServer.FirstResponse:='(c)Mediascape Ltd 2023';  //Set the port number  FServer.Port:=FPort;  //Start the Thread  FServer.Start; end else begin  WriteToLog('Error opening log',logDispOnly);  btnStopClick(Sender); end;end; {------------------ -------------------------------------------------------------Stop logging - button and menu item---------------------------------------- ---------------------------------------}procedure TMainForm.btnStopClick(Sender: TObject);begin //Disable the refresh log timer RefreshLog.Enabled:=False; //Disable the stop controls btnStop.Enabled :=False; menuStop.Enabled:=btnStop.Enabled; //Terminate the thread FSe rver.Terminate; FServer.WaitFor; FServer.Free; FServer:=nil; //Close the log CloseLog; //Enable the start controls btnStart.Enabled     :=True; btnConfig.Enabled    :=True; menuStart.Enabled    :=btnStart.E nabled; menuConfigure.Enabled:=btnConfig.Enabled; Log.ColumnClickSorts :=True; //Set the last active flag LastActive:=False; //And save to the registry SaveRegistry; //Add an entry to the display log only WriteToLog('Log Stopped',logDispOnly);end; ---------------------------------------------------------------------- geraldholdsworth · 2023-10-24 16:13 OK, it would appear I need to give it some time for the client to close the socket. This, of course, leads to my next question...how do I tell if said socket has been closed before attempting to reopen it? ---------------------------------------------------------------------- geraldholdsworth · 2023-10-25 12:30 This appears to work - it's basically testing to see if the port is open, and if not close and try again. Repeating until it does. First, new function: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i {---------- ---------------------------------------------------------------------C hecks to see if the port is available--------------------------------- ----------------------------------------------}function TTCPServer.IsPortOpen: Boolean;var LServer: TTCPBlockSocket;begin LSer ver:=TTCPBlockSocket.Create; LServer.Connect('127.0.0.1',IntToStr(FPor t)); Result:=LServer.LastError=0; LServer.Free;end;This just tries to open on the same port but using the loopback address. Then, change the Execute function to: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i {---------- ---------------------------------------------------------------------R uns when the thread starts-------------------------------------------- -----------------------------------}procedure TTCPServer.Execute;begin //We'll make sure that the port is open while(not IsPortOpen)and(not Terminated)do begin  //Create the socket  FSocket.CreateSocket;  FSocket.SetLinger(True,10000); //Timeout 10 secs  //No specific IP address, as we're just listening  FSocket.Bind('0.0.0.0',IntToStr(FPort));  //Start listening  FSocket.Listen;  //Is the port open?  if not IsPortOpen then  begin   //If not, close it and try again   FSocket.Free;   FSocket:=TTCPBlockSocket.Create;  end; end; //Start listening repeat  if not Terminated then   if FSocket.CanRead(1000) then //Check if we can read (timeout is 1sec)    AddClient(FSocket.Accept); //Something there? Create a client and start chatting until(Terminated)or(FSocket.LastError<>0); //Until an error or we are closed //Free up the socket FSocket.Free; FSocket:=nil; //Indicates that we have freed it upend;It would be nice to get some feedback from the class - I'll work on this. ---------------------------------------------------------------------- MarkMLl · 2023-10-25 13:15 I had a lot of that from LNet, which contributed to my decision to write my own Telnet classes... which of course suffered from a similar problem but were much easier to debug. See https://github.com/MarkMLl/telnetsrv/blob/main/telnetserver.pas roughly line 856 Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i (* If the program terminates itself as the result of a received command, we     *)(* need to make sure that the TCP stack cleans things up promptly. Treat a      *)(* failure here as an irritant which might result in a problem if the program   *)(* is restarted within (in the case of Linux 6.0) a minute, but not as an error *)(* which merits possibly- confusing output.                                      *)     sz := 1;    if fpSetSockOpt(fSocket, SOL_SOCKET, SO_REUSEADDR, @sz, SizeOf(sz)) < 0 then begin      sz := SocketError;  //    WriteLn(StdErr, 'SetSockopt error ' + IntToStr(SocketError) + ': ' + StrError(SocketError))    end;  However it would also be worth exploring whether fpListen()'s backlog parameter etc. has the same effect. MarkMLl