From 62e50ca5069d8ecd707f8893e4a2cd73ee6a0583 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Sat, 18 Apr 2015 06:12:07 +0000
Subject: [PATCH] * Patch from Luca Olivetti to allow to specify an address to
 which server must bind (bug ID 27892)

git-svn-id: trunk@30639 -
---
 packages/fcl-web/src/base/custhttpapp.pp  | 27 +++++++++++++++++++++++
 packages/fcl-web/src/base/fphttpserver.pp | 16 +++++++++++++-
 2 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/packages/fcl-web/src/base/custhttpapp.pp b/packages/fcl-web/src/base/custhttpapp.pp
index 234edbfbff..69501fc571 100644
--- a/packages/fcl-web/src/base/custhttpapp.pp
+++ b/packages/fcl-web/src/base/custhttpapp.pp
@@ -48,10 +48,12 @@ Type
     FOnRequestError: TRequestErrorHandler;
     FServer: TEmbeddedHTTPServer;
     function GetAllowConnect: TConnectQuery;
+    function GetAddress: string;
     function GetPort: Word;
     function GetQueueSize: Word;
     function GetThreaded: Boolean;
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
+    procedure SetAddress(const AValue: string);
     procedure SetPort(const AValue: Word);
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
@@ -70,6 +72,8 @@ Type
     Procedure Terminate; override;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    // Address to listen on.
+    Property Address : string Read GetAddress Write SetAddress;
     // Port to listen on.
     Property Port : Word Read GetPort Write SetPort Default 80;
     // Max connections on queue (for Listen call)
@@ -91,10 +95,12 @@ Type
     function GetLookupHostNames : Boolean;
     Procedure SetLookupHostnames(Avalue : Boolean);
     function GetAllowConnect: TConnectQuery;
+    function GetAddress: String;
     function GetPort: Word;
     function GetQueueSize: Word;
     function GetThreaded: Boolean;
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
+    procedure SetAddress(const AValue: string);
     procedure SetPort(const AValue: Word);
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
@@ -102,6 +108,7 @@ Type
     function InitializeWebHandler: TWebHandler; override;
     Function HTTPHandler : TFPHTTPServerHandler;
   Public
+    Property Address : string Read GetAddress Write SetAddress;
     Property Port : Word Read GetPort Write SetPort Default 80;
     // Max connections on queue (for Listen call)
     Property QueueSize : Word Read GetQueueSize Write SetQueueSize Default 5;
@@ -153,6 +160,11 @@ begin
   Result:=HTTPHandler.OnAllowConnect;
 end;
 
+function TCustomHTTPApplication.GetAddress: String;
+begin
+  Result:=HTTPHandler.Address;
+end;
+
 function TCustomHTTPApplication.GetPort: Word;
 begin
   Result:=HTTPHandler.Port;
@@ -173,6 +185,11 @@ begin
   HTTPHandler.OnAllowConnect:=AValue;
 end;
 
+procedure TCustomHTTPApplication.SetAddress(const AValue: string);
+begin
+  HTTPHandler.Address:=Avalue;
+end;
+
 procedure TCustomHTTPApplication.SetPort(const AValue: Word);
 begin
   HTTPHandler.Port:=Avalue;
@@ -245,6 +262,11 @@ begin
   Result:=FServer.OnAllowConnect;
 end;
 
+function TFPHTTPServerHandler.GetAddress: string;
+begin
+  Result:=FServer.Address;
+end;
+
 function TFPHTTPServerHandler.GetPort: Word;
 begin
   Result:=FServer.Port;
@@ -265,6 +287,11 @@ begin
   FServer.OnAllowConnect:=Avalue
 end;
 
+procedure TFPHTTPServerHandler.SetAddress(const AValue: string);
+begin
+  FServer.Address:=AValue
+end;
+
 procedure TFPHTTPServerHandler.SetPort(const AValue: Word);
 begin
   FServer.Port:=Avalue
diff --git a/packages/fcl-web/src/base/fphttpserver.pp b/packages/fcl-web/src/base/fphttpserver.pp
index 6691e736a0..816280821d 100644
--- a/packages/fcl-web/src/base/fphttpserver.pp
+++ b/packages/fcl-web/src/base/fphttpserver.pp
@@ -111,6 +111,7 @@ Type
     FOnAllowConnect: TConnectQuery;
     FOnRequest: THTTPServerRequestHandler;
     FOnRequestError: TRequestErrorHandler;
+    FAddress: string;
     FPort: Word;
     FQueueSize: Word;
     FServer : TInetServer;
@@ -122,6 +123,7 @@ Type
     function GetActive: Boolean;
     procedure SetActive(const AValue: Boolean);
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
+    procedure SetAddress(const AValue: string);
     procedure SetPort(const AValue: Word);
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
@@ -164,6 +166,8 @@ Type
   protected
     // Set to true to start listening.
     Property Active : Boolean Read GetActive Write SetActive Default false;
+    // Address to listen on.
+    Property Address : string Read FAddress Write SetAddress;
     // Port to listen on.
     Property Port : Word Read FPort Write SetPort Default 80;
     // Max connections on queue (for Listen call)
@@ -683,6 +687,13 @@ begin
   FOnAllowConnect:=AValue;
 end;
 
+procedure TFPCustomHttpServer.SetAddress(const AValue: string);
+begin
+  if FAddress=AValue then exit;
+  CheckInactive;
+  FAddress:=AValue;
+end;
+
 procedure TFPCustomHttpServer.SetPort(const AValue: Word);
 begin
   if FPort=AValue then exit;
@@ -773,7 +784,10 @@ end;
 
 procedure TFPCustomHttpServer.CreateServerSocket;
 begin
-  FServer:=TInetServer.Create(FPort);
+  if FAddress='' then
+    FServer:=TInetServer.Create(FPort)
+  else
+    FServer:=TInetServer.Create(FAddress,FPort);
   FServer.MaxConnections:=-1;
   FServer.OnConnectQuery:=OnAllowConnect;
   FServer.OnConnect:=@DOConnect;