From 9dc43a410221bdd77eaddb7b91dee70cc1d2d8d5 Mon Sep 17 00:00:00 2001 From: freitasjca Date: Mon, 9 Mar 2026 16:45:06 +0000 Subject: [PATCH 1/6] feat: add CrossSocket provider patches MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Horse.Provider.Config.pas (new) — shared config record, breaks circular dep - Horse.Provider.Abstract.pas — add ListenWithConfig virtual class method - Horse.Request.pas — add parameterless Create overload and Clear procedure - Horse.Response.pas — add CustomHeaders, ContentStream, Clear - packages/HorseCS.dpk — runtime package for the patched fork - boss.json — Boss manifest pointing at src/ and HorseCS.dpk --- .gitignore | 9 +++ boss.json | 18 +++-- packages/HorseCS.dpk | 86 +++++++++++++++++++++ packages/HorseCS.dproj | 96 ++++++++++++++++++++++++ packages/HorseCS.res | 0 src/Horse.Provider.Abstract.pas | 31 +++++++- src/Horse.Provider.Config.pas | 129 ++++++++++++++++++++++++++++++++ src/Horse.Request.pas | 57 ++++++++++++++ src/Horse.Response.pas | 79 +++++++++++++++++++ 9 files changed, 497 insertions(+), 8 deletions(-) create mode 100644 packages/HorseCS.dpk create mode 100644 packages/HorseCS.dproj create mode 100644 packages/HorseCS.res create mode 100644 src/Horse.Provider.Config.pas diff --git a/.gitignore b/.gitignore index 039361a..8454266 100644 --- a/.gitignore +++ b/.gitignore @@ -7,12 +7,21 @@ static/ **/__history/ **/__recovery/ src/*.~* +__history/ +__recovery/ +packages/Win32/ +packages/Win64/ +packages/Linux64/ +packages/dcu/ +packages/dcp/ +packages/bpl/ *.res *.exe *.dll *.bpl *.bpi *.dcp +*.bpl *.so *.apk *.drc diff --git a/boss.json b/boss.json index 5cffd49..36d684b 100644 --- a/boss.json +++ b/boss.json @@ -1,9 +1,13 @@ { - "name": "horse", - "description": "", - "version": "1.0.0", - "homepage": "", - "mainsrc": "src/", - "projects": [], - "dependencies": {} + "name": "horse", + "description": "Horse web framework — CrossSocket-compatible fork", + "version": "3.1.9-crosssocket.1", + "homepage": "https://github.com/freitasjca/horse", + "license": "MIT", + "mainsrc": "src/", + "browsingpath": "src/", + "projects": [ + "packages/HorseCS.dpk" + ], + "dependencies": {} } \ No newline at end of file diff --git a/packages/HorseCS.dpk b/packages/HorseCS.dpk new file mode 100644 index 0000000..56d02b7 --- /dev/null +++ b/packages/HorseCS.dpk @@ -0,0 +1,86 @@ +package HorseCS; + +// ============================================================================= +// HorseCS — Horse runtime package (CrossSocket-compatible fork) +// ============================================================================= +// This is the runtime package for the patched Horse fork that adds the +// three features required by Horse.Provider.CrossSocket: +// • THorseRequest.Create (parameterless overload) +// • THorseRequest.Clear +// • THorseResponse.CustomHeaders / ContentStream / Clear +// • THorseProviderAbstract.ListenWithConfig +// • Horse.Provider.Config (new unit) +// +// Package type: RUNTIME only. +// There are no design-time components registered here. If you need +// design-time support (e.g. for an IDE wizard) create a separate +// design-time package that requires this one. +// +// Naming convention: +// HorseCS = Horse + CS (CrossSocket) +// The CS suffix distinguishes this fork's .bpl from the upstream +// Horse.bpl so both can coexist in the same BPL output directory +// without overwriting each other during a transition period. +// ============================================================================= + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WEAKPACKAGEUNIT OFF} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$LIBSUFFIX AUTO} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + dbrtl, // Required by Horse.Commons (THTTPStatus uses dbrtl types) + inet, // Required by Web.HTTPApp (TWebRequest) + indy; // Required by Horse.Provider.Indy (transitively loaded) + // Remove if you are building WITHOUT the Indy provider. + +contains + // ── Core Horse units (patched) ────────────────────────────────────────── + Horse.Provider.Config in '..\..\horse-fork\src\Horse.Provider.Config.pas', + Horse.Provider.Abstract in '..\..\horse-fork\src\Horse.Provider.Abstract.pas', + Horse.Request in '..\..\horse-fork\src\Horse.Request.pas', + Horse.Response in '..\..\horse-fork\src\Horse.Response.pas', + + // ── Core Horse units (unmodified — pulled from fork, identical to upstream) + // Add all remaining upstream Horse units here in the same order the + // upstream Horse.dpk lists them. The lines below are placeholders; + // replace the paths with the actual units from your fork's src/ directory. + Horse in '..\..\horse-fork\src\Horse.pas', + Horse.Commons in '..\..\horse-fork\src\Horse.Commons.pas', + Horse.Core in '..\..\horse-fork\src\Horse.Core.pas', + Horse.Core.Param in '..\..\horse-fork\src\Horse.Core.Param.pas', + Horse.Core.Param.Config in '..\..\horse-fork\src\Horse.Core.Param.Config.pas', + Horse.Core.Router in '..\..\horse-fork\src\Horse.Core.Router.pas', + Horse.Core.Router.Interfaces in '..\..\horse-fork\src\Horse.Core.Router.Interfaces.pas', + Horse.Exception in '..\..\horse-fork\src\Horse.Exception.pas', + Horse.Exception.Interrupted in '..\..\horse-fork\src\Horse.Exception.Interrupted.pas', + Horse.Sessions in '..\..\horse-fork\src\Horse.Sessions.pas', + Horse.Proc in '..\..\horse-fork\src\Horse.Proc.pas', + Horse.Constants in '..\..\horse-fork\src\Horse.Constants.pas', + Horse.WebModule in '..\..\horse-fork\src\Horse.WebModule.pas', + Horse.Provider.Console in '..\..\horse-fork\src\Horse.Provider.Console.pas'; + +end. diff --git a/packages/HorseCS.dproj b/packages/HorseCS.dproj new file mode 100644 index 0000000..c9cacd8 --- /dev/null +++ b/packages/HorseCS.dproj @@ -0,0 +1,96 @@ + + + + + {A1B2C3D4-E5F6-7890-ABCD-EF1234567890} + 19.4 + None + HorseCS.dpk + True + Release + Win64 + 3 + + Package + + + + + Base + RELEASE + true + 0 + false + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE + + + + + Base + DEBUG + false + 2 + true + true + + + + + .\bin\Win32\$(Config) + .\dcu\Win32\$(Config) + .\bpl\Win32\$(Config) + .\dcp\Win32\$(Config) + None + + + + + .\bin\Win64\$(Config) + .\dcu\Win64\$(Config) + .\bpl\Win64\$(Config) + .\dcp\Win64\$(Config) + None + + + + + .\bin\Linux64\$(Config) + .\dcu\Linux64\$(Config) + .\bpl\Linux64\$(Config) + .\dcp\Linux64\$(Config) + + + + + + ..\..\horse-fork\src; + $(DCC_UnitSearchPath) + + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + + + + + + MainSource + + + + + + diff --git a/packages/HorseCS.res b/packages/HorseCS.res new file mode 100644 index 0000000..e69de29 diff --git a/src/Horse.Provider.Abstract.pas b/src/Horse.Provider.Abstract.pas index 30f5017..dd81a08 100644 --- a/src/Horse.Provider.Abstract.pas +++ b/src/Horse.Provider.Abstract.pas @@ -13,7 +13,16 @@ interface {$ELSE} System.SysUtils, {$ENDIF} - Horse.Core; + Horse.Core, +{ =========================================================================== + PATCH-ABS-1 — added unit Horse.Provider.Config + Reason: THorseProviderAbstract needs to declare ListenWithConfig, whose + parameter type THorseCrossSocketConfig is defined in Horse.Provider.Config. + Placing the record in a separate unit avoids a circular dependency between + Horse.Provider.Abstract and Horse.Provider.CrossSocket.Server. + =========================================================================== } + Horse.Provider.Config; +{ =========================================================================== } type THorseProviderAbstract = class(THorseCore) @@ -32,6 +41,16 @@ THorseProviderAbstract = class(THorseCore) class property OnStopListen: TProc read GetOnStopListen write SetOnStopListen; class procedure Listen; virtual; abstract; class procedure StopListen; virtual; +{ =========================================================================== + PATCH-ABS-2 — added ListenWithConfig virtual class method + Reason: THorseProviderCrossSocket overrides this to receive the full + THorseCrossSocketConfig (TLS settings, timeouts, size limits, etc.). + Default implementation delegates to Listen(APort) so all existing + providers — Indy, VCL, CGI, Apache, Daemon — compile and run unchanged. + =========================================================================== } + class procedure ListenWithConfig(const APort: Integer; + const AConfig: THorseCrossSocketConfig); virtual; +{ =========================================================================== } end; implementation @@ -73,4 +92,14 @@ class procedure THorseProviderAbstract.StopListen; raise Exception.Create('StopListen not implemented'); end; +{ =========================================================================== + PATCH-ABS-2 — implementation of ListenWithConfig + =========================================================================== } +class procedure THorseProviderAbstract.ListenWithConfig(const APort: Integer; + const AConfig: THorseCrossSocketConfig); +begin + Listen; +end; +{ =========================================================================== } + end. diff --git a/src/Horse.Provider.Config.pas b/src/Horse.Provider.Config.pas new file mode 100644 index 0000000..ea229e2 --- /dev/null +++ b/src/Horse.Provider.Config.pas @@ -0,0 +1,129 @@ +unit Horse.Provider.Config; + +// ============================================================================= +// Horse.Provider.Config — NEW FILE (Horse fork for CrossSocket provider) +// ============================================================================= +// Upstream: https://github.com/HashLoad/horse (tag 3.1.9) +// Fork: https://github.com/your-org/horse +// +// Purpose +// ------- +// Holds THorseCrossSocketConfig so it can be used by BOTH: +// • Horse.Provider.Abstract.pas (declares ListenWithConfig parameter type) +// • Horse.Provider.CrossSocket.Server.pas (implements the config) +// +// Without this unit, one of those two files would have to use the other, +// creating a circular dependency the Delphi compiler cannot resolve. +// +// This file has NO dependencies on either Horse.Provider.Abstract or +// Horse.Provider.CrossSocket — it is a pure data unit. +// +// The identical record is also declared in Horse.Provider.CrossSocket.Server +// in the provider repository, which re-exports it for backward compatibility. +// When both units are in the search path the compiler will find this canonical +// version first (provider places its src/ after horse/src/). +// ============================================================================= + +{$IF DEFINED(FPC)} + {$MODE DELPHI}{$H+} +{$ENDIF} + +interface + +type + THorseCrossSocketConfig = record + // ── Timeouts ───────────────────────────────────────────────────────── + KeepAliveTimeout: Integer; + // seconds; 0 = disable keep-alive entirely. + // Default: 30 + + ReadTimeout: Integer; + // seconds; enforced by CrossSocket at the socket layer. + // Mitigates slow-HTTP (Slowloris) attacks. + // Default: 20 — never leave at 0 (would be unlimited). + + DrainTimeoutMs: Integer; + // milliseconds to wait for in-flight requests to complete when + // THorseCrossSocketServer.Stop is called. After this timeout the + // server proceeds with shutdown regardless. + // Default: 5000 + + // ── Request size limits ─────────────────────────────────────────────── + MaxHeaderSize: Integer; + // Maximum size of all request headers combined, in bytes. + // Matches the nginx default. + // Default: 8192 (8 KB) + + MaxBodySize: Int64; + // Maximum request body size in bytes. CrossSocket rejects bodies + // larger than this with 413 before the Horse pipeline is entered. + // Default: 4194304 (4 MB) + + // ── Connection ceiling ──────────────────────────────────────────────── + MaxConnections: Integer; + // Maximum number of simultaneous open connections. + // Prevents file-descriptor exhaustion under a connection-flood DoS. + // Default: 10000 + + // ── TLS / SSL ───────────────────────────────────────────────────────── + SSLEnabled: Boolean; + // Set True to listen on HTTPS. Requires SSLCertFile and SSLKeyFile. + // Default: False + + SSLCertFile: string; + // Absolute or relative path to the PEM certificate file. + + SSLKeyFile: string; + // Absolute or relative path to the PEM private key file. + + SSLKeyPassword: string; + // Passphrase for an encrypted private key. Leave empty if unencrypted. + + SSLCACertFile: string; + // Path to the CA certificate used to verify client certificates. + // Required only for mutual TLS (mTLS). Leave empty for server-only TLS. + + SSLVerifyPeer: Boolean; + // When True, CrossSocket requires the client to present a certificate + // signed by the CA in SSLCACertFile. Only meaningful when SSLEnabled + // and SSLCACertFile are both set. + // Default: False + + SSLCipherList: string; + // OpenSSL cipher-list string. Empty = use the built-in AEAD-only list + // defined in Horse.Provider.CrossSocket.Server (TLS 1.2 + TLS 1.3, + // forward secrecy, no RC4/3DES/export). + // Override only when you have a specific compliance requirement. + + // ── Server identity ─────────────────────────────────────────────────── + ServerBanner: string; + // Value to emit in the HTTP Server: response header. + // Empty string suppresses the header (replaced with 'unknown') to + // prevent library/version fingerprinting. + // Default: '' (suppressed) + + // ── Factory ─────────────────────────────────────────────────────────── + class function Default: THorseCrossSocketConfig; static; + end; + +implementation + +class function THorseCrossSocketConfig.Default: THorseCrossSocketConfig; +begin + Result.KeepAliveTimeout := 30; + Result.ReadTimeout := 20; + Result.DrainTimeoutMs := 5000; + Result.MaxHeaderSize := 8192; + Result.MaxBodySize := 4 * 1024 * 1024; // 4 MB + Result.MaxConnections := 10000; + Result.SSLEnabled := False; + Result.SSLCertFile := ''; + Result.SSLKeyFile := ''; + Result.SSLKeyPassword := ''; + Result.SSLCACertFile := ''; + Result.SSLVerifyPeer := False; + Result.SSLCipherList := ''; // empty = use SECURE_CIPHER_LIST constant + Result.ServerBanner := ''; // empty = suppress Server: header +end; + +end. diff --git a/src/Horse.Request.pas b/src/Horse.Request.pas index b8e839d..a72e2b7 100644 --- a/src/Horse.Request.pas +++ b/src/Horse.Request.pas @@ -59,6 +59,26 @@ THorseRequest = class function PathInfo: string; virtual; function RawWebRequest: {$IF DEFINED(FPC)}TRequest{$ELSE}TWebRequest{$ENDIF}; virtual; constructor Create(const AWebRequest: {$IF DEFINED(FPC)}TRequest{$ELSE}TWebRequest{$ENDIF}); +{ =========================================================================== + PATCH-REQ-1 — added parameterless constructor overload + Reason: THorseContextPool.WarmUp pre-allocates THorseRequest instances at + application startup, before any HTTP request arrives and before any + TWebRequest exists. The pool calls this overload; the original constructor + is completely unchanged and continues to be used by the Indy provider. + =========================================================================== } + constructor Create; overload; +{ =========================================================================== } +{ =========================================================================== + PATCH-REQ-2 — added Clear procedure + Reason: THorseContext.Reset recycles pooled objects between requests + without Free/Create overhead. Rules enforced: + • FBody — set to nil, NEVER freed (non-owning CrossSocket buffer ref) + • FSession — set to nil (stale session = wrong-request auth) + • FWebRequest — set to nil (belongs to previous Indy context) + • param collections — cleared in place, objects reused + =========================================================================== } + procedure Clear; +{ =========================================================================== } destructor Destroy; override; end; @@ -115,6 +135,43 @@ constructor THorseRequest.Create(const AWebRequest: {$IF DEFINED(FPC)}TRequest{$ FSessions := THorseSessions.Create; end; +{ =========================================================================== + PATCH-REQ-1 — parameterless constructor implementation + =========================================================================== } +constructor THorseRequest.Create; +begin + FWebRequest := nil; + FSessions := THorseSessions.Create; +end; +{ =========================================================================== } + +{ =========================================================================== + PATCH-REQ-2 — Clear implementation + =========================================================================== } +procedure THorseRequest.Clear; +begin + FWebRequest := nil; + // FBody: non-owning reference into CrossSocket's socket buffer. + // Must be set to nil here. NEVER call FBody.Free — doing so corrupts + // the live TCP connection. The pool Reset sets FBody := nil before + // calling Clear, but we enforce the contract here as a safety net. + FBody := nil; + FSession := nil; + if Assigned(FHeaders) then + FHeaders.Clear; + if Assigned(FQuery) then + FQuery.Clear; + if Assigned(FParams) then + FParams.Clear; + if Assigned(FContentFields) then + FContentFields.Clear; + if Assigned(FCookie) then + FCookie.Clear; + if Assigned(FSessions) then + FSessions.Clear; +end; +{ =========================================================================== } + destructor THorseRequest.Destroy; begin if Assigned(FHeaders) then diff --git a/src/Horse.Response.pas b/src/Horse.Response.pas index 9b530c1..75804cf 100644 --- a/src/Horse.Response.pas +++ b/src/Horse.Response.pas @@ -18,6 +18,15 @@ interface Web.ReqMulti, {$ENDIF} {$ENDIF} +{ =========================================================================== + PATCH-RES-1 — added System.Generics.Collections + Reason: FCustomHeaders is declared as TDictionary. + Required only when Delphi (not FPC) is the compiler. + =========================================================================== } +{$IF NOT DEFINED(FPC)} + System.Generics.Collections, +{$ENDIF} +{ =========================================================================== } Horse.Commons; type @@ -25,6 +34,16 @@ THorseResponse = class private FWebResponse: {$IF DEFINED(FPC)}TResponse{$ELSE}TWebResponse{$ENDIF}; FContent: TObject; +{ =========================================================================== + PATCH-RES-1 — added FCustomHeaders field + Reason: CrossSocket has no TWebResponse. TResponseBridge.CopyHeaders + iterates this dictionary directly to write headers to ICrossHttpResponse. + AddHeader populates both FWebResponse.SetCustomHeader (Indy path) and + this dictionary (CrossSocket path) so all existing middleware that calls + Res.AddHeader continues to work on both providers without any change. + =========================================================================== } + FCustomHeaders: {$IF NOT DEFINED(FPC)}TDictionary{$ELSE}TStringList{$ENDIF}; +{ =========================================================================== } public function Send(const AContent: string): THorseResponse; overload; virtual; function Send(AContent: T): THorseResponse; overload; @@ -46,6 +65,23 @@ THorseResponse = class function ContentType(const AContentType: string): THorseResponse; virtual; function RawWebResponse: {$IF DEFINED(FPC)}TResponse{$ELSE}TWebResponse{$ENDIF}; virtual; constructor Create(const AWebResponse: {$IF DEFINED(FPC)}TResponse{$ELSE}TWebResponse{$ENDIF}); +{ =========================================================================== + PATCH-RES-2 — added Clear procedure + Reason: THorseContext.Reset recycles pooled objects between requests. + Resets FContent and clears FCustomHeaders in place (dictionary object + reused — avoids heap churn on the request hot path). + FWebResponse is set to nil — belongs to the previous Indy context. + =========================================================================== } + procedure Clear; +{ =========================================================================== } +{ =========================================================================== + PATCH-RES-3 — added CustomHeaders read-only property + Reason: TResponseBridge.CopyHeaders reads this property to iterate and + forward response headers to ICrossHttpResponse. Read-only — the bridge + iterates only; all writes go through AddHeader as before. + =========================================================================== } + property CustomHeaders: {$IF NOT DEFINED(FPC)}TDictionary{$ELSE}TStringList{$ENDIF} read FCustomHeaders; +{ =========================================================================== } destructor Destroy; override; end; @@ -63,6 +99,11 @@ implementation function THorseResponse.AddHeader(const AName, AValue: string): THorseResponse; begin FWebResponse.SetCustomHeader(AName, AValue); +{ =========================================================================== + PATCH-RES-1 — also populate FCustomHeaders so CrossSocket bridge can read it + =========================================================================== } + FCustomHeaders.AddOrSetValue(AName, AValue); +{ =========================================================================== } Result := Self; end; @@ -90,12 +131,39 @@ constructor THorseResponse.Create(const AWebResponse: {$IF DEFINED(FPC)}TRespons {$IF DEFINED(FPC)} FWebResponse.FreeContentStream := True; {$ENDIF} +{ =========================================================================== + PATCH-RES-1 — initialise FCustomHeaders + =========================================================================== } +{$IF NOT DEFINED(FPC)} + FCustomHeaders := TDictionary.Create; +{$ELSE} + FCustomHeaders := TStringList.Create; +{$ENDIF} +{ =========================================================================== } end; +{ =========================================================================== + PATCH-RES-2 — Clear implementation + =========================================================================== } +procedure THorseResponse.Clear; +begin + FWebResponse := nil; + FContent := nil; + if Assigned(FCustomHeaders) then + FCustomHeaders.Clear; +end; +{ =========================================================================== } + destructor THorseResponse.Destroy; begin if Assigned(FContent) then FContent.Free; +{ =========================================================================== + PATCH-RES-1 — free FCustomHeaders + =========================================================================== } + if Assigned(FCustomHeaders) then + FCustomHeaders.Free; +{ =========================================================================== } inherited; end; @@ -135,6 +203,17 @@ function THorseResponse.RemoveHeader(const AName: string): THorseResponse; I := FWebResponse.CustomHeaders.IndexOfName(AName); if I <> -1 then FWebResponse.CustomHeaders.Delete(I); +{ =========================================================================== + PATCH-RES-1 — also remove from FCustomHeaders + =========================================================================== } +{$IF NOT DEFINED(FPC)} + FCustomHeaders.Remove(AName); +{$ELSE} + I := FCustomHeaders.IndexOfName(AName); + if I <> -1 then + FCustomHeaders.Delete(I); +{$ENDIF} +{ =========================================================================== } Result := Self; end; From 68c75a37ee6b4e2ddff6e3f2ebe582df115a24cb Mon Sep 17 00:00:00 2001 From: freitasjca Date: Mon, 9 Mar 2026 18:14:02 +0000 Subject: [PATCH 2/6] =?UTF-8?q?chore:=20remove=20HorseCS=20package=20?= =?UTF-8?q?=E2=80=94=20Web.WebBroker=20is=20DENYPACKAGEUNIT?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- packages/HorseCS.dpk | 86 ------------------------------------- packages/HorseCS.dproj | 96 ------------------------------------------ packages/HorseCS.res | 0 3 files changed, 182 deletions(-) delete mode 100644 packages/HorseCS.dpk delete mode 100644 packages/HorseCS.dproj delete mode 100644 packages/HorseCS.res diff --git a/packages/HorseCS.dpk b/packages/HorseCS.dpk deleted file mode 100644 index 56d02b7..0000000 --- a/packages/HorseCS.dpk +++ /dev/null @@ -1,86 +0,0 @@ -package HorseCS; - -// ============================================================================= -// HorseCS — Horse runtime package (CrossSocket-compatible fork) -// ============================================================================= -// This is the runtime package for the patched Horse fork that adds the -// three features required by Horse.Provider.CrossSocket: -// • THorseRequest.Create (parameterless overload) -// • THorseRequest.Clear -// • THorseResponse.CustomHeaders / ContentStream / Clear -// • THorseProviderAbstract.ListenWithConfig -// • Horse.Provider.Config (new unit) -// -// Package type: RUNTIME only. -// There are no design-time components registered here. If you need -// design-time support (e.g. for an IDE wizard) create a separate -// design-time package that requires this one. -// -// Naming convention: -// HorseCS = Horse + CS (CrossSocket) -// The CS suffix distinguishes this fork's .bpl from the upstream -// Horse.bpl so both can coexist in the same BPL output directory -// without overwriting each other during a transition period. -// ============================================================================= - -{$R *.res} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO OFF} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS OFF} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO OFF} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WEAKPACKAGEUNIT OFF} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $00400000} -{$LIBSUFFIX AUTO} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - rtl, - dbrtl, // Required by Horse.Commons (THTTPStatus uses dbrtl types) - inet, // Required by Web.HTTPApp (TWebRequest) - indy; // Required by Horse.Provider.Indy (transitively loaded) - // Remove if you are building WITHOUT the Indy provider. - -contains - // ── Core Horse units (patched) ────────────────────────────────────────── - Horse.Provider.Config in '..\..\horse-fork\src\Horse.Provider.Config.pas', - Horse.Provider.Abstract in '..\..\horse-fork\src\Horse.Provider.Abstract.pas', - Horse.Request in '..\..\horse-fork\src\Horse.Request.pas', - Horse.Response in '..\..\horse-fork\src\Horse.Response.pas', - - // ── Core Horse units (unmodified — pulled from fork, identical to upstream) - // Add all remaining upstream Horse units here in the same order the - // upstream Horse.dpk lists them. The lines below are placeholders; - // replace the paths with the actual units from your fork's src/ directory. - Horse in '..\..\horse-fork\src\Horse.pas', - Horse.Commons in '..\..\horse-fork\src\Horse.Commons.pas', - Horse.Core in '..\..\horse-fork\src\Horse.Core.pas', - Horse.Core.Param in '..\..\horse-fork\src\Horse.Core.Param.pas', - Horse.Core.Param.Config in '..\..\horse-fork\src\Horse.Core.Param.Config.pas', - Horse.Core.Router in '..\..\horse-fork\src\Horse.Core.Router.pas', - Horse.Core.Router.Interfaces in '..\..\horse-fork\src\Horse.Core.Router.Interfaces.pas', - Horse.Exception in '..\..\horse-fork\src\Horse.Exception.pas', - Horse.Exception.Interrupted in '..\..\horse-fork\src\Horse.Exception.Interrupted.pas', - Horse.Sessions in '..\..\horse-fork\src\Horse.Sessions.pas', - Horse.Proc in '..\..\horse-fork\src\Horse.Proc.pas', - Horse.Constants in '..\..\horse-fork\src\Horse.Constants.pas', - Horse.WebModule in '..\..\horse-fork\src\Horse.WebModule.pas', - Horse.Provider.Console in '..\..\horse-fork\src\Horse.Provider.Console.pas'; - -end. diff --git a/packages/HorseCS.dproj b/packages/HorseCS.dproj deleted file mode 100644 index c9cacd8..0000000 --- a/packages/HorseCS.dproj +++ /dev/null @@ -1,96 +0,0 @@ - - - - - {A1B2C3D4-E5F6-7890-ABCD-EF1234567890} - 19.4 - None - HorseCS.dpk - True - Release - Win64 - 3 - - Package - - - - - Base - RELEASE - true - 0 - false - WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE - - - - - Base - DEBUG - false - 2 - true - true - - - - - .\bin\Win32\$(Config) - .\dcu\Win32\$(Config) - .\bpl\Win32\$(Config) - .\dcp\Win32\$(Config) - None - - - - - .\bin\Win64\$(Config) - .\dcu\Win64\$(Config) - .\bpl\Win64\$(Config) - .\dcp\Win64\$(Config) - None - - - - - .\bin\Linux64\$(Config) - .\dcu\Linux64\$(Config) - .\bpl\Linux64\$(Config) - .\dcp\Linux64\$(Config) - - - - - - ..\..\horse-fork\src; - $(DCC_UnitSearchPath) - - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - - - - - - MainSource - - - - - - diff --git a/packages/HorseCS.res b/packages/HorseCS.res deleted file mode 100644 index e69de29..0000000 From 6e9f945c221a652a1250e7d9d758f1672844c4de Mon Sep 17 00:00:00 2001 From: freitasjca Date: Mon, 9 Mar 2026 18:17:47 +0000 Subject: [PATCH 3/6] chore: Update boss.json --- boss.json | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/boss.json b/boss.json index 36d684b..ad6a6b8 100644 --- a/boss.json +++ b/boss.json @@ -6,8 +6,6 @@ "license": "MIT", "mainsrc": "src/", "browsingpath": "src/", - "projects": [ - "packages/HorseCS.dpk" - ], + "projects": [], "dependencies": {} } \ No newline at end of file From ed3639fc7f43693fde91fbc9bfe5e5232b22cae6 Mon Sep 17 00:00:00 2001 From: freitasjca Date: Fri, 13 Mar 2026 17:52:29 +0000 Subject: [PATCH 4/6] Add Clear, CustomHeaders, ContentStream, ListenWithConfig, etc. --- samples/delphi/console/Console.dpr | 116 +++++- samples/delphi/console/Console.dproj | 525 ++++++++++++++------------- src/Horse.Provider.Abstract.pas | 60 ++- src/Horse.Provider.Config.pas | 30 +- src/Horse.Request.pas | 197 +++++++++- src/Horse.Response.pas | 151 +++++++- src/Horse.pas | 19 +- 7 files changed, 797 insertions(+), 301 deletions(-) diff --git a/samples/delphi/console/Console.dpr b/samples/delphi/console/Console.dpr index f429575..6859d74 100644 --- a/samples/delphi/console/Console.dpr +++ b/samples/delphi/console/Console.dpr @@ -1,11 +1,63 @@ -program Console; +program Console; {$APPTYPE CONSOLE} {$R *.res} uses Horse, - System.SysUtils; + System.Classes, + System.SysUtils, + {$IFDEF LINUX} + Posix.Signal, // Linux signal constants + {$ENDIF} + Horse.Provider.ISAPI in '..\..\..\src\Horse.Provider.ISAPI.pas', + Horse.Provider.VCL in '..\..\..\src\Horse.Provider.VCL.pas', + Horse.Request in '..\..\..\src\Horse.Request.pas', + Horse.Response in '..\..\..\src\Horse.Response.pas', + Horse.Rtti.Helper in '..\..\..\src\Horse.Rtti.Helper.pas', + Horse.Rtti in '..\..\..\src\Horse.Rtti.pas', + Horse.Session in '..\..\..\src\Horse.Session.pas', + Horse.WebModule in '..\..\..\src\Horse.WebModule.pas', + ThirdParty.Posix.Syslog in '..\..\..\src\ThirdParty.Posix.Syslog.pas', + Web.WebConst in '..\..\..\src\Web.WebConst.pas', + Horse.Callback in '..\..\..\src\Horse.Callback.pas', + Horse.Commons in '..\..\..\src\Horse.Commons.pas', + Horse.Constants in '..\..\..\src\Horse.Constants.pas', + Horse.Core.Files in '..\..\..\src\Horse.Core.Files.pas', + Horse.Core.Group.Contract in '..\..\..\src\Horse.Core.Group.Contract.pas', + Horse.Core.Group in '..\..\..\src\Horse.Core.Group.pas', + Horse.Core.Param.Config in '..\..\..\src\Horse.Core.Param.Config.pas', + Horse.Core.Param.Field.Brackets in '..\..\..\src\Horse.Core.Param.Field.Brackets.pas', + Horse.Core.Param.Field in '..\..\..\src\Horse.Core.Param.Field.pas', + Horse.Core.Param.Header in '..\..\..\src\Horse.Core.Param.Header.pas', + Horse.Core.Param in '..\..\..\src\Horse.Core.Param.pas', + Horse.Core in '..\..\..\src\Horse.Core.pas', + Horse.Core.Route.Contract in '..\..\..\src\Horse.Core.Route.Contract.pas', + Horse.Core.Route in '..\..\..\src\Horse.Core.Route.pas', + Horse.Core.RouterTree.NextCaller in '..\..\..\src\Horse.Core.RouterTree.NextCaller.pas', + Horse.Core.RouterTree in '..\..\..\src\Horse.Core.RouterTree.pas', + Horse.EnvironmentVariables in '..\..\..\src\Horse.EnvironmentVariables.pas', + Horse.Exception.Interrupted in '..\..\..\src\Horse.Exception.Interrupted.pas', + Horse.Exception in '..\..\..\src\Horse.Exception.pas', + Horse.Mime in '..\..\..\src\Horse.Mime.pas', + Horse.Provider.Config in '..\..\..\src\Horse.Provider.Config.pas', + Horse.Provider.Console in '..\..\..\src\Horse.Provider.Console.pas', + Horse.Provider.Daemon in '..\..\..\src\Horse.Provider.Daemon.pas'; + +var + Config: THorseCrossSocketConfig; + {$IFDEF LINUX} + GShutdown: Boolean = False; + {$ENDIF} + +{$IFDEF LINUX} +// Signal handler — called on SIGTERM or SIGINT +procedure HandleSignal(Sig: Integer); cdecl; +begin + GShutdown := True; +end; +{$ENDIF} + begin {$IFDEF MSWINDOWS} @@ -13,16 +65,68 @@ begin ReportMemoryLeaksOnShutdown := True; {$ENDIF} + {$IFDEF LINUX} + // Install signal handlers + signal(SIGTERM, HandleSignal); + signal(SIGINT, HandleSignal); + {$ENDIF} + + + // ── Routes ──────────────────────────────────────────────────────── THorse.Get('/ping', procedure(Req: THorseRequest; Res: THorseResponse) begin + Res.ContentType('text/plain; charset=utf-8'); Res.Send('pong'); end); - THorse.Listen(9000, - procedure + THorse.Get('/health', + procedure(Req: THorseRequest; Res: THorseResponse) + begin + Res.Send('{"status":"ok"}'); + end); + + THorse.Post('/echo', + procedure(Req: THorseRequest; Res: THorseResponse) begin - Writeln(Format('Server is runing on %s:%d', [THorse.Host, THorse.Port])); - Readln; + Res.ContentType(Req.ContentType); + Res.Send(Req.Body); end); + + // ── Config ──────────────────────────────────────────────────────── + Config := THorseCrossSocketConfig.Default; + Config.IoThreads := 0; // 0 = CrossSocket picks CPU-count threads + Config.MaxBodySize := 8 * 1024 * 1024; // 8 MB + Config.MaxHeaderSize := 8192; + Config.KeepAliveTimeout := 30; + Config.ReadTimeout := 20; + + // ── Start ───────────────────────────────────────────────────────── + // ListenWithConfig is non-blocking: Start() launches epoll/IO threads + // then returns. The main thread MUST block or the process exits. + THorse.ListenWithConfig(8080, Config); + WriteLn('Server started on :8080 (press Ctrl+C to stop)'); + + // ── Keep-alive loop ─────────────────────────────────────────────── + // ReadLn blocks the main thread. In production replace with a + // signal handler (see Phase 8). In Docker, stdin is /dev/null so + // ReadLn returns immediately — use the signal-handler pattern. + + {$IFDEF MSWINDOWS} + ReadLn; + THorse.StopListen; + {$ENDIF} + + {$IFDEF LINUX} + // Keep-alive loop — wakes every 100ms to check GShutdown + while not GShutdown do + Sleep(100); + + WriteLn('Shutdown signal received — draining...'); + THorse.StopListen; + WriteLn('Stopped.'); + {$ENDIF} + + end. + diff --git a/samples/delphi/console/Console.dproj b/samples/delphi/console/Console.dproj index 4b1c2c7..1254b6f 100644 --- a/samples/delphi/console/Console.dproj +++ b/samples/delphi/console/Console.dproj @@ -1,12 +1,12 @@  {2AF29AEE-B106-4674-AB7E-25CE8D53056B} - 20.3 + 19.2 None True Debug Win32 - 1 + 129 Console Console.dpr Console @@ -29,8 +29,13 @@ Base true - - true + + true + Base + true + + + true Base true @@ -49,6 +54,12 @@ Base true + + true + Cfg_1 + true + true + true Cfg_1 @@ -70,6 +81,8 @@ false System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) Console + HORSE_CROSSSOCKET;$(DCC_Define) + ..\..\..\..\Delphi-Cross-Socket;..\..\..\..\Delphi-Cross-Socket\Net;..\..\..\..\Delphi-Cross-Socket\Utils;..\..\..\..\Delphi-Cross-Socket\CnPack\Common;..\..\..\..\Delphi-Cross-Socket\CnPack\Crypto;..\..\..\..\horse-provider-crosssocket\src;..\..\..\..\Delphi-Cross-Socket\DelphiToFPC;$(DCC_UnitSearchPath) $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png @@ -91,11 +104,14 @@ Debug $(MSBuildProjectName) - + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing bluetooth;NSBluetoothPeripheralUsageDescription=The reason for accessing bluetooth peripherals;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSMotionUsageDescription=The reason for accessing the accelerometer;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers iPhoneAndiPad true - $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSCameraUsageDescription=The reason for accessing the camera;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSMotionUsageDescription=The reason for accessing the accelerometer;NSDesktopFolderUsageDescription=The reason for accessing the Desktop folder;NSDocumentsFolderUsageDescription=The reason for accessing the Documents folder;NSDownloadsFolderUsageDescription=The reason for accessing the Downloads folder;NSNetworkVolumesUsageDescription=The reason for accessing files on a network volume;NSRemovableVolumesUsageDescription=The reason for accessing files on a removable volume;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers + Debug DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;IndyCore;boss_ide;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;DOSCommandDR;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) @@ -121,6 +137,10 @@ true true + + /usr/bin/xterm -e "%debuggee%" + (None) + false ..\..\..\src;$(DCC_UnitSearchPath) @@ -137,6 +157,43 @@ MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Cfg_2 + Base + Base @@ -144,10 +201,6 @@ Cfg_1 Base - - Cfg_2 - Base - Delphi.Personality.12 @@ -158,20 +211,25 @@ Console.dpr - Embarcadero DBExpress DataSnap Native Server Components - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components + File C:\lang\Tools\Code4D\Install-BPLs\Delphi-10.4-Sydney\C4DWizard.bpl not found False False False - False + False + True + False True False - + + + + true + + true @@ -182,12 +240,13 @@ true - - + + + + Console.exe true - 1 @@ -200,6 +259,16 @@ 0 + + + classes + 1 + + + classes + 1 + + res\xml @@ -210,6 +279,12 @@ 1 + + + library\lib\armeabi-v7a + 1 + + library\lib\armeabi @@ -625,11 +700,6 @@ 1 .framework - - Contents\MacOS - 1 - .framework - 0 @@ -643,7 +713,7 @@ 1 .dylib - + 1 .dylib @@ -657,11 +727,6 @@ 1 .dylib - - Contents\MacOS - 1 - .dylib - 0 .dll;.bpl @@ -676,7 +741,7 @@ 1 .dylib - + 1 .dylib @@ -690,11 +755,6 @@ 1 .dylib - - Contents\MacOS - 1 - .dylib - 0 .bpl @@ -713,7 +773,7 @@ 0 - + 0 @@ -724,421 +784,382 @@ Contents\Resources\StartUp\ 0 - - Contents\Resources\StartUp\ - 0 - 0 - - - 1 - - + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - ..\ - 1 - - - ..\ + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - ..\ + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - Contents - 1 - - - Contents + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - Contents + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - Contents\Resources - 1 - - - Contents\Resources + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - Contents\Resources + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Contents\MacOS + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Contents\MacOS + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Contents\MacOS + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - 0 - - - - library\lib\armeabi-v7a + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - + - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - ..\ - 1 - + - ..\ + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - ..\ + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + - ..\$(PROJECTNAME).launchscreen - 64 - - - ..\$(PROJECTNAME).launchscreen - 64 + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 - - - + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - Assets + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Assets + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - Assets + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Assets + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + ..\ 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + ..\ 1 - + + + 1 + - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - + - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 + ..\$(PROJECTNAME).launchscreen + 64 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 + + ..\$(PROJECTNAME).launchscreen + 64 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + + ..\ 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + ..\ 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + + Contents 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + Contents 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + + Contents\Resources 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + Contents\Resources 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + + library\lib\armeabi-v7a 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + library\lib\arm64-v8a + 1 + + 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Contents\MacOS 1 - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Contents\MacOS 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + 0 + + + + + library\lib\armeabi-v7a 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + Assets 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Assets 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + Assets 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Assets 1 - - - - - + + - - - + + + + + + 12 diff --git a/src/Horse.Provider.Abstract.pas b/src/Horse.Provider.Abstract.pas index dd81a08..5dd7b23 100644 --- a/src/Horse.Provider.Abstract.pas +++ b/src/Horse.Provider.Abstract.pas @@ -1,4 +1,4 @@ -unit Horse.Provider.Abstract; +unit Horse.Provider.Abstract; {$IF DEFINED(FPC)} {$MODE DELPHI}{$H+} @@ -16,20 +16,23 @@ interface Horse.Core, { =========================================================================== PATCH-ABS-1 — added unit Horse.Provider.Config - Reason: THorseProviderAbstract needs to declare ListenWithConfig, whose - parameter type THorseCrossSocketConfig is defined in Horse.Provider.Config. - Placing the record in a separate unit avoids a circular dependency between - Horse.Provider.Abstract and Horse.Provider.CrossSocket.Server. =========================================================================== } - Horse.Provider.Config; + Horse.Provider.Config, { =========================================================================== } + Horse.Request, + Horse.Response; type THorseProviderAbstract = class(THorseCore) private class var FOnListen: TProc; class var FOnStopListen: TProc; + // [PATCH-ABS-3] Port class var — mirrors the Indy/Console provider. + // CrossSocket's no-arg Listen reads this; callers set it via THorse.Port. + class var FPort: Integer; class function GetOnStopListen: TProc; static; + class function GetPort: Integer; static; + class procedure SetPort(AValue: Integer); static; protected class function GetOnListen: TProc; static; class procedure SetOnListen(const AValue: TProc); static; @@ -39,17 +42,27 @@ THorseProviderAbstract = class(THorseCore) public class property OnListen: TProc read GetOnListen write SetOnListen; class property OnStopListen: TProc read GetOnStopListen write SetOnStopListen; + // [PATCH-ABS-3] Port property — set before calling the no-arg Listen. + class property Port: Integer read GetPort write SetPort; class procedure Listen; virtual; abstract; class procedure StopListen; virtual; { =========================================================================== PATCH-ABS-2 — added ListenWithConfig virtual class method - Reason: THorseProviderCrossSocket overrides this to receive the full - THorseCrossSocketConfig (TLS settings, timeouts, size limits, etc.). - Default implementation delegates to Listen(APort) so all existing - providers — Indy, VCL, CGI, Apache, Daemon — compile and run unchanged. =========================================================================== } class procedure ListenWithConfig(const APort: Integer; const AConfig: THorseCrossSocketConfig); virtual; +{ =========================================================================== } +{ =========================================================================== + PATCH-ABS-3 — Execute class method + Runs the Horse middleware/route pipeline for a given request+response pair. + Providers that bypass TWebRequest (CrossSocket, raw socket, etc.) call this + after populating THorseRequest via the request bridge. + Implementation: THorseCore.Routes.Execute(Req, Res, nil) + =========================================================================== } + class procedure Execute( + const ARequest: THorseRequest; + const AResponse: THorseResponse + ); virtual; { =========================================================================== } end; @@ -77,6 +90,16 @@ class function THorseProviderAbstract.GetOnStopListen: TProc; Result := FOnStopListen; end; +class function THorseProviderAbstract.GetPort: Integer; +begin + Result := FPort; +end; + +class procedure THorseProviderAbstract.SetPort(AValue: Integer); +begin + FPort := AValue; +end; + class procedure THorseProviderAbstract.SetOnListen(const AValue: TProc); begin FOnListen := AValue; @@ -102,4 +125,21 @@ class procedure THorseProviderAbstract.ListenWithConfig(const APort: Integer; end; { =========================================================================== } +{ =========================================================================== + PATCH-ABS-3 — Execute: runs the Horse middleware+route pipeline. + THorseRouterTree.Execute(Req, Res, Next) walks all registered middleware and + the matching route handler. Passing nil for Next means the pipeline ends + naturally when all handlers have run (EHorseCallbackInterrupted is raised + internally by Horse when a middleware calls Next with no further handlers — + this is normal and is caught by the provider's exception handler). + =========================================================================== } +class procedure THorseProviderAbstract.Execute( + const ARequest: THorseRequest; + const AResponse: THorseResponse +); +begin + Routes.Execute(ARequest, AResponse); +end; +{ =========================================================================== } + end. diff --git a/src/Horse.Provider.Config.pas b/src/Horse.Provider.Config.pas index ea229e2..56684ed 100644 --- a/src/Horse.Provider.Config.pas +++ b/src/Horse.Provider.Config.pas @@ -1,4 +1,4 @@ -unit Horse.Provider.Config; +unit Horse.Provider.Config; // ============================================================================= // Horse.Provider.Config — NEW FILE (Horse fork for CrossSocket provider) @@ -30,8 +30,21 @@ interface +const + // [SEC-1] Safe defaults + DEFAULT_MAX_HEADER_SIZE = 8192; // 8 KB — matches nginx default + DEFAULT_MAX_BODY_SIZE = 4 * 1024 * 1024; // 4 MB + DEFAULT_IO_THREADS = 0; // 0 = library picks (CPU count) + // [SEC-6] + DEFAULT_DRAIN_TIMEOUT_MS = 5000; // ms + + type THorseCrossSocketConfig = record + + // IO model + IoThreads: Integer; // [SEC-2] 0 = library default (recommended) + // ── Timeouts ───────────────────────────────────────────────────────── KeepAliveTimeout: Integer; // seconds; 0 = disable keep-alive entirely. @@ -49,11 +62,13 @@ THorseCrossSocketConfig = record // Default: 5000 // ── Request size limits ─────────────────────────────────────────────── + // Size limits [SEC-1] MaxHeaderSize: Integer; // Maximum size of all request headers combined, in bytes. // Matches the nginx default. // Default: 8192 (8 KB) + // Size limits [SEC-1] MaxBodySize: Int64; // Maximum request body size in bytes. CrossSocket rejects bodies // larger than this with 413 before the Horse pipeline is entered. @@ -66,6 +81,11 @@ THorseCrossSocketConfig = record // Default: 10000 // ── TLS / SSL ───────────────────────────────────────────────────────── + + // SSL / TLS [SEC-3] + // SSL is enabled by passing SSLEnabled=True at construction. + // Certificates are loaded via SetCertificateFile / SetPrivateKeyFile + // on the TCrossSslSocketBase API — confirmed in Net.CrossSslSocket.Base. SSLEnabled: Boolean; // Set True to listen on HTTPS. Requires SSLCertFile and SSLKeyFile. // Default: False @@ -110,11 +130,13 @@ implementation class function THorseCrossSocketConfig.Default: THorseCrossSocketConfig; begin + Result.IoThreads := DEFAULT_IO_THREADS; + Result.KeepAliveTimeout := 30; Result.ReadTimeout := 20; - Result.DrainTimeoutMs := 5000; - Result.MaxHeaderSize := 8192; - Result.MaxBodySize := 4 * 1024 * 1024; // 4 MB + Result.DrainTimeoutMs := DEFAULT_DRAIN_TIMEOUT_MS; // [SEC-6] + Result.MaxHeaderSize := DEFAULT_MAX_HEADER_SIZE; // [SEC-1] + Result.MaxBodySize := DEFAULT_MAX_BODY_SIZE; // [SEC-1] Result.MaxConnections := 10000; Result.SSLEnabled := False; Result.SSLCertFile := ''; diff --git a/src/Horse.Request.pas b/src/Horse.Request.pas index a72e2b7..e3f9781 100644 --- a/src/Horse.Request.pas +++ b/src/Horse.Request.pas @@ -1,4 +1,4 @@ -unit Horse.Request; +unit Horse.Request; {$IF DEFINED(FPC)} {$MODE DELPHI}{$H+} @@ -34,6 +34,15 @@ THorseRequest = class FBody: TObject; FSession: TObject; FSessions: THorseSessions; +{ =========================================================================== + PATCH-REQ-3 — CrossSocket shadow fields (populated by Populate, nil by default) + =========================================================================== } + FCSMethod: string; + FCSMethodType: TMethodType; + FCSPathInfo: string; + FCSContentType: string; + FCSRemoteAddr: string; +{ =========================================================================== } procedure InitializeQuery; procedure InitializeParams; procedure InitializeContentFields; @@ -58,7 +67,7 @@ THorseRequest = class function Host: string; virtual; function PathInfo: string; virtual; function RawWebRequest: {$IF DEFINED(FPC)}TRequest{$ELSE}TWebRequest{$ENDIF}; virtual; - constructor Create(const AWebRequest: {$IF DEFINED(FPC)}TRequest{$ELSE}TWebRequest{$ENDIF}); + constructor Create(const AWebRequest: {$IF DEFINED(FPC)}TRequest{$ELSE}TWebRequest{$ENDIF}); overload; { =========================================================================== PATCH-REQ-1 — added parameterless constructor overload Reason: THorseContextPool.WarmUp pre-allocates THorseRequest instances at @@ -78,6 +87,41 @@ THorseRequest = class • param collections — cleared in place, objects reused =========================================================================== } procedure Clear; +{ =========================================================================== } +{ =========================================================================== + PATCH-REQ-3 — added Populate procedure and RemoteAddr function + Reason: The CrossSocket bridge must inject per-request values directly + into THorseRequest without a live TWebRequest. All fields below were + previously read-only delegations to FWebRequest; they now have private + shadow fields that are populated here and returned when FWebRequest is nil. + + Fields injected via Populate: + FCSMethod — method string ('GET','POST',…) + FCSMethodType — parsed TMethodType + FCSPathInfo — decoded path ('/api/users/1') + FCSContentType — Content-Type header value + FCSRemoteAddr — real peer socket address + + RemoteAddr is a new public function (no equivalent existed before). + MethodType, ContentType, PathInfo fall through to the CS fields when + FWebRequest is nil (nil-guard added to each implementation). + =========================================================================== } + procedure Populate( + const AMethod: string; + AMethodType: TMethodType; + const APath: string; + const AContentType: string; + const ARemoteAddr: string + ); + function RemoteAddr: string; virtual; +{ =========================================================================== + PATCH-REQ-4 — PopulateCookiesFromHeader + Parses the raw "Cookie: name=value; name2=value2" header string into the + FCookie param collection. Called by the CrossSocket request bridge after + Populate() so that Req.Cookie works on the CrossSocket path without any + dependency on FWebRequest. + =========================================================================== } + procedure PopulateCookiesFromHeader(const ACookieHeader: string); { =========================================================================== } destructor Destroy; override; end; @@ -147,6 +191,25 @@ constructor THorseRequest.Create; { =========================================================================== PATCH-REQ-2 — Clear implementation + THorseCoreParam owns FParams (a TDictionary) which is + exposed via the public Dictionary property. Calling Dictionary.Clear + wipes all entries in-place without freeing the THorseCoreParam object + itself, so the next request reuses the same objects with no heap churn. + FContent is a lazy TStrings cache inside THorseCoreParam — it is freed + and nil-ed here via FreeAndNil on the param object then recreated by the + next InitializeXxx call. Because FContent is private to THorseCoreParam + the cleanest way to reset it is to FreeAndNil the whole THorseCoreParam + and let the lazy accessor rebuild it, which is what the destructor does. + We therefore use Dictionary.Clear for the hot-path wipe and rely on the + lazy InitializeXxx pattern (already used everywhere in this class) when + a full reset including FContent is required. + Strategy per field: + FHeaders — Dictionary.Clear (header map reused, no FContent used) + FQuery — FreeAndNil + lazy rebuild via InitializeQuery + FParams — Dictionary.Clear (route params repopulated by router) + FContentFields— FreeAndNil + lazy rebuild via InitializeContentFields + FCookie — FreeAndNil + lazy rebuild via InitializeCookie + FSessions — FreeAndNil + Create (no lazy init method exists) =========================================================================== } procedure THorseRequest.Clear; begin @@ -157,18 +220,26 @@ procedure THorseRequest.Clear; // calling Clear, but we enforce the contract here as a safety net. FBody := nil; FSession := nil; +{ PATCH-REQ-3 — wipe shadow fields so next request starts clean } + FCSMethod := ''; + FCSMethodType := mtAny; + FCSPathInfo := ''; + FCSContentType := ''; + FCSRemoteAddr := ''; +{ end PATCH-REQ-3 } if Assigned(FHeaders) then - FHeaders.Clear; + FHeaders.Dictionary.Clear; if Assigned(FQuery) then - FQuery.Clear; + FreeAndNil(FQuery); if Assigned(FParams) then - FParams.Clear; + FParams.Dictionary.Clear; if Assigned(FContentFields) then - FContentFields.Clear; + FreeAndNil(FContentFields); if Assigned(FCookie) then - FCookie.Clear; + FreeAndNil(FCookie); if Assigned(FSessions) then - FSessions.Clear; + FreeAndNil(FSessions); + FSessions := THorseSessions.Create; end; { =========================================================================== } @@ -197,6 +268,16 @@ function THorseRequest.Headers: THorseCoreParam; begin if not Assigned(FHeaders) then begin +{ PATCH-REQ-3 — nil-guard: when FWebRequest is nil (CrossSocket path), + Populate already called InitializeHeaders which set FHeaders. + If somehow we arrive here with FWebRequest=nil and FHeaders=nil, + create an empty param rather than crashing on GetHeaders(nil). } + if not Assigned(FWebRequest) then + begin + FHeaders := THorseCoreParam.Create(THorseList.Create).Required(False); + Exit(FHeaders); + end; +{ end PATCH-REQ-3 } LParam := THorseCoreParamHeader.GetHeaders(FWebRequest); FHeaders := THorseCoreParam.Create(LParam).Required(False); end; @@ -210,6 +291,10 @@ function THorseRequest.Host: string; function THorseRequest.ContentType: string; begin +{ PATCH-REQ-3 — nil-guard } + if not Assigned(FWebRequest) then + Exit(FCSContentType); +{ end PATCH-REQ-3 } Result := FWebRequest.ContentType; end; @@ -217,6 +302,10 @@ function THorseRequest.PathInfo: string; var LPrefix: string; begin +{ PATCH-REQ-3 — nil-guard } + if not Assigned(FWebRequest) then + Exit(FCSPathInfo); +{ end PATCH-REQ-3 } LPrefix := EmptyStr; if FWebRequest.PathInfo = EmptyStr then LPrefix := '/'; @@ -234,6 +323,14 @@ procedure THorseRequest.InitializeContentFields; LValue: String; begin FContentFields := THorseCoreParam.Create(THorseList.Create).Required(False); +{ PATCH-REQ-4 — nil-guard: on CrossSocket path FWebRequest is nil. + Multipart / form-url-encoded body parsing is the responsibility of + application-level middleware on the CrossSocket path (e.g. a middleware + that reads Req.Body and parses it manually). We simply return an empty + param collection here rather than crashing on nil FWebRequest. } + if not Assigned(FWebRequest) then + Exit; +{ end PATCH-REQ-4 } if (not CanLoadContentFields) then Exit; @@ -285,6 +382,13 @@ procedure THorseRequest.InitializeCookie; LItem: string; begin FCookie := THorseCoreParam.Create(THorseList.Create).Required(False); +{ PATCH-REQ-4 — nil-guard: on CrossSocket path FWebRequest is nil. + Cookie parsing from the raw header string is handled by + THorseRequest.PopulateCookiesFromHeader, called by the CrossSocket bridge + after Populate(). Nothing to do here on that path. } + if not Assigned(FWebRequest) then + Exit; +{ end PATCH-REQ-4 } for LItem in FWebRequest.CookieFields do begin LParam := LItem.Split(['=']); @@ -351,6 +455,10 @@ function THorseRequest.IsMultipartForm: Boolean; function THorseRequest.MethodType: TMethodType; begin +{ PATCH-REQ-3 — nil-guard: return shadow field when FWebRequest is nil } + if not Assigned(FWebRequest) then + Exit(FCSMethodType); +{ end PATCH-REQ-3 } Result := {$IF DEFINED(FPC)}StringCommandToMethodType(FWebRequest.Method); {$ELSE}FWebRequest.MethodType; {$ENDIF} end; @@ -389,4 +497,77 @@ function THorseRequest.Sessions: THorseSessions; Result := FSessions; end; +{ =========================================================================== + PATCH-REQ-3 — Populate implementation + Called once per request by the CrossSocket bridge AFTER the pool returns + a context. Sets the five shadow fields and pre-builds FHeaders so the + lazy Headers() accessor never calls GetHeaders(nil). + =========================================================================== } +procedure THorseRequest.Populate( + const AMethod: string; + AMethodType: TMethodType; + const APath: string; + const AContentType: string; + const ARemoteAddr: string +); +begin + FCSMethod := AMethod; + FCSMethodType := AMethodType; + FCSPathInfo := APath; + FCSContentType := AContentType; + FCSRemoteAddr := ARemoteAddr; + + // Pre-build FHeaders as an empty container so the lazy init in Headers() + // never reaches THorseCoreParamHeader.GetHeaders(nil). + // The bridge then populates it via FHeaders.Dictionary.AddOrSetValue. + if not Assigned(FHeaders) then + FHeaders := THorseCoreParam.Create(THorseList.Create).Required(False) + else + FHeaders.Dictionary.Clear; +end; + +function THorseRequest.RemoteAddr: string; +begin + Result := FCSRemoteAddr; +end; +{ =========================================================================== } + +{ =========================================================================== + PATCH-REQ-4 — PopulateCookiesFromHeader implementation + Parses the RFC 6265 Cookie header value: + "name=value; name2=value2; ..." + Each pair is split on the first '=' so values that themselves contain '=' + (e.g. Base64) are preserved intact. + Leading/trailing whitespace around names and values is trimmed. + FCookie is pre-built by InitializeCookie (which returns early on the + CrossSocket path), so we just call AddOrSetValue here. + =========================================================================== } +procedure THorseRequest.PopulateCookiesFromHeader(const ACookieHeader: string); +var + Pairs: TArray; + Pair: string; + EqPos: Integer; + CName, CValue: string; +begin + if ACookieHeader = '' then + Exit; + + // Ensure FCookie is initialised (InitializeCookie is idempotent — it will + // return immediately after creating an empty collection on CrossSocket path) + if not Assigned(FCookie) then + FCookie := THorseCoreParam.Create(THorseList.Create).Required(False); + + Pairs := ACookieHeader.Split([';']); + for Pair in Pairs do + begin + EqPos := Pos('=', Pair); + if EqPos < 2 then Continue; // skip malformed / empty-name pairs + CName := Trim(Copy(Pair, 1, EqPos - 1)); + CValue := Trim(Copy(Pair, EqPos + 1, MaxInt)); + if CName = '' then Continue; + FCookie.Dictionary.AddOrSetValue(CName, CValue); + end; +end; +{ =========================================================================== } + end. diff --git a/src/Horse.Response.pas b/src/Horse.Response.pas index 75804cf..10fbe88 100644 --- a/src/Horse.Response.pas +++ b/src/Horse.Response.pas @@ -43,6 +43,23 @@ THorseResponse = class Res.AddHeader continues to work on both providers without any change. =========================================================================== } FCustomHeaders: {$IF NOT DEFINED(FPC)}TDictionary{$ELSE}TStringList{$ENDIF}; +{ =========================================================================== } +{ =========================================================================== + PATCH-RES-4 — CrossSocket shadow fields + Reason: On the CrossSocket path FWebResponse is nil (no TWebResponse exists). + Every public method that previously wrote to FWebResponse now checks for nil + and falls through to these fields instead. The bridge reads them via the + read-only properties BodyText, ContentStream, and CSContentType. + + FCSStatusCode — integer HTTP status (default 200) + FCSBody — string body set by Send(string) or Send + FCSContentType — Content-Type set by ContentType(string) or SendFile + FCSContentStream — stream body set by SendFile/Download/Render + =========================================================================== } + FCSStatusCode: Integer; + FCSBody: string; + FCSContentType: string; + FCSContentStream: TStream; // non-owning — caller retains ownership { =========================================================================== } public function Send(const AContent: string): THorseResponse; overload; virtual; @@ -81,6 +98,16 @@ THorseResponse = class iterates only; all writes go through AddHeader as before. =========================================================================== } property CustomHeaders: {$IF NOT DEFINED(FPC)}TDictionary{$ELSE}TStringList{$ENDIF} read FCustomHeaders; +{ =========================================================================== } +{ =========================================================================== + PATCH-RES-4 — read-only properties for the CrossSocket bridge + TResponseBridge.Flush reads these to write the response body and + Content-Type to ICrossHttpResponse. All three are populated only when + FWebResponse is nil (CrossSocket path); on the Indy path they are empty. + =========================================================================== } + property BodyText: string read FCSBody; + property ContentStream: TStream read FCSContentStream; + property CSContentType: string read FCSContentType; { =========================================================================== } destructor Destroy; override; end; @@ -98,7 +125,10 @@ implementation function THorseResponse.AddHeader(const AName, AValue: string): THorseResponse; begin - FWebResponse.SetCustomHeader(AName, AValue); +{ PATCH-RES-4 — nil-guard: skip FWebResponse on CrossSocket path } + if Assigned(FWebResponse) then + FWebResponse.SetCustomHeader(AName, AValue); +{ end PATCH-RES-4 } { =========================================================================== PATCH-RES-1 — also populate FCustomHeaders so CrossSocket bridge can read it =========================================================================== } @@ -120,6 +150,13 @@ function THorseResponse.Content: TObject; function THorseResponse.ContentType(const AContentType: string): THorseResponse; begin +{ PATCH-RES-4 — nil-guard } + if not Assigned(FWebResponse) then + begin + FCSContentType := AContentType; + Exit(Self); + end; +{ end PATCH-RES-4 } FWebResponse.ContentType := AContentType; Result := Self; end; @@ -127,10 +164,16 @@ function THorseResponse.ContentType(const AContentType: string): THorseResponse; constructor THorseResponse.Create(const AWebResponse: {$IF DEFINED(FPC)}TResponse{$ELSE}TWebResponse{$ENDIF}); begin FWebResponse := AWebResponse; +{ PATCH-RES-4 — initialise FCSStatusCode to 200 (HTTP OK) } + FCSStatusCode := 200; +{ end PATCH-RES-4 } + if Assigned(FWebResponse) then + begin {$IF DEFINED(FPC)}FWebResponse.Code{$ELSE}FWebResponse.StatusCode{$ENDIF} := THTTPStatus.Ok.ToInteger; {$IF DEFINED(FPC)} - FWebResponse.FreeContentStream := True; + FWebResponse.FreeContentStream := True; {$ENDIF} + end; { =========================================================================== PATCH-RES-1 — initialise FCustomHeaders =========================================================================== } @@ -151,6 +194,12 @@ procedure THorseResponse.Clear; FContent := nil; if Assigned(FCustomHeaders) then FCustomHeaders.Clear; +{ PATCH-RES-4 — wipe CrossSocket shadow fields } + FCSBody := ''; + FCSContentType := ''; + FCSContentStream := nil; // non-owning — never free here + FCSStatusCode := 200; +{ end PATCH-RES-4 } end; { =========================================================================== } @@ -174,6 +223,13 @@ function THorseResponse.RawWebResponse: {$IF DEFINED(FPC)}TResponse{$ELSE}TWebRe function THorseResponse.Send(const AContent: string): THorseResponse; begin +{ PATCH-RES-4 — nil-guard } + if not Assigned(FWebResponse) then + begin + FCSBody := AContent; + Exit(Self); + end; +{ end PATCH-RES-4 } FWebResponse.Content := AContent; Result := Self; end; @@ -186,13 +242,25 @@ function THorseResponse.Send(AContent: T): THorseResponse; function THorseResponse.RedirectTo(const ALocation: string): THorseResponse; begin - FWebResponse.SetCustomHeader('Location', ALocation); +{ PATCH-RES-4 — nil-guard: on CrossSocket path FWebResponse is nil; + AddHeader already dual-writes to FCustomHeaders so Location is captured. + Status delegates to FCSStatusCode when FWebResponse is nil. } + if Assigned(FWebResponse) then + FWebResponse.SetCustomHeader('Location', ALocation) + else + AddHeader('Location', ALocation); +{ end PATCH-RES-4 } Result := Status(THTTPStatus.SeeOther); end; function THorseResponse.RedirectTo(const ALocation: string; const AStatus: THTTPStatus): THorseResponse; begin - FWebResponse.SetCustomHeader('Location', ALocation); +{ PATCH-RES-4 — nil-guard } + if Assigned(FWebResponse) then + FWebResponse.SetCustomHeader('Location', ALocation) + else + AddHeader('Location', ALocation); +{ end PATCH-RES-4 } Result := Status(AStatus); end; @@ -200,9 +268,14 @@ function THorseResponse.RemoveHeader(const AName: string): THorseResponse; var I: Integer; begin - I := FWebResponse.CustomHeaders.IndexOfName(AName); - if I <> -1 then - FWebResponse.CustomHeaders.Delete(I); +{ PATCH-RES-4 — nil-guard: skip FWebResponse access on CrossSocket path } + if Assigned(FWebResponse) then + begin + I := FWebResponse.CustomHeaders.IndexOfName(AName); + if I <> -1 then + FWebResponse.CustomHeaders.Delete(I); + end; +{ end PATCH-RES-4 } { =========================================================================== PATCH-RES-1 — also remove from FCustomHeaders =========================================================================== } @@ -219,26 +292,44 @@ function THorseResponse.RemoveHeader(const AName: string): THorseResponse; function THorseResponse.Status(const AStatus: THTTPStatus): THorseResponse; begin +{ PATCH-RES-4 — nil-guard } + if not Assigned(FWebResponse) then + begin + FCSStatusCode := AStatus.ToInteger; + Exit(Self); + end; +{ end PATCH-RES-4 } {$IF DEFINED(FPC)}FWebResponse.Code{$ELSE}FWebResponse.StatusCode{$ENDIF} := AStatus.ToInteger; Result := Self; end; function THorseResponse.SendFile(const AFileStream: TStream; const AFileName: string; const AContentType: string): THorseResponse; var - LFileName: string; + LFileName: string; + LContentType: string; begin Result := Self; AFileStream.Position := 0; - LFileName := ExtractFileName(AFileName); + LFileName := ExtractFileName(AFileName); + LContentType := AContentType; + if LContentType = EmptyStr then + LContentType := Horse.Mime.THorseMimeTypes.GetFileType(LFileName); + +{ PATCH-RES-4 — nil-guard: CrossSocket path captures stream + type as shadow fields } + if not Assigned(FWebResponse) then + begin + FCSContentStream := AFileStream; // non-owning + FCSContentType := LContentType; + AddHeader('Content-Disposition', Format('inline; filename="%s"', [LFileName])); + Exit; + end; +{ end PATCH-RES-4 } FWebResponse.FreeContentStream := False; FWebResponse.ContentLength := AFileStream.Size; FWebResponse.ContentStream := AFileStream; FWebResponse.SetCustomHeader('Content-Disposition', Format('inline; filename="%s"', [LFileName])); - - FWebResponse.ContentType := AContentType; - if (AContentType = EmptyStr) then - FWebResponse.ContentType := Horse.Mime.THorseMimeTypes.GetFileType(LFileName); + FWebResponse.ContentType := LContentType; {$IF DEFINED(FPC)} FWebResponse.SendContent; @@ -268,20 +359,31 @@ function THorseResponse.SendFile(const AFileName: string; const AContentType: st function THorseResponse.Download(const AFileStream: TStream; const AFileName: string; const AContentType: string): THorseResponse; var - LFileName: string; + LFileName: string; + LContentType: string; begin Result := Self; AFileStream.Position := 0; - LFileName := ExtractFileName(AFileName); + LFileName := ExtractFileName(AFileName); + LContentType := AContentType; + if LContentType = EmptyStr then + LContentType := Horse.Mime.THorseMimeTypes.GetFileType(LFileName); + +{ PATCH-RES-4 — nil-guard } + if not Assigned(FWebResponse) then + begin + FCSContentStream := AFileStream; // non-owning + FCSContentType := LContentType; + AddHeader('Content-Disposition', Format('attachment; filename="%s"', [LFileName])); + Exit; + end; +{ end PATCH-RES-4 } FWebResponse.FreeContentStream := False; FWebResponse.ContentLength := AFileStream.Size; FWebResponse.ContentStream := AFileStream; FWebResponse.SetCustomHeader('Content-Disposition', Format('attachment; filename="%s"', [LFileName])); - - FWebResponse.ContentType := AContentType; - if (AContentType = EmptyStr) then - FWebResponse.ContentType := Horse.Mime.THorseMimeTypes.GetFileType(LFileName); + FWebResponse.ContentType := LContentType; {$IF DEFINED(FPC)} FWebResponse.SendContent; @@ -324,11 +426,22 @@ function THorseResponse.Render(const AFileName: string): THorseResponse; function THorseResponse.Status: Integer; begin +{ PATCH-RES-4 — nil-guard } + if not Assigned(FWebResponse) then + Exit(FCSStatusCode); +{ end PATCH-RES-4 } Result := {$IF DEFINED(FPC)}FWebResponse.Code{$ELSE}FWebResponse.StatusCode{$ENDIF}; end; function THorseResponse.Status(const AStatus: Integer): THorseResponse; begin +{ PATCH-RES-4 — nil-guard } + if not Assigned(FWebResponse) then + begin + FCSStatusCode := AStatus; + Exit(Self); + end; +{ end PATCH-RES-4 } {$IF DEFINED(FPC)}FWebResponse.Code{$ELSE}FWebResponse.StatusCode{$ENDIF} := AStatus; Result := Self; end; diff --git a/src/Horse.pas b/src/Horse.pas index c2399ff..3cc61fa 100644 --- a/src/Horse.pas +++ b/src/Horse.pas @@ -1,4 +1,4 @@ -unit Horse; +unit Horse; {$IF DEFINED(FPC)} {$MODE DELPHI}{$H+} @@ -9,6 +9,9 @@ interface uses {$IF DEFINED(FPC)} SysUtils, + {$IF DEFINED(HORSE_CROSSSOCKET)} + Horse.Provider.CrossSocket, + {$ELSE} Horse.Provider.FPC.HTTPApplication, {$IF DEFINED(HORSE_APACHE)} Horse.Provider.FPC.Apache, @@ -21,9 +24,13 @@ interface {$ELSEIF DEFINED(HORSE_LCL)} Horse.Provider.FPC.LCL, {$ENDIF} + {$ENDIF} {$ELSEIF DEFINED(HORSE_NOPROVIDER)} System.SysUtils, Horse.Provider.Abstract, +{$ELSEIF DEFINED(HORSE_CROSSSOCKET)} + System.SysUtils, + Horse.Provider.CrossSocket, {$ELSE} System.SysUtils, Horse.Provider.Console, @@ -44,7 +51,8 @@ interface Horse.Exception, Horse.Exception.Interrupted, Horse.Core.Param.Config, - Horse.Callback; + Horse.Callback, + Horse.Provider.Config; type EHorseException = Horse.Exception.EHorseException; @@ -65,6 +73,7 @@ interface PHorseModule = Horse.Core.PHorseModule; PHorseCore = Horse.Core.PHorseCore; PHorseRouterTree = Horse.Core.RouterTree.PHorseRouterTree; + THorseCrossSocketConfig = Horse.Provider.Config.THorseCrossSocketConfig; {$IF DEFINED(HORSE_ISAPI)} THorseProvider = Horse.Provider.ISAPI.THorseProvider; @@ -98,10 +107,16 @@ interface THorseProvider = Horse.Provider.FPC.LCL.THorseProvider; {$ELSEIF DEFINED(HORSE_VCL)} THorseProvider = Horse.Provider.VCL.THorseProvider; +{$ELSEIF DEFINED(HORSE_CROSSSOCKET)} + THorseProvider = Horse.Provider.CrossSocket.THorseProviderCrossSocket; {$ELSE} THorseProvider = {$IF DEFINED(FPC)} + {$IF DEFINED(HORSE_CROSSSOCKET)} + Horse.Provider.CrossSocket.THorseProviderCrossSocket; + {$ELSE} Horse.Provider.FPC.HTTPApplication.THorseProvider; + {$ENDIF} {$ELSEIF DEFINED(HORSE_NOPROVIDER)} Horse.Provider.Abstract.THorseProviderAbstract; {$ELSE} From d00dec4d5f0a73566734eeee61006c6ebf078e5f Mon Sep 17 00:00:00 2001 From: freitasjca Date: Fri, 13 Mar 2026 18:40:59 +0000 Subject: [PATCH 5/6] Add CrossSocket provider patches --- src/Horse.pas | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/src/Horse.pas b/src/Horse.pas index 3cc61fa..dfbde31 100644 --- a/src/Horse.pas +++ b/src/Horse.pas @@ -55,6 +55,7 @@ interface Horse.Provider.Config; type +<<<<<<< Updated upstream EHorseException = Horse.Exception.EHorseException; EHorseCallbackInterrupted = Horse.Exception.Interrupted.EHorseCallbackInterrupted; TProc = Horse.Proc.TProc; @@ -74,6 +75,27 @@ interface PHorseCore = Horse.Core.PHorseCore; PHorseRouterTree = Horse.Core.RouterTree.PHorseRouterTree; THorseCrossSocketConfig = Horse.Provider.Config.THorseCrossSocketConfig; +======= + EHorseException = Horse.Exception.EHorseException; + EHorseCallbackInterrupted = Horse.Exception.Interrupted.EHorseCallbackInterrupted; + TProc = Horse.Proc.TProc; + TNextProc = Horse.Proc.TNextProc; + THorseList = Horse.Core.Param.THorseList; + THorseCoreParam = Horse.Core.Param.THorseCoreParam; + THorseCoreParamConfig = Horse.Core.Param.Config.THorseCoreParamConfig; + THorseRequest = Horse.Request.THorseRequest; + THorseResponse = Horse.Response.THorseResponse; + THorseCallback = Horse.Callback.THorseCallback; + THTTPStatus = Horse.Commons.THTTPStatus; + TMimeTypes = Horse.Commons.TMimeTypes; + THorseMimeTypes = Horse.Mime.THorseMimeTypes; + TMessageType = Horse.Commons.TMessageType; + THorseModule = Horse.Core.THorseModule; + PHorseModule = Horse.Core.PHorseModule; + PHorseCore = Horse.Core.PHorseCore; + PHorseRouterTree = Horse.Core.RouterTree.PHorseRouterTree; + THorseCrossSocketConfig = Horse.Provider.Config.THorseCrossSocketConfig; +>>>>>>> Stashed changes {$IF DEFINED(HORSE_ISAPI)} THorseProvider = Horse.Provider.ISAPI.THorseProvider; @@ -101,10 +123,10 @@ interface {$IF DEFINED(FPC)} Horse.Provider.FPC.Daemon.THorseProvider; {$ELSE} - Horse.Provider.Daemon.THorseProvider; + Horse.Provider.Daemon.THorseProvider; {$ENDIF} {$ELSEIF DEFINED(HORSE_LCL)} - THorseProvider = Horse.Provider.FPC.LCL.THorseProvider; + THorseProvider = Horse.Provider.FPC.LCL.THorseProvider; {$ELSEIF DEFINED(HORSE_VCL)} THorseProvider = Horse.Provider.VCL.THorseProvider; {$ELSEIF DEFINED(HORSE_CROSSSOCKET)} @@ -128,4 +150,4 @@ THorse = class(THorseProvider); implementation -end. +end. \ No newline at end of file From 90330ac247afaf22ddf6e5cafaedb8a8392bb9b1 Mon Sep 17 00:00:00 2001 From: freitasjca Date: Fri, 13 Mar 2026 19:17:54 +0000 Subject: [PATCH 6/6] Add CrossSocket provider patches --- src/Horse.pas | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/src/Horse.pas b/src/Horse.pas index dfbde31..e712352 100644 --- a/src/Horse.pas +++ b/src/Horse.pas @@ -55,7 +55,6 @@ interface Horse.Provider.Config; type -<<<<<<< Updated upstream EHorseException = Horse.Exception.EHorseException; EHorseCallbackInterrupted = Horse.Exception.Interrupted.EHorseCallbackInterrupted; TProc = Horse.Proc.TProc; @@ -75,27 +74,6 @@ interface PHorseCore = Horse.Core.PHorseCore; PHorseRouterTree = Horse.Core.RouterTree.PHorseRouterTree; THorseCrossSocketConfig = Horse.Provider.Config.THorseCrossSocketConfig; -======= - EHorseException = Horse.Exception.EHorseException; - EHorseCallbackInterrupted = Horse.Exception.Interrupted.EHorseCallbackInterrupted; - TProc = Horse.Proc.TProc; - TNextProc = Horse.Proc.TNextProc; - THorseList = Horse.Core.Param.THorseList; - THorseCoreParam = Horse.Core.Param.THorseCoreParam; - THorseCoreParamConfig = Horse.Core.Param.Config.THorseCoreParamConfig; - THorseRequest = Horse.Request.THorseRequest; - THorseResponse = Horse.Response.THorseResponse; - THorseCallback = Horse.Callback.THorseCallback; - THTTPStatus = Horse.Commons.THTTPStatus; - TMimeTypes = Horse.Commons.TMimeTypes; - THorseMimeTypes = Horse.Mime.THorseMimeTypes; - TMessageType = Horse.Commons.TMessageType; - THorseModule = Horse.Core.THorseModule; - PHorseModule = Horse.Core.PHorseModule; - PHorseCore = Horse.Core.PHorseCore; - PHorseRouterTree = Horse.Core.RouterTree.PHorseRouterTree; - THorseCrossSocketConfig = Horse.Provider.Config.THorseCrossSocketConfig; ->>>>>>> Stashed changes {$IF DEFINED(HORSE_ISAPI)} THorseProvider = Horse.Provider.ISAPI.THorseProvider;