Merge pull request #52 from risoflora/custom-hostname-support

Implement custom host name support
risoflora · Feb 14, 2024 · 13ac175 · 13ac175
2 parents b86ffff + 0248fb3
commit 13ac175
Show file tree

Hide file tree

Showing 6 changed files with 94 additions and 17 deletions.
diff --git a/.gitignore b/.gitignore
@@ -143,3 +143,6 @@ Test_StringMap
 Test_URLEntryPoints
 Test_URLRouter
 Test_Utility
+
+# Temp files
+.DS_Store
diff --git a/Package/BrookTardigrade.dproj b/Package/BrookTardigrade.dproj
@@ -59,7 +59,7 @@
         <SanitizedProjectName>BrookTardigrade</SanitizedProjectName>
         <VerInfo_Locale>1033</VerInfo_Locale>
         <DCC_UnitSearchPath>..\Source;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
-        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=5.6.1.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=5.6.1.0;Comments=</VerInfo_Keys>
+        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=5.7.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=5.7.0.0;Comments=</VerInfo_Keys>
         <VerInfo_MajorVer>5</VerInfo_MajorVer>
         <DCC_Description>Brook is microframework which helps to develop web Pascal applications.</DCC_Description>
     </PropertyGroup>
@@ -70,7 +70,7 @@
         <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
         <BT_BuildType>Debug</BT_BuildType>
         <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
-        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=5.6.1.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=5.6.1.0;Comments=</VerInfo_Keys>
+        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=5.7.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=5.7.0.0;Comments=</VerInfo_Keys>
         <VerInfo_Locale>1033</VerInfo_Locale>
         <DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
     </PropertyGroup>
@@ -88,8 +88,8 @@
     <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
         <DCC_RemoteDebug>false</DCC_RemoteDebug>
         <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
-        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=5.6.1.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=5.6.1.0;Comments=</VerInfo_Keys>
-        <VerInfo_MinorVer>5</VerInfo_MinorVer>
+        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=5.7.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=5.7.0.0;Comments=</VerInfo_Keys>
+        <VerInfo_MinorVer>7</VerInfo_MinorVer>
     </PropertyGroup>
     <PropertyGroup Condition="'$(Cfg_2)'!=''">
         <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>

diff --git a/Package/BrookTardigrade.lpk b/Package/BrookTardigrade.lpk
@@ -1,6 +1,6 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <Package Version="4">
+  <Package Version="5">
     <Name Value="BrookTardigrade"/>
     <Type Value="RunAndDesignTime"/>
     <Author Value="Silvio Clecio (silvioprog)"/>
@@ -28,7 +28,7 @@ Lesser General Public License for more details.
 You should have received a copy of the GNU Lesser General Public
 License along with Brook framework; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA"/>
-    <Version Major="5" Minor="6" Release="1"/>
+    <Version Major="5" Minor="7"/>
     <Files Count="23">
       <Item1>
         <Filename Value="../Source/BrookDefines.inc"/>
@@ -124,6 +124,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA"/
         <UnitName Value="BrookIDEIntegration"/>
       </Item23>
     </Files>
+    <CompatibilityMode Value="True"/>
     <RequiredPkgs Count="1">
       <Item1>
         <PackageName Value="IDEIntf"/>

diff --git a/Source/BrookExtra.pas b/Source/BrookExtra.pas
@@ -39,6 +39,8 @@ interface
   { Default upload(s) limit (in bytes). }
   BROOK_UPLOADS_LIMIT = {$IFDEF CPUARM}16777216{~16MB}{$ELSE}67108864{~64MB}{$ENDIF};
 
+  { Default maximum length of the queue of pending connections. }
+  BROOK_BACKLOG = 511;
   { Default minimal buffer size (in bytes). }
   BROOK_MIN_BUFFER_SIZE = 128;
   { Default buffer size (in bytes). }

diff --git a/Source/BrookHTTPServer.pas b/Source/BrookHTTPServer.pas
@@ -132,6 +132,8 @@   TBrookHTTPServer = class(TBrookHandledComponent)
   private
     FHandle: Psg_httpsrv;
     FAuthenticated: Boolean;
+    FHostName: string;
+    FBacklog: Word;
     FConnectionLimit: Cardinal;
     FConnectionTimeout: Cardinal;
     FNoFavicon: Boolean;
@@ -165,6 +167,8 @@   TBrookHTTPServer = class(TBrookHandledComponent)
     function GetUploadsDir: string;
     function IsActiveStored: Boolean;
     function IsAuthenticatedStored: Boolean;
+    function IsHostNameStored: Boolean;
+    function IsBacklogStored: Boolean;
     function IsConnectionLimitStored: Boolean;
     function IsConnectionTimeoutStored: Boolean;
     function IsNoFaviconStored: Boolean;
@@ -176,6 +180,8 @@   TBrookHTTPServer = class(TBrookHandledComponent)
     function IsThreadPoolSizeStored: Boolean;
     function IsUploadsDirStored: Boolean;
     procedure SetAuthenticated(AValue: Boolean);
+    procedure SetHostName(const AValue: string);
+    procedure SetBacklog(AValue: Word);
     procedure SetConnectionLimit(AValue: Cardinal);
     procedure SetConnectionTimeout(AValue: Cardinal);
     procedure SetPayloadLimit(AValue: NativeUInt);
@@ -258,9 +264,15 @@   TBrookHTTPServer = class(TBrookHandledComponent)
     { Enables/disables the basic HTTP authentication. }
     property Authenticated: Boolean read FAuthenticated write SetAuthenticated
       stored IsAuthenticatedStored;
+    { Host name for listening to connections. }
+    property HostName: string read FHostName write SetHostName
+      stored IsHostNameStored;
     { Port for listening to connections. }
     property Port: UInt16 read GetPort write SetPort stored IsPortStored
       default 0;
+    { Maximum length of the queue of pending connections. Default: 511. }
+    property Backlog: Word read FBacklog write SetBacklog stored IsBacklogStored
+      default BROOK_BACKLOG;
     { Enables/disables the threaded model. If @true, the server creates one
       thread per connection. }
     property Threaded: Boolean read GetThreaded write SetThreaded
@@ -369,6 +381,7 @@ constructor TBrookHTTPServer.Create(AOwner: TComponent);
   inherited Create(AOwner);
   FSecurity := CreateSecurity;
   SgLib.UnloadEvents.Add(InternalLibUnloadEvent, Self);
+  FBacklog := BROOK_BACKLOG;
   FPostBufferSize := BROOK_POST_BUFFER_SIZE;
   FPayloadLimit := BROOK_PAYLOAD_LIMIT;
   FUploadsLimit := BROOK_UPLOADS_LIMIT;
@@ -884,6 +897,16 @@ function TBrookHTTPServer.IsAuthenticatedStored: Boolean;
   Result := FAuthenticated;
 end;
 
+function TBrookHTTPServer.IsHostNameStored: Boolean;
+begin
+  Result := FHostName <> EmptyStr;
+end;
+
+function TBrookHTTPServer.IsBacklogStored: Boolean;
+begin
+  Result := FBacklog <> BROOK_BACKLOG;
+end;
+
 function TBrookHTTPServer.IsPortStored: Boolean;
 begin
   Result := FPort <> 0;
@@ -920,6 +943,20 @@ procedure TBrookHTTPServer.SetAuthenticated(AValue: Boolean);
   FAuthenticated := AValue;
 end;
 
+procedure TBrookHTTPServer.SetHostName(const AValue: string);
+begin
+  if not FStreamedActive then
+    CheckInactive;
+  FHostName := AValue;
+end;
+
+procedure TBrookHTTPServer.SetBacklog(AValue: Word);
+begin
+  if not FStreamedActive then
+    CheckInactive;
+  FBacklog := AValue;
+end;
+
 procedure TBrookHTTPServer.SetActive(AValue: Boolean);
 begin
   if AValue = FActive then
@@ -976,18 +1013,40 @@ procedure TBrookHTTPServer.DoOpen;
   if FSecurity.Active then
   begin
     FSecurity.Validate;
-    if not Assigned(sg_httpsrv_tls_listen3) then
-      raise ENotSupportedException.Create(SBrookTLSNotAvailable);
-    FActive := sg_httpsrv_tls_listen3(FHandle,
-      M.ToCNullableString(FSecurity.PrivateKey),
-      M.ToCNullableString(FSecurity.PrivatePassword),
-      M.ToCNullableString(FSecurity.Certificate),
-      M.ToCNullableString(FSecurity.Trust),
-      M.ToCNullableString(FSecurity.DHParams),
-      M.ToCNullableString(FSecurity.Priorities), FPort, FThreaded);
+    if FHostName <> EmptyStr then
+    begin
+      if not Assigned(sg_httpsrv_tls_listen3) then
+        raise ENotSupportedException.Create(SBrookTLSNotAvailable);
+      FActive := sg_httpsrv_tls_listen3(FHandle,
+        M.ToCNullableString(FSecurity.PrivateKey),
+        M.ToCNullableString(FSecurity.PrivatePassword),
+        M.ToCNullableString(FSecurity.Certificate),
+        M.ToCNullableString(FSecurity.Trust),
+        M.ToCNullableString(FSecurity.DHParams),
+        M.ToCNullableString(FSecurity.Priorities), FPort, FThreaded);
+    end
+    else
+    begin
+      if not Assigned(sg_httpsrv_tls_listen4) then
+        raise ENotSupportedException.Create(SBrookTLSNotAvailable);
+      FActive := sg_httpsrv_tls_listen4(FHandle,
+        M.ToCNullableString(FSecurity.PrivateKey),
+        M.ToCNullableString(FSecurity.PrivatePassword),
+        M.ToCNullableString(FSecurity.Certificate),
+        M.ToCNullableString(FSecurity.Trust),
+        M.ToCNullableString(FSecurity.DHParams),
+        M.ToCNullableString(FSecurity.Priorities), M.ToCString(FHostName),
+        FPort, FBacklog, FThreaded);
+    end;
   end
   else
-    FActive := sg_httpsrv_listen(FHandle, FPort, FThreaded);
+  begin
+    if FHostName <> EmptyStr then
+      FActive := sg_httpsrv_listen2(FHandle, M.ToCString(FHostName), FPort,
+        FBacklog, FThreaded)
+    else
+      FActive := sg_httpsrv_listen(FHandle, FPort, FThreaded);
+  end;
   if not FActive then
     InternalFreeServerHandle
   else

diff --git a/Source/libsagui.pas b/Source/libsagui.pas
@@ -60,7 +60,7 @@ interface
 const
   SG_VERSION_MAJOR = 3;
 
-  SG_VERSION_MINOR = 4;
+  SG_VERSION_MINOR = 5;
 
   SG_VERSION_PATCH = 0;
 
@@ -445,6 +445,11 @@ function sg_httpres_zrender(res: Psg_httpres;
 
   sg_httpsrv_free: procedure(srv: Psg_httpsrv); cdecl;
 
+  sg_httpsrv_tls_listen4: function(srv: Psg_httpsrv; const key: Pcchar;
+    const pwd: Pcchar; const cert: Pcchar; const trust: Pcchar;
+    const dhparams: Pcchar; const priorities: Pcchar; const hostname: Pcchar;
+    port: cuint16_t; backlog: cuint; threaded: cbool): cbool; cdecl;
+
   sg_httpsrv_tls_listen3: function(srv: Psg_httpsrv; const key: Pcchar;
     const pwd: Pcchar; const cert: Pcchar; const trust: Pcchar;
     const dhparams: Pcchar; const priorities: Pcchar; port: cuint16_t;
@@ -457,6 +462,9 @@ function sg_httpres_zrender(res: Psg_httpres;
   sg_httpsrv_tls_listen: function(srv: Psg_httpsrv; const key: Pcchar;
     const cert: Pcchar; port: cuint16_t; threaded: cbool): cbool; cdecl;
 
+  sg_httpsrv_listen2: function(srv: Psg_httpsrv; hostname: Pcchar;
+    port: cuint16_t; backlog: cuint; threaded: cbool): cbool; cdecl;
+
   sg_httpsrv_listen: function(srv: Psg_httpsrv; port: cuint16_t;
     threaded: cbool): cbool; cdecl;
 
@@ -1106,9 +1114,11 @@ class function SgLib.InternalLoad(const AName: TFileName): TLibHandle;
     sg_httpsrv_new2 := GetProcAddress(GHandle, 'sg_httpsrv_new2');
     sg_httpsrv_new := GetProcAddress(GHandle, 'sg_httpsrv_new');
     sg_httpsrv_free := GetProcAddress(GHandle, 'sg_httpsrv_free');
+    sg_httpsrv_tls_listen4 := GetProcAddress(GHandle, 'sg_httpsrv_tls_listen4');
     sg_httpsrv_tls_listen3 := GetProcAddress(GHandle, 'sg_httpsrv_tls_listen3');
     sg_httpsrv_tls_listen2 := GetProcAddress(GHandle, 'sg_httpsrv_tls_listen2');
     sg_httpsrv_tls_listen := GetProcAddress(GHandle, 'sg_httpsrv_tls_listen');
+    sg_httpsrv_listen2 := GetProcAddress(GHandle, 'sg_httpsrv_listen2');
     sg_httpsrv_listen := GetProcAddress(GHandle, 'sg_httpsrv_listen');
     sg_httpsrv_shutdown := GetProcAddress(GHandle, 'sg_httpsrv_shutdown');
     sg_httpsrv_port := GetProcAddress(GHandle, 'sg_httpsrv_port');
@@ -1308,9 +1318,11 @@ class function SgLib.Unload: TLibHandle;
     sg_httpsrv_new2 := nil;
     sg_httpsrv_new := nil;
     sg_httpsrv_free := nil;
+    sg_httpsrv_tls_listen4 := nil;
     sg_httpsrv_tls_listen3 := nil;
     sg_httpsrv_tls_listen2 := nil;
     sg_httpsrv_tls_listen := nil;
+    sg_httpsrv_listen2 := nil;
     sg_httpsrv_listen := nil;
     sg_httpsrv_shutdown := nil;
     sg_httpsrv_port := nil;