Browse Source

Remove the KeepAlive* properties from TFPCustomHttpServer, rename KeepAliveEnabled to EnableKeepAlive

Ondrej Pokorny 4 years ago
parent
commit
6a2f596b8e

+ 18 - 5
packages/fcl-web/examples/httpserver/threadedhttpserver.pas

@@ -7,13 +7,18 @@ uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   cthreads,
   {$ENDIF}{$ENDIF}
   {$ENDIF}{$ENDIF}
-  sysutils, Classes, fphttpserver, fpmimetypes, testhttpserver, syncobjs;
+  sysutils, Classes, fphttpserver, fpmimetypes, testhttpserver, syncobjs, ssockets;
 
 
 Type
 Type
+  THTTPServer = class(TTestHTTPServer)
+  protected
+    function CreateConnection(Data: TSocketStream): TFPHTTPConnection; override;
+  end;
+
   TServerThread = class(TThread)
   TServerThread = class(TThread)
   private
   private
     FCSWriteln: TCriticalSection;
     FCSWriteln: TCriticalSection;
-    FServ : TTestHTTPServer;
+    FServ : THTTPServer;
     procedure ServOnIdle(Sender: TObject);
     procedure ServOnIdle(Sender: TObject);
     procedure WriteInfo(S: string);
     procedure WriteInfo(S: string);
   public
   public
@@ -22,6 +27,16 @@ Type
     destructor Destroy; override;
     destructor Destroy; override;
   end;
   end;
 
 
+{ THTTPServer }
+
+function THTTPServer.CreateConnection(Data: TSocketStream): TFPHTTPConnection;
+begin
+  Result := inherited CreateConnection(Data);
+  Result.Socket.IOTimeout := 15*1000;
+  Result.EnableKeepAlive := True;
+  Result.KeepAliveTimeout := 60*1000;
+end;
+
 { TServerThread }
 { TServerThread }
 
 
 constructor TServerThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
 constructor TServerThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
@@ -30,14 +45,12 @@ begin
 
 
   FCSWriteln := TCriticalSection.Create;
   FCSWriteln := TCriticalSection.Create;
 
 
-  FServ:=TTestHTTPServer.Create(Nil);
+  FServ:=THTTPServer.Create(Nil);
   FServ.BaseDir:=ExtractFilePath(ParamStr(0));
   FServ.BaseDir:=ExtractFilePath(ParamStr(0));
 {$ifdef unix}
 {$ifdef unix}
   FServ.MimeTypesFile:='/etc/mime.types';
   FServ.MimeTypesFile:='/etc/mime.types';
 {$endif}
 {$endif}
   FServ.Threaded:=True;
   FServ.Threaded:=True;
-  FServ.KeepAliveEnabled:=True;
-  FServ.KeepAliveTimeout:=60*1000;
   FServ.Port:=8080;
   FServ.Port:=8080;
   FServ.WriteInfo := @WriteInfo;
   FServ.WriteInfo := @WriteInfo;
   FServ.AcceptIdleTimeout := 500;
   FServ.AcceptIdleTimeout := 500;

+ 10 - 17
packages/fcl-web/src/base/fphttpserver.pp

@@ -65,7 +65,7 @@ Type
     FSocket: TSocketStream;
     FSocket: TSocketStream;
     FSetupSocket : Boolean;
     FSetupSocket : Boolean;
     FBuffer : Ansistring;
     FBuffer : Ansistring;
-    FKeepAliveEnabled : Boolean;
+    FEnableKeepAlive : Boolean;
     FKeepAlive : Boolean;
     FKeepAlive : Boolean;
     FKeepAliveTimeout : Integer;
     FKeepAliveTimeout : Integer;
     procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String);
     procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String);
@@ -85,8 +85,12 @@ Type
     Property Server : TFPCustomHTTPServer Read FServer;
     Property Server : TFPCustomHTTPServer Read FServer;
     Property OnRequestError : TRequestErrorHandler Read FOnError Write FOnError;
     Property OnRequestError : TRequestErrorHandler Read FOnError Write FOnError;
     Property LookupHostNames : Boolean Read GetLookupHostNames;
     Property LookupHostNames : Boolean Read GetLookupHostNames;
-    Property KeepAliveEnabled: Boolean read FKeepAliveEnabled write FKeepAliveEnabled;
+
+    // Set to true if you want to support HTTP 1.1 connection: keep-alive - only available for threaded server
+    Property EnableKeepAlive: Boolean read FEnableKeepAlive write FEnableKeepAlive;
+    // time-out for keep-alive: how many ms should the server keep the connection alive after a request has been handled
     Property KeepAliveTimeout: Integer read FKeepAliveTimeout write FKeepAliveTimeout;
     Property KeepAliveTimeout: Integer read FKeepAliveTimeout write FKeepAliveTimeout;
+    // is the current connection set up for KeepAlive?
     Property KeepAlive: Boolean read FKeepAlive;
     Property KeepAlive: Boolean read FKeepAlive;
   end;
   end;
 
 
@@ -133,8 +137,6 @@ Type
     FConnectionThreadList: TThreadList;
     FConnectionThreadList: TThreadList;
     FConnectionCount : Integer;
     FConnectionCount : Integer;
     FUseSSL: Boolean;
     FUseSSL: Boolean;
-    FKeepAliveEnabled: Boolean;
-    FKeepAliveTimeout: Integer;
     procedure DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler);
     procedure DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler);
     function GetActive: Boolean;
     function GetActive: Boolean;
     function GetHostName: string;
     function GetHostName: string;
@@ -227,11 +229,6 @@ Type
     Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
     Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
     // Called after create socket handler was created, with the created socket handler.
     // Called after create socket handler was created, with the created socket handler.
     Property AfterSocketHandlerCreate : TSocketHandlerCreatedEvent Read FAfterSocketHandlerCreated Write FAfterSocketHandlerCreated;
     Property AfterSocketHandlerCreate : TSocketHandlerCreatedEvent Read FAfterSocketHandlerCreated Write FAfterSocketHandlerCreated;
-
-    // Set to true if you want to support HTTP 1.1 connection: keep-alive - only available for threaded server
-    Property KeepAliveEnabled: Boolean read FKeepAliveEnabled write FKeepAliveEnabled;
-    // time-out for keep-alive: how many ms should the server keep the connection alive after a request has been handled
-    Property KeepAliveTimeout: Integer read FKeepAliveTimeout write FKeepAliveTimeout;
   end;
   end;
 
 
   TFPHttpServer = Class(TFPCustomHttpServer)
   TFPHttpServer = Class(TFPCustomHttpServer)
@@ -583,7 +580,7 @@ begin
       If Req.ContentLength>0 then
       If Req.ContentLength>0 then
         ReadRequestContent(Req);
         ReadRequestContent(Req);
       Req.InitRequestVars;
       Req.InitRequestVars;
-      if KeepAliveEnabled then
+      if EnableKeepAlive then
         begin
         begin
         // Read out keep-alive
         // Read out keep-alive
         FKeepAlive:=Req.HttpVersion='1.1'; // keep-alive is default on HTTP 1.1
         FKeepAlive:=Req.HttpVersion='1.1'; // keep-alive is default on HTTP 1.1
@@ -642,12 +639,12 @@ begin
   try
   try
     try
     try
       repeat
       repeat
-        if Connection.KeepAliveEnabled and Connection.KeepAlive
+        if Connection.EnableKeepAlive and Connection.KeepAlive
         and not Connection.Socket.CanRead(Connection.KeepAliveTimeout) then
         and not Connection.Socket.CanRead(Connection.KeepAliveTimeout) then
           break;
           break;
 
 
         FConnection.HandleRequest;
         FConnection.HandleRequest;
-      until not (FConnection.KeepAliveEnabled and FConnection.KeepAlive and (FConnection.Socket.LastError=0));
+      until not (FConnection.EnableKeepAlive and FConnection.KeepAlive and (FConnection.Socket.LastError=0));
     finally
     finally
       FreeAndNil(FConnection);
       FreeAndNil(FConnection);
       if Assigned(FThreadList) then
       if Assigned(FThreadList) then
@@ -830,11 +827,7 @@ begin
     Con.FServer:=Self;
     Con.FServer:=Self;
     Con.OnRequestError:=@HandleRequestError;
     Con.OnRequestError:=@HandleRequestError;
     if Threaded then
     if Threaded then
-      begin
-      Con.KeepAliveEnabled:=KeepAliveEnabled;
-      Con.KeepAliveTimeout:=KeepAliveTimeout;
-      CreateConnectionThread(Con);
-      end
+      CreateConnectionThread(Con)
     else
     else
       begin
       begin
       Con.HandleRequest;
       Con.HandleRequest;