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..ad6a6b8 100644 --- a/boss.json +++ b/boss.json @@ -1,9 +1,11 @@ { - "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": [], + "dependencies": {} } \ No newline at end of file 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 30f5017..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+} @@ -13,14 +13,26 @@ interface {$ELSE} System.SysUtils, {$ENDIF} - Horse.Core; + Horse.Core, +{ =========================================================================== + PATCH-ABS-1 — added unit 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; @@ -30,8 +42,28 @@ 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 + =========================================================================== } + 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; implementation @@ -58,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; @@ -73,4 +115,31 @@ 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; +{ =========================================================================== } + +{ =========================================================================== + 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 new file mode 100644 index 0000000..56684ed --- /dev/null +++ b/src/Horse.Provider.Config.pas @@ -0,0 +1,151 @@ +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 + +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. + // 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 ─────────────────────────────────────────────── + // 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. + // 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 ───────────────────────────────────────────────────────── + + // 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 + + 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.IoThreads := DEFAULT_IO_THREADS; + + Result.KeepAliveTimeout := 30; + Result.ReadTimeout := 20; + 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 := ''; + 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..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,62 @@ 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 + 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; +{ =========================================================================== } +{ =========================================================================== + 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; @@ -115,6 +179,70 @@ 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 + 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 + 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; +{ 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.Dictionary.Clear; + if Assigned(FQuery) then + FreeAndNil(FQuery); + if Assigned(FParams) then + FParams.Dictionary.Clear; + if Assigned(FContentFields) then + FreeAndNil(FContentFields); + if Assigned(FCookie) then + FreeAndNil(FCookie); + if Assigned(FSessions) then + FreeAndNil(FSessions); + FSessions := THorseSessions.Create; +end; +{ =========================================================================== } + destructor THorseRequest.Destroy; begin if Assigned(FHeaders) then @@ -140,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; @@ -153,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; @@ -160,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 := '/'; @@ -177,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; @@ -228,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(['=']); @@ -294,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; @@ -332,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 9b530c1..10fbe88 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,33 @@ 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}; +{ =========================================================================== } +{ =========================================================================== + 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; function Send(AContent: T): THorseResponse; overload; @@ -46,6 +82,33 @@ 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; +{ =========================================================================== } +{ =========================================================================== + 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; @@ -62,7 +125,15 @@ 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 + =========================================================================== } + FCustomHeaders.AddOrSetValue(AName, AValue); +{ =========================================================================== } Result := Self; end; @@ -79,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; @@ -86,16 +164,55 @@ 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 + =========================================================================== } +{$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; +{ PATCH-RES-4 — wipe CrossSocket shadow fields } + FCSBody := ''; + FCSContentType := ''; + FCSContentStream := nil; // non-owning — never free here + FCSStatusCode := 200; +{ end PATCH-RES-4 } +end; +{ =========================================================================== } + destructor THorseResponse.Destroy; begin if Assigned(FContent) then FContent.Free; +{ =========================================================================== + PATCH-RES-1 — free FCustomHeaders + =========================================================================== } + if Assigned(FCustomHeaders) then + FCustomHeaders.Free; +{ =========================================================================== } inherited; end; @@ -106,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; @@ -118,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; @@ -132,34 +268,68 @@ function THorseResponse.RemoveHeader(const AName: string): THorseResponse; var I: Integer; begin - I := FWebResponse.CustomHeaders.IndexOfName(AName); +{ 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 + =========================================================================== } +{$IF NOT DEFINED(FPC)} + FCustomHeaders.Remove(AName); +{$ELSE} + I := FCustomHeaders.IndexOfName(AName); if I <> -1 then - FWebResponse.CustomHeaders.Delete(I); + FCustomHeaders.Delete(I); +{$ENDIF} +{ =========================================================================== } Result := Self; end; 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; @@ -189,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; @@ -245,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..e712352 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; @@ -92,16 +101,22 @@ 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)} + 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} @@ -113,4 +128,4 @@ THorse = class(THorseProvider); implementation -end. +end. \ No newline at end of file