paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 13:59:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Luca Olivetti to allow to specify an address to which server must bind (bug ID 27892)

Browse Source 
git-svn-id: trunk@30639 -
This commit is contained in:
michael 2015-04-18 06:12:07 +00:00
parent 75ec4adcf9
commit 62e50ca506
2 changed files with 42 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
packages/fcl-web/src/base/custhttpapp.pp
View File

@ -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

16
packages/fcl-web/src/base/fphttpserver.pp
View File

@ -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;