TWebsocketClient.MessagePump.Free Hangs

Summary

TWebsocketClient can hang indefinitely when used with TWSThreadMessagePump unless the program keeps the thread/message loop active briefly after sending, or an unrelated WriteLn is executed right before freeing the message pump. Without either workaround, shutdown gets stuck at "Disconnecting...".

This appears to be a timing/race issue in the disconnect/close-handshake path and/or message-pump thread lifecycle/teardown ordering.

System Information

• Operating system: Windows 10
• Processor architecture: x86-64
• Compiler version: Free Pascal Compiler version 3.3.1-19159-g6b1f77c267-dirty [2026/01/01] for x86_64

Steps to reproduce

1. Compile and run the sample program below.
2. Keep Demo.WaitForMessages(3); commented out.
3. Let the program exit normally (it frees Demo in the finally block).
4. Observe it prints "Disconnecting..." and then hangs indefinitely.

** note, you might have to try 2 or 3 times to reproduce the issue

Confirming workarounds

• Workaround A: Uncomment Demo.WaitForMessages(3); → disconnect completes reliably.
• Workaround B: Keep WaitForMessages commented out, but add a WriteLn(...) immediately before FClient.MessagePump.Free; → disconnect completes reliably.

Example Project

Single-file minimal repro: WebSocketDisconnectDemo.lpr (included below).

Connects to a public echo server: wss://ws.postman-echo.com/raw.

What is the current bug behavior?

• Shutdown hangs at Disconnecting... (no Disconnected!, no further output).
• Hang only occurs when we do not wait/pump briefly after sending.
• Hang disappears if:
  • we call Demo.WaitForMessages(3);, or
  • we add an unrelated WriteLn right before freeing the message pump.

What is the expected (correct) behavior?

FClient.MessagePump.Free should complete reliably during shutdown without requiring:

• an artificial wait loop (WaitForMessages), or
• unrelated console I/O (WriteLn) to influence thread scheduling/timing.

Relevant logs and/or screenshots

Repro code (WebSocketDisconnectDemo.lpr)

program WebSocketDisconnectDemo;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  heaptrc,  // Enable heap tracing for leak detection
  SysUtils,
  Classes,
  opensslsockets,
  fpwebsocketclient,
  fpwebsocket;

type
  TWebSocketDemo = class
  private
    FClient: TWebsocketClient;
    FConnected: Boolean;

    procedure HandleConnect(Sender: TObject);
    procedure HandleDisconnect(Sender: TObject);
    procedure HandleMessageReceived(Sender: TObject; const AMessage: TWSMessage);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Connect(const AHost: string; APort: Integer; const AResource: string);
    procedure Disconnect;
    procedure Send(const AMessage: string);
    procedure WaitForMessages(ASeconds: Integer);
  end;

{ TWebSocketDemo }

constructor TWebSocketDemo.Create;
var
  LMessagePump: TWSThreadMessagePump;
begin
  inherited Create;
  FConnected := False;

  // Create message pump for async message handling
  LMessagePump := TWSThreadMessagePump.Create(nil);
  LMessagePump.Interval := 50; // Check every 50ms

  // Create client
  FClient := TWebsocketClient.Create(nil);
  FClient.MessagePump := LMessagePump;
  FClient.ConnectTimeout := 10000;
  FClient.CheckTimeOut := 100;

  // Wire events
  FClient.OnConnect := @HandleConnect;
  FClient.OnDisconnect := @HandleDisconnect;
  FClient.OnMessageReceived := @HandleMessageReceived;
end;

destructor TWebSocketDemo.Destroy;
begin
  WriteLn('Destroying WebSocketDemo...');

  // Disconnect if still connected
  if FConnected then
    Disconnect;

  // Free message pump first
  if Assigned(FClient.MessagePump) then
  begin
    // Workaround B: adding a WriteLn here makes disconnect/freeing pump succeed:
    // WriteLn('  Freeing message pump...');
    FClient.MessagePump.Free;
  end;

  // Free client
  WriteLn('  Freeing client...');
  FClient.Free;

  WriteLn('  Done.');
  inherited;
end;

procedure TWebSocketDemo.HandleConnect(Sender: TObject);
begin
  FConnected := True;
  WriteLn('Connected!');
end;

procedure TWebSocketDemo.HandleDisconnect(Sender: TObject);
begin
  FConnected := False;
  WriteLn('Disconnected!');
end;

procedure TWebSocketDemo.HandleMessageReceived(Sender: TObject; const AMessage: TWSMessage);
begin
  if AMessage.IsText then
    WriteLn('Received: ', AMessage.AsString)
  else
    WriteLn('Received binary data: ', Length(AMessage.PayLoad), ' bytes');
end;

procedure TWebSocketDemo.Connect(const AHost: string; APort: Integer; const AResource: string);
begin
  WriteLn('Connecting to ', AHost, ':', APort, AResource);

  FClient.HostName := AHost;
  FClient.Port := APort;
  FClient.Resource := AResource;
  FClient.UseSSL := (APort = 443);

  // Start message pump
  if Assigned(FClient.MessagePump) then
    FClient.MessagePump.Execute;

  // Connect
  FClient.Connect;
end;

procedure TWebSocketDemo.Disconnect;
begin
  if not FClient.Active then
    Exit;

  WriteLn('Disconnecting...');

  // Stop message pump first
  if Assigned(FClient.MessagePump) then
  begin
    try
      FClient.MessagePump.Terminate;
    except
      // Ignore
    end;
  end;

  FClient.Disconnect;
end;

procedure TWebSocketDemo.WaitForMessages(ASeconds: Integer);
var
  I: Integer;
begin
  WriteLn('Waiting ', ASeconds, ' seconds for messages...');
  for I := 1 to ASeconds do
  begin
    Sleep(1000);
    Write('.');
  end;
  WriteLn;
end;

procedure TWebSocketDemo.Send(const AMessage: string);
begin
  WriteLn('Sending: ', AMessage);
  FClient.SendMessage(AMessage);
end;

var
  Demo: TWebSocketDemo;

begin
  WriteLn('=== WebSocket Disconnect Demo ===');
  WriteLn;

  Demo := TWebSocketDemo.Create;
  try
    try
      Demo.Connect('ws.postman-echo.com', 443, '/raw');
      Sleep(2000);
      Demo.Send('Hello from FPC WebSocket Disconnect Demo!');

      // Workaround A: uncommenting this allows the disconnect to complete
      // Demo.WaitForMessages(3);
    except
      on E: Exception do
        WriteLn('Connection error (expected if server unavailable): ', E.Message);
    end;
  finally
    Demo.Free;
  end;

  WriteLn;
  WriteLn('Demo complete.');
  WriteLn('Press Enter to exit.');
  ReadLn;
end.

Sample output (hang)

=== WebSocket Disconnect Demo ===

Connecting to ws.postman-echo.com:443/raw
Connected!
Sending: Hello from FPC WebSocket Disconnect Demo!
Destroying WebSocketDemo...
Disconnecting...