Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Catalog · How the catalog works
Anything · Lazarus or Delphi
Random projectRandom project

horse-WS

Middleware for WS in HORSE

View on GitHub

Member rating

No ratings yet.

Sign in to rate this project.

README

Horse.WS

WebSocket middleware for Horse — one single unit that works on Delphi (Indy) and on Lazarus / Free Pascal (fphttpserver).

pascal
WSRegister(TWSConfig.Create('/ws',
  procedure(Conn: TWSConnection; const Text: string;
            IsBinary: Boolean; const Data: TBytes)
  begin
    Conn.SendText('Echo: ' + Text);
  end));

THorse.Listen(9000);

Features

  • Full RFC 6455 handshake (Sec-WebSocket-Accept), no external dependency
  • Text and binary frames, including fragmented messages
  • Ping / pong and the close handshake, with a configurable message size limit
  • Channels: clients pick one with ?channel=xxx, broadcasts can target it
  • Messages broadcast to an empty channel are queued and delivered to the first client that joins it
  • Everything is callable from any thread

Requirements

  • Delphi: any version that runs Horse (developed against Delphi 13 / 37.0).
  • Lazarus / FPC: FPC 3.2.2+ (developed against Lazarus 4.6 + FPC 3.2.2, win64). With FPC 3.3.1+ and -dHORSE_FPC_FUNCTIONREFERENCES you also get Delphi-style anonymous methods.

Supported Horse providers

Provider Supported
Delphi — Console / VCL / Daemon (Indy) ✅
Lazarus — default THTTPApplication, HORSE_LCL, HORSE_DAEMON ✅
ISAPI, Apache, CGI, FastCGI ❌

WebSocket needs the raw socket of the request, which the CGI-style providers do not expose. The handler blocks for the whole lifetime of the connection, so the server must be threaded — all supported providers are.

Install

bash
boss init
boss install github.com/kabiri/horse-WS

Horse itself comes along as a dependency, so you end up with:

pascal
modules\horse\src        <- the framework
modules\horse-ws\src     <- Horse.WS.pas

Add both to your search path, then uses Horse, Horse.WS;.

Delphi — Project → Options → Building → Delphi Compiler → Search path:

pascal
modules\horse\src;modules\horse-ws\src

Add your provider define if you are not on the console one, e.g. HORSE_VCL.

Lazarus — Project → Options → Compiler Options → Paths → Other unit files:

pascal
modules\horse\src;modules\horse-ws\src

and under Custom Options the provider define, e.g. -dHORSE_LCL for an LCL application.

Without boss, just copy src\Horse.WS.pas next to your project — it has no dependency beyond Horse itself.

⚠️ Two patches are needed on FPC

Horse's FPC support has two bugs that affect this unit. Both are one-liners in modules\horse\src\, and both have to be re-applied after every boss install / boss update.

1. Horse.FPC.inc — otherwise Horse does not compile at all on FPC 3.2.2

pascal
Horse.Core.Param.Header.pas(37,26) Error: (5042) No matching implementation for
interface method "Equals(constref AnsiString;constref AnsiString):Boolean;" found

The guard assumes const on CPU64 AND WINDOWS, but FPC 3.2.2 declares the interface with constref on every platform. Drop that branch:

pascal
{$IF FPC_FULLVERSION >= 30301}
  {$DEFINE CONST_GENERIC := const}
{$ELSE}
  {$DEFINE CONST_GENERIC := constref}
{$ENDIF}

2. Horse.Provider.FPC.LCL.pas — otherwise the app crashes when it closes

THTTPServerThread.Destroy frees the server and the thread object without Terminate / WaitFor / inherited Destroy, and the accept loop never ends because AcceptIdleTimeout is zero (so StopListen does nothing):

pascal
destructor THTTPServerThread.Destroy;
begin
  Terminate;
  if Assigned(FServer) then
    FServer.Active := False;   // wakes the accept loop
  inherited Destroy;           // TThread's Terminate + WaitFor
  if Assigned(FServer) then
    FreeAndNil(FServer);       // only once the thread really finished
end;

procedure THTTPServerThread.Execute;
begin
  while not Terminated do
    if FStartServer then
    begin
      FServer.Port      := FPort;
      FServer.Threaded  := True;
      FServer.QueueSize := FListenQueue;
      FServer.AcceptIdleTimeout := 250;   // <- makes StopListen effective
      FServer.Active    := True;
    end
    else
      Sleep(10);                          // <- used to burn 100% CPU
end;

These are edits to Horse's own sources, not to this package. They survive nothing: re-apply them after every boss install / boss update. The snippets above were taken from Horse master as of 2026-08 — if your copy differs, apply the same four changes by hand rather than replacing the file.

Both are worth sending upstream: https://github.com/HashLoad/horse

Usage

Delphi

pascal
uses Horse, Horse.WS;

begin
  WSRegister(TWSConfig.Create('/ws',
    // OnMessage
    procedure(Conn: TWSConnection; const Text: string;
              IsBinary: Boolean; const Data: TBytes)
    begin
      if IsBinary then
        Conn.SendBinary(Data)
      else if Text = '__ping__' then
        Conn.SendText('__pong__')
      else
        Conn.SendText('Echo: ' + Text);
    end,
    65536,                                   // MaxMessageBytes
    // OnConnect
    procedure(Conn: TWSConnection; Req: THorseRequest)
    begin
      Writeln('connected: ', Conn.Id, '  channel=', Conn.Channel);
    end,
    // OnDisconnect
    procedure(Conn: TWSConnection)
    begin
      Writeln('disconnected: ', Conn.Id);
    end));

  THorse.Listen(9000);
end.

Lazarus / FPC

FPC 3.2.x has no anonymous methods, so the callbacks are plain procedures — exactly like Horse's own callbacks on FPC:

pascal
uses Horse, Horse.WS;

procedure OnMsg(Conn: TWSConnection; const Text: string;
                IsBinary: Boolean; const Data: TBytes);
begin
  if IsBinary then
    Conn.SendBinary(Data)
  else
    Conn.SendText('Echo: ' + Text);
end;

procedure OnConn(Conn: TWSConnection; Req: THorseRequest);
begin
  WriteLn('connected: ', Conn.Id);
end;

procedure OnDisc(Conn: TWSConnection);
begin
  WriteLn('disconnected: ', Conn.Id);
end;

begin
  WSRegister(TWSConfig.Create('/ws', OnMsg, 65536, OnConn, OnDisc));
  THorse.Listen(9000);
end.

Because the callbacks are not form methods, never touch UI controls from them. Push into a thread-safe buffer and let a timer drain it on the main thread.

Browser

js
var ws = new WebSocket("ws://localhost:9000/ws?channel=news");
ws.onopen    = ()  => ws.send("hello");
ws.onmessage = (e) => console.log(e.data);

API

pascal
procedure WSRegister(const Config: TWSConfig);

procedure WSBroadcast(const Text: string; const Channel: string = '');
procedure WSBroadcastBinary(const Data: TBytes; const Channel: string = '');
function  WSClientCount: Integer;
function  WSChannelExist(const Channel: string): Boolean;
function  WSRemoveChannel(const Channel: string): Boolean;   // '' = every client

TWSConfig

pascal
TWSConfig.Create(
  const AEndpoint: string;
  const AOnMessage: TWSOnMessage;
  AMaxMessageBytes: Int64 = 65536;
  const AOnConnect: TWSOnConnect = nil;
  const AOnDisconnect: TWSOnDisconnect = nil;
  const AAuth: TWSAuthFunc = nil): TWSConfig;

A message larger than MaxMessageBytes gets a close frame with code 1009.

TWSConnection

Member Purpose
SendText(S) send a text frame
SendBinary(Data) send a binary frame
Ping(Data) send a ping (pongs are answered automatically)
Close(Code, Reason) close handshake; WS_CLOSE_NORMAL, WS_CLOSE_GOING_AWAY, …
Disconnect drop the socket without a close frame
Id, Channel, Connected read-only state

Channels

A client picks its channel through the connect URL:

js
new WebSocket("ws://host/ws?channel=news")
  • WSBroadcast('hi') — everyone
  • WSBroadcast('hi', 'news') — only clients on news
  • If nobody is on news yet, the message is queued and flushed to the first client that joins that channel
  • WSRemoveChannel('news') disconnects that channel, WSRemoveChannel('') disconnects everyone

Authentication

pascal
WSRegister(TWSConfig.Create('/ws', OnMsg, 65536, nil, nil,
  function(Req: THorseRequest): Boolean
  begin
    Result := Req.Query['token'] = 'secret';
  end));

Returning False answers 401 before the connection is upgraded.

Shutting down cleanly

Every live connection blocks its own thread. Close the clients before stopping the server, otherwise those threads are still running while the RTL tears itself down:

pascal
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  Waited: Integer;
begin
  if THorse.IsRunning then
  begin
    WSRemoveChannel('');            // closes every WebSocket

    Waited := 0;
    while (WSClientCount > 0) and (Waited < 1000) do
    begin
      Sleep(20);
      Inc(Waited, 20);
    end;

    THorse.StopListen;
  end;
end;

How it works

The endpoint is a normal Horse GET route that takes over the connection:

Delphi Lazarus / FPC
Socket TIdIOHandler of the request TFPHTTPConnection.Socket
Handshake written directly, HeaderHasBeenWritten := True sent through the response object, so ContentSent is set
Disconnect IOHandler.Close fpshutdown + a read timeout

Frame parsing, masking, fragmentation and the connection registry are shared by both compilers.

Notes and limitations

  • One WebSocket endpoint per process (the config is global).
  • On FPC, text is passed through as raw UTF-8 bytes with no code page conversion — which is what the LCL expects from its UTF-8 strings.
  • On FPC the socket uses a 500 ms read timeout internally. This is not an idle timeout — idle connections stay open indefinitely — it exists because on Windows shutdown() does not release a blocked recv(), and without it the handler thread would still be alive at process exit and crash inside ntdll once the RTL had been finalized.
  • Under the Lazarus debugger you may see first-chance EHTTPServer: Error reading data from the socket notifications when the server stops while browsers still hold idle keep-alive sockets. fphttpserver raises and catches those internally; tick Ignore this exception type to silence them.

License

Do what you like with it.