From 0b4a13d44480bd29aff8310e8ba7339426606946 Mon Sep 17 00:00:00 2001
From: Uladzimir Karpenka <i@vladimir.cc>
Date: Mon, 27 Apr 2026 22:01:12 +0300
Subject: [PATCH] Fix CAT TCP server Stop: eliminate up-to-5s hang on shutdown
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

PurgeLoop used Sleep(5000) — Stop had to wait up to 5 seconds for the
purge thread to wake before it could proceed. Fix: add TEvent FStopEvent;
Stop signals it before waiting on threads so PurgeLoop exits immediately.
Also moved client Disconnect calls before WaitFor so all sockets are
unblocked in parallel rather than sequentially.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
---
 CATTcp.pas | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

diff --git a/CATTcp.pas b/CATTcp.pas
index d95a8f9..dd4df03 100644
--- a/CATTcp.pas
+++ b/CATTcp.pas
@@ -75,6 +75,7 @@ type
     FRunning:      Boolean;
     FSendWelcome:  Boolean;
     FLastError:    string;
+    FStopEvent:    TEvent;
 
     procedure ServerLoop;
     procedure PurgeLoop;
@@ -291,6 +292,7 @@ begin
   FListenSock  := SOCK_INVALID;
   FClients     := TList.Create;
   FClientsLock := TCriticalSection.Create;
+  FStopEvent   := TEvent.Create(nil, True, False, '');
   FRunning     := False;
   FSendWelcome := True;
   FLastError   := '';
@@ -304,6 +306,7 @@ begin
   Stop;
   FClients.Free;
   FClientsLock.Free;
+  FStopEvent.Free;
   {$IFDEF MSWINDOWS}
   WSACleanup;
   {$ENDIF}
@@ -376,12 +379,23 @@ begin
   if not FRunning then Exit;
   FRunning := False;
 
+  // Будим PurgeLoop немедленно, чтобы он не ждал 5 секунд
+  FStopEvent.SetEvent;
+
+  // Закрываем listen socket — разблокирует fpAccept в ServerLoop
   if FListenSock <> SOCK_INVALID then begin
     SockShutdown(FListenSock);
     SockClose(FListenSock);
     FListenSock := SOCK_INVALID;
   end;
 
+  // Разрываем всех клиентов до ожидания потоков
+  FClientsLock.Acquire;
+  try
+    for i := 0 to FClients.Count-1 do
+      TCATTcpClientThread(FClients[i]).Disconnect;
+  finally FClientsLock.Release; end;
+
   if Assigned(FServerThread) then begin
     FServerThread.Terminate;
     FServerThread.WaitFor;
@@ -393,16 +407,18 @@ begin
     FreeAndNil(FPurgeThread);
   end;
 
+  // Теперь безопасно ждём завершения клиентских потоков и освобождаем
   FClientsLock.Acquire;
   try
     for i := 0 to FClients.Count-1 do begin
       cli := TCATTcpClientThread(FClients[i]);
-      cli.Disconnect;
       cli.WaitFor;
       cli.Free;
     end;
     FClients.Clear;
   finally FClientsLock.Release; end;
+
+  FStopEvent.ResetEvent;
 end;
 
 procedure TCATTcpServer.ServerLoop;
@@ -440,7 +456,7 @@ begin
   del := TList.Create;
   try
     while FRunning do begin
-      Sleep(5000);
+      if FStopEvent.WaitFor(5000) <> wrTimeout then Break;
       del.Clear;
       FClientsLock.Acquire;
       try