Fix CAT TCP server Stop: eliminate up-to-5s hang on shutdown

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>
This commit is contained in:
2026-04-27 22:01:12 +03:00
co-authored by Claude Sonnet 4.6
parent bcd045a1be
commit 0b4a13d444
+18 -2
View File
@@ -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