Thanks Michael and Andrew.
Michael Van Canneyt wrote:
> I plan a set of socket options in TSocketServer;
> I have the same problem as you, I just need a free moment to
> implement it :-)
Great, then I'll wait for your implementation.
I've done some changes in my local copy to get things working
until better implementation is ready.
In case you are interested I'm attaching a diff of these changes
(sorry, they got mixed with my earlier patch for #20370)
> Configurable seems like the best option.
In the attached diff there is boolean ReuseAddress property
for TCustomHTTPApplication. The drawback of this approach is that
it's not uniform with TCustomFCgiApplication.ProtocolOptions
(serving the same purpose for FCGI application). The advantage
is that it does not declare new data structures and thus does
not force us to add more lower-level units into main program's
uses clause.
Index: src/base/custhttpapp.pp
===================================================================
--- src/base/custhttpapp.pp (revision 19236)
+++ src/base/custhttpapp.pp (working copy)
@@ -43,10 +43,12 @@
function GetAllowConnect: TConnectQuery;
function GetPort: Word;
function GetQueueSize: Word;
+ function GetReuseAddress: Boolean;
function GetThreaded: Boolean;
procedure SetOnAllowConnect(const AValue: TConnectQuery);
procedure SetPort(const AValue: Word);
procedure SetQueueSize(const AValue: Word);
+ procedure SetReuseAddress(AValue: Boolean);
procedure SetThreaded(const AValue: Boolean);
protected
function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
@@ -64,6 +66,8 @@
Property OnAllowConnect : TConnectQuery Read GetAllowConnect Write SetOnAllowConnect;
// Use a thread to handle a connection ?
property Threaded : Boolean read GetThreaded Write SetThreaded;
+ // Reuse socket address on Unix platforms (enables SO_REUSEADDR socket option)
+ property ReuseAddress : Boolean Read GetReuseAddress Write SetReuseAddress;
end;
{ TCustomHTTPApplication }
@@ -73,10 +77,12 @@
function GetAllowConnect: TConnectQuery;
function GetPort: Word;
function GetQueueSize: Word;
+ function GetReuseAddress: Boolean;
function GetThreaded: Boolean;
procedure SetOnAllowConnect(const AValue: TConnectQuery);
procedure SetPort(const AValue: Word);
procedure SetQueueSize(const AValue: Word);
+ procedure SetReuseAddress(const AValue: Boolean);
procedure SetThreaded(const AValue: Boolean);
protected
function InitializeWebHandler: TWebHandler; override;
@@ -89,6 +95,8 @@
Property OnAllowConnect : TConnectQuery Read GetAllowConnect Write SetOnAllowConnect;
// Use a thread to handle a connection ?
property Threaded : Boolean read GetThreaded Write SetThreaded;
+ // Reuse socket address on Unix platforms (enables SO_REUSEADDR socket option)
+ property ReuseAddress : Boolean Read GetReuseAddress Write SetReuseAddress;
end;
ResourceString
@@ -124,6 +132,11 @@
Result:=HTTPHandler.QueueSize;
end;
+function TCustomHTTPApplication.GetReuseAddress: Boolean;
+begin
+ Result:=HTTPHandler.ReuseAddress;
+end;
+
function TCustomHTTPApplication.GetThreaded: Boolean;
begin
Result:=HTTPHandler.Threaded;
@@ -144,6 +157,11 @@
HTTPHandler.QueueSize:=Avalue;
end;
+procedure TCustomHTTPApplication.SetReuseAddress(const AValue: Boolean);
+begin
+ HTTPHandler.ReuseAddress := AValue;
+end;
+
procedure TCustomHTTPApplication.SetThreaded(const AValue: Boolean);
begin
HTTPHandler.Threaded:=Avalue;
@@ -190,6 +208,11 @@
Result:=FServer.QueueSize;
end;
+function TFPHTTPServerHandler.GetReuseAddress: Boolean;
+begin
+ Result:=FServer.ReuseAddress;
+end;
+
function TFPHTTPServerHandler.GetThreaded: Boolean;
begin
Result:=FServer.Threaded;
@@ -210,6 +233,11 @@
FServer.QueueSize:=Avalue
end;
+procedure TFPHTTPServerHandler.SetReuseAddress(AValue: Boolean);
+begin
+ FServer.ReuseAddress:=AValue;
+end;
+
procedure TFPHTTPServerHandler.SetThreaded(const AValue: Boolean);
begin
FServer.Threaded:=AValue;
Index: src/base/fphttpserver.pp
===================================================================
--- src/base/fphttpserver.pp (revision 19236)
+++ src/base/fphttpserver.pp (working copy)
@@ -20,7 +20,7 @@
interface
uses
- Classes, SysUtils, ssockets, httpdefs;
+ Classes, SysUtils, sockets, ssockets, resolve, httpdefs;
Const
ReadBufLen = 4096;
@@ -35,8 +35,12 @@
TFPHTTPConnectionRequest = Class(TRequest)
private
FConnection: TFPHTTPConnection;
+ FRemoteAddress: String;
+ FServerPort: String;
protected
+ function GetFieldValue(AIndex : Integer) : String; override;
procedure SetContent(AValue : String);
+ procedure SetFieldValue(Index : Integer; Value : String); override;
published
Property Connection : TFPHTTPConnection Read FConnection;
end;
@@ -100,6 +104,7 @@
FOnRequest: THTTPServerRequestHandler;
FPort: Word;
FQueueSize: Word;
+ FReuseAddress: Boolean;
FServer : TInetServer;
FLoadActivate : Boolean;
FServerBanner: string;
@@ -109,6 +114,7 @@
procedure SetOnAllowConnect(const AValue: TConnectQuery);
procedure SetPort(const AValue: Word);
procedure SetQueueSize(const AValue: Word);
+ procedure SetReuseAddress(AValue: Boolean);
procedure SetThreaded(const AValue: Boolean);
Protected
// Create a connection handling object.
@@ -140,6 +146,8 @@
Property OnAllowConnect : TConnectQuery Read FOnAllowConnect Write SetOnAllowConnect;
// Use a thread to handle a connection ?
property Threaded : Boolean read FThreaded Write SetThreaded;
+ // Reuse socket address on Unix platforms (enables SO_REUSEADDR socket option)
+ property ReuseAddress : Boolean read FReuseAddress Write SetReuseAddress;
// Called to handle the request. If Threaded=True, it is called in a the connection thread.
Property OnRequest : THTTPServerRequestHandler Read FOnRequest Write FOnRequest;
@@ -221,6 +229,41 @@
end;
end;
+Function SocketAddrToString(ASocketAddr: TSockAddr): String;
+begin
+ if ASocketAddr.sa_family = AF_INET then
+ Result := NetAddrToStr(ASocketAddr.sin_addr)
+ else // no ipv6 support yet
+ Result := '';
+end;
+
+Function GetHostNameByAddress(const AnAddress: String): String;
+var
+ Resolver: THostResolver;
+begin
+ Result := '';
+ if AnAddress = '' then exit;
+
+ Resolver := THostResolver.Create(nil);
+ try
+ if Resolver.AddressLookup(AnAddress) then
+ Result := Resolver.ResolvedName
+ finally
+ FreeAndNil(Resolver);
+ end;
+end;
+
+function TFPHTTPConnectionRequest.GetFieldValue(AIndex: Integer): String;
+begin
+ case AIndex of
+ 27 : Result := FRemoteAddress;
+ 28 : Result := GetHostNameByAddress(FRemoteAddress); // Remote Host
+ 30 : Result := FServerPort;
+ else
+ Result := inherited GetFieldValue(AIndex);
+ end;
+end;
+
procedure TFPHTTPConnectionRequest.SetContent(AValue : String);
begin
@@ -228,6 +271,17 @@
FContentRead:=true;
InitRequestVars;
end;
+
+procedure TFPHTTPConnectionRequest.SetFieldValue(Index: Integer; Value: String);
+begin
+ case Index of
+ 27 : FRemoteAddress := Value;
+ 30 : FServerPort := Value;
+ else
+ inherited SetFieldValue(Index, Value);
+ end;
+end;
+
(*
Procedure TFPHTTPConnectionRequest.SetFieldValue(Index : Integer; Value : String);
@@ -437,6 +491,9 @@
if (S<>'') then
InterPretHeader(Result,S);
Until (S='');
+
+ Result.RemoteAddress := SocketAddrToString(FSocket.RemoteAddress);
+ Result.ServerPort := FServer.Port;
end;
constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream);
@@ -550,6 +607,13 @@
FQueueSize:=AValue;
end;
+procedure TFPCustomHttpServer.SetReuseAddress(AValue: Boolean);
+begin
+ if FReuseAddress=AValue then exit;
+ CheckInactive;
+ FReuseAddress:=AValue;
+end;
+
procedure TFPCustomHttpServer.SetThreaded(const AValue: Boolean);
begin
if FThreaded=AValue then exit;
@@ -596,8 +660,18 @@
end;
procedure TFPCustomHttpServer.CreateServerSocket;
+var
+ TrueValue: Integer;
begin
FServer:=TInetServer.Create(FPort);
+ {$IFDEF Unix}
+ if ReuseAddress then
+ begin
+ // remedy socket port locking on Posix platforms
+ TrueValue := 1;
+ fpSetSockOpt(FServer.Socket, SOL_SOCKET, SO_REUSEADDR, @TrueValue, SizeOf(TrueValue));
+ end;
+ {$ENDIF}
FServer.MaxConnections:=-1;
FServer.OnConnectQuery:=OnAllowConnect;
FServer.OnConnect:=@DOConnect;
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
