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

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

Browse Source
This commit is contained in:
Ondrej Pokorny 2021-08-14 05:44:44 +02:00 committed by Michaël Van Canneyt
parent bf2e3bf51a
commit da10b8141c
2 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packages/fcl-web/examples/httpserver/threadedhttpserver.pas
View File

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

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

@ -65,7 +65,7 @@ Type
FSocket: TSocketStream;
FSetupSocket : Boolean;
FBuffer : Ansistring;
FKeepAliveEnabled : Boolean;
FEnableKeepAlive : Boolean;
FKeepAlive : Boolean;
FKeepAliveTimeout : Integer;
procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String);
@ -85,8 +85,14 @@ Type
Property Server : TFPCustomHTTPServer Read FServer;
Property OnRequestError : TRequestErrorHandler Read FOnError Write FOnError;
Property LookupHostNames : Boolean Read GetLookupHostNames;
<<<<<<< HEAD
Property EnableKeepAlive: Boolean read FEnableKeepAlive write FEnableKeepAlive;
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;
>>>>>>> Remove the KeepAlive* properties from TFPCustomHttpServer, rename KeepAliveEnabled to EnableKeepAlive
// 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;
// is the current connection set up for KeepAlive?
@ -136,8 +142,6 @@ Type
FConnectionThreadList: TThreadList;
FConnectionCount : Integer;
FUseSSL: Boolean;
FKeepAliveEnabled: Boolean;
FKeepAliveTimeout: Integer;
procedure DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler);
function GetActive: Boolean;
function GetConnectionCount: Integer;
@ -231,10 +235,13 @@ Type
Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
// Called after create socket handler was created, with the created socket handler.
Property AfterSocketHandlerCreate : TSocketHandlerCreatedEvent Read FAfterSocketHandlerCreated Write FAfterSocketHandlerCreated;
<<<<<<< HEAD
// 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;
=======
>>>>>>> Remove the KeepAlive* properties from TFPCustomHttpServer, rename KeepAliveEnabled to EnableKeepAlive
end;
TFPHttpServer = Class(TFPCustomHttpServer)
@ -586,7 +593,7 @@ begin
If Req.ContentLength>0 then
ReadRequestContent(Req);
Req.InitRequestVars;
if KeepAliveEnabled then
if EnableKeepAlive then
begin
// Read out keep-alive
FKeepAlive:=Req.HttpVersion='1.1'; // keep-alive is default on HTTP 1.1
@ -648,12 +655,12 @@ begin
try
try
repeat
if not Terminated and Connection.EnableKeepAlive and Connection.KeepAlive
FConnection.HandleRequest;
if Connection.EnableKeepAlive and Connection.KeepAlive
and not Connection.Socket.CanRead(Connection.KeepAliveTimeout) then
break;
FConnection.HandleRequest;
until not (not Terminated and FConnection.EnableKeepAlive and FConnection.KeepAlive and (FConnection.Socket.LastError=0));
FConnection.HandleRequest;
until not (FConnection.EnableKeepAlive and FConnection.KeepAlive and (FConnection.Socket.LastError=0));
finally
FreeAndNil(FConnection);
if Assigned(FThreadList) then
@ -841,11 +848,7 @@ begin
Con.FServer:=Self;
Con.OnRequestError:=@HandleRequestError;
if Threaded then
begin
Con.KeepAliveEnabled:=KeepAliveEnabled;
Con.KeepAliveTimeout:=KeepAliveTimeout;
CreateConnectionThread(Con);
end
CreateConnectionThread(Con)
else
begin
Con.HandleRequest;