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

httpserver keep-alive first attempt

Browse Source
This commit is contained in:
Ondrej Pokorny 2021-08-14 02:12:40 +02:00 committed by Michaël Van Canneyt
parent 6b36229d3c
commit 7fbc82a9ff
2 changed files with 40 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packages/fcl-net/src/ssockets.pp
View File

@ -99,6 +99,7 @@ type
Constructor Create (AHandle : Longint; AHandler : TSocketHandler = Nil);virtual;
destructor Destroy; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
Function CanRead(TimeOut : Integer): Boolean;
Function Read (Var Buffer; Count : Longint) : longint; Override;
Function Write (Const Buffer; Count : Longint) :Longint; Override;
Property SocketOptions : TSocketOptions Read FSocketOptions
@ -484,6 +485,18 @@ begin
Result:=0;
end;
Function TSocketStream.CanRead (TimeOut : Integer) : Boolean;
var
B: Byte;
lTM: Integer;
begin
lTM := IOTimeout;
IOTimeout := TimeOut;
FHandler.Recv(B,0);
Result := FHandler.FLastError=0;
IOTimeout := lTM;
end;
Function TSocketStream.Read (Var Buffer; Count : Longint) : longint;
begin

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

@ -63,7 +63,9 @@ Type
FOnError: TRequestErrorHandler;
FServer: TFPCustomHTTPServer;
FSocket: TSocketStream;
FSetupSocket : Boolean;
FBuffer : Ansistring;
FKeepAlive : Boolean;
procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String);
function ReadString: String;
Function GetLookupHostNames : Boolean;
@ -81,6 +83,7 @@ Type
Property Server : TFPCustomHTTPServer Read FServer;
Property OnRequestError : TRequestErrorHandler Read FOnError Write FOnError;
Property LookupHostNames : Boolean Read GetLookupHostNames;
property KeepAlive: Boolean read FKeepAlive;
end;
{ TFPHTTPConnectionThread }
@ -525,6 +528,7 @@ end;
constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream);
begin
FSocket:=ASocket;
FSetupSocket:=True;
FServer:=AServer;
If Assigned(FServer) then
InterLockedIncrement(FServer.FConnectionCount)
@ -555,7 +559,15 @@ Var
begin
Try
SetupSocket;
if FSetupSocket then
begin
SetupSocket;
FSetupSocket:=False;
end else
begin
if not Socket.CanRead(1000) then
Exit;
end;
// Read headers.
Req:=ReadRequestHeaders;
try
@ -565,6 +577,12 @@ begin
If Req.ContentLength>0 then
ReadRequestContent(Req);
Req.InitRequestVars;
// Read out keep-alive
FKeepAlive:=Req.HttpVersion='1.1'; // keep-alive is default on HTTP 1.1
if SameText(Req.GetHeader(hhConnection),'close') then
FKeepAlive:=False
else if SameText(Req.GetHeader(hhConnection),'keep-alive') then
FKeepAlive:=True;
// Create Response
Resp:= Server.CreateResponse(Req);
try
@ -574,7 +592,12 @@ begin
if Server.Active then
Server.HandleRequest(Req,Resp);
if Assigned(Resp) and (not Resp.ContentSent) then
begin
// Add connection header for HTTP 1.0 keep-alive
if FKeepAlive and (Req.HttpVersion='1.0') and not Resp.HeaderIsSet(hhConnection) then
Resp.SetHeader(hhConnection,'keep-alive');
Resp.SendContent;
end;
finally
FreeAndNil(Resp);
end;
@ -609,7 +632,9 @@ procedure TFPHTTPConnectionThread.Execute;
begin
try
try
FConnection.HandleRequest;
repeat
FConnection.HandleRequest;
until not (FConnection.KeepAlive and (FConnection.Socket.LastError=0));
finally
FreeAndNil(FConnection);
if Assigned(FThreadList) then