* Request ID and connection ID for logging purposes

This commit is contained in:
Michaël Van Canneyt 2021-08-18 16:37:09 +02:00
parent 4ac009846c
commit a68a6415f2
3 changed files with 53 additions and 3 deletions

View File

@ -77,7 +77,7 @@ begin
try try
CheckMimeLoaded; CheckMimeLoaded;
AResponse.ContentType:=MimeTypes.GetMimeType(ExtractFileExt(FN)); AResponse.ContentType:=MimeTypes.GetMimeType(ExtractFileExt(FN));
WriteInfo('Serving file: "'+Fn+'". Reported Mime type: '+AResponse.ContentType); WriteInfo('Connection ('+aRequest.Connection.ConnectionID+') - Request ['+aRequest.RequestID+']: Serving file: "'+Fn+'". Reported Mime type: '+AResponse.ContentType);
AResponse.ContentLength:=F.Size; AResponse.ContentLength:=F.Size;
AResponse.ContentStream:=F; AResponse.ContentStream:=F;
AResponse.SendContent; AResponse.SendContent;

View File

@ -61,8 +61,11 @@ Type
{ TFPHTTPConnection } { TFPHTTPConnection }
TFPHTTPConnection = Class(TObject) TFPHTTPConnection = Class(TObject)
private
Class var _ConnectionCount : Int64;
private private
FBusy: Boolean; FBusy: Boolean;
FConnectionID: String;
FOnError: TRequestErrorHandler; FOnError: TRequestErrorHandler;
FServer: TFPCustomHTTPServer; FServer: TFPCustomHTTPServer;
FSocket: TSocketStream; FSocket: TSocketStream;
@ -75,12 +78,21 @@ Type
function ReadString: String; function ReadString: String;
Function GetLookupHostNames : Boolean; Function GetLookupHostNames : Boolean;
Protected Protected
// Allocate the ID for this connection.
Procedure AllocateConnectionID;
// Read the request content
procedure ReadRequestContent(ARequest: TFPHTTPConnectionRequest); virtual; procedure ReadRequestContent(ARequest: TFPHTTPConnectionRequest); virtual;
// Allow descendents to handle unknown headers
procedure UnknownHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String); virtual; procedure UnknownHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String); virtual;
// Handle request error, calls OnRequestError
procedure HandleRequestError(E : Exception); virtual; procedure HandleRequestError(E : Exception); virtual;
// Setup socket
Procedure SetupSocket; virtual; Procedure SetupSocket; virtual;
// Mark connection as busy with request
Procedure SetBusy; Procedure SetBusy;
// Actually handle request
procedure DoHandleRequest; virtual; procedure DoHandleRequest; virtual;
// Read request headers
Function ReadRequestHeaders : TFPHTTPConnectionRequest; Function ReadRequestHeaders : TFPHTTPConnectionRequest;
// Check if we have keep-alive and no errors occured // Check if we have keep-alive and no errors occured
Function AllowNewRequest : Boolean; Function AllowNewRequest : Boolean;
@ -88,15 +100,25 @@ Type
Function RequestPending : Boolean; Function RequestPending : Boolean;
// True if we're handling a request. Needed to be able to schedule properly. // True if we're handling a request. Needed to be able to schedule properly.
Property Busy : Boolean Read FBusy; Property Busy : Boolean Read FBusy;
Public
Type
TConnectionIDAllocator = Procedure(out aID : String) of object;
class var IDAllocator : TConnectionIDAllocator;
Public Public
Constructor Create(AServer : TFPCustomHTTPServer; ASocket : TSocketStream); Constructor Create(AServer : TFPCustomHTTPServer; ASocket : TSocketStream);
Destructor Destroy; override; Destructor Destroy; override;
// Handle 1 request: Set up socket if needed, Read request, dispatch, return response.
Procedure HandleRequest; Procedure HandleRequest;
// Unique ID per new connection
Property ConnectionID : String Read FConnectionID;
// The socket used by this connection
Property Socket : TSocketStream Read FSocket; Property Socket : TSocketStream Read FSocket;
// The server that created this connection
Property Server : TFPCustomHTTPServer Read FServer; Property Server : TFPCustomHTTPServer Read FServer;
// Handler to call when an error occurs.
Property OnRequestError : TRequestErrorHandler Read FOnError Write FOnError; Property OnRequestError : TRequestErrorHandler Read FOnError Write FOnError;
// Look up host names to map IP -> hostname ?
Property LookupHostNames : Boolean Read GetLookupHostNames; Property LookupHostNames : Boolean Read GetLookupHostNames;
// Set to true if you want to support HTTP 1.1 connection: keep-alive - only available for threaded server // 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; 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 // time-out for keep-alive: how many ms should the server keep the connection alive after a request has been handled
@ -929,6 +951,7 @@ begin
FSocket:=ASocket; FSocket:=ASocket;
FServer:=AServer; FServer:=AServer;
KeepAliveTimeout:=DefaultKeepaliveTimeout; KeepAliveTimeout:=DefaultKeepaliveTimeout;
AllocateConnectionID;
end; end;
destructor TFPHTTPConnection.Destroy; destructor TFPHTTPConnection.Destroy;
@ -946,6 +969,15 @@ begin
Result:=False; Result:=False;
end; end;
procedure TFPHTTPConnection.AllocateConnectionID;
begin
if Assigned(IDAllocator) then
IDAllocator(FConnectionID);
if FConnectionID='' then
FConnectionID:=IntToStr(InterlockedIncrement64(_ConnectionCount))
end;
procedure TFPHTTPConnection.DoHandleRequest; procedure TFPHTTPConnection.DoHandleRequest;
Var Var

View File

@ -444,17 +444,19 @@ type
{ TRequest } { TRequest }
TRequest = class(THttpHeader) TRequest = class(THttpHeader)
Private
class var _RequestCount : Int64;
private private
FCommand: String; FCommand: String;
FCommandLine: String; FCommandLine: String;
FHandleGetOnPost: Boolean; FHandleGetOnPost: Boolean;
FOnUnknownEncoding: TOnUnknownEncodingEvent; FOnUnknownEncoding: TOnUnknownEncodingEvent;
FFiles : TUploadedFiles; FFiles : TUploadedFiles;
FRequestID: String;
FReturnedPathInfo : String; FReturnedPathInfo : String;
FLocalPathPrefix : string; FLocalPathPrefix : string;
FContentRead : Boolean; FContentRead : Boolean;
FRouteParams : TStrings; FRouteParams : TStrings;
FStreamingContentType: TStreamingContentType; FStreamingContentType: TStreamingContentType;
FMimeItems: TMimeItems; FMimeItems: TMimeItems;
FKeepFullContents: Boolean; FKeepFullContents: Boolean;
@ -466,6 +468,7 @@ type
function GetRP(AParam : String): String; function GetRP(AParam : String): String;
procedure SetRP(AParam : String; AValue: String); procedure SetRP(AParam : String; AValue: String);
Protected Protected
procedure AllocateRequestID; virtual;
Function AllowReadContent : Boolean; virtual; Function AllowReadContent : Boolean; virtual;
Function CreateUploadedFiles : TUploadedFiles; virtual; Function CreateUploadedFiles : TUploadedFiles; virtual;
Function CreateMimeItems : TMimeItems; virtual; Function CreateMimeItems : TMimeItems; virtual;
@ -497,11 +500,16 @@ type
procedure ProcessStreamingSetContent(const State: TContentStreamingState; const Buf; const Size: Integer); virtual; procedure ProcessStreamingSetContent(const State: TContentStreamingState; const Buf; const Size: Integer); virtual;
procedure HandleStreamingUnknownEncoding(const State: TContentStreamingState; const Buf; const Size: Integer); procedure HandleStreamingUnknownEncoding(const State: TContentStreamingState; const Buf; const Size: Integer);
Property ContentRead : Boolean Read FContentRead Write FContentRead; Property ContentRead : Boolean Read FContentRead Write FContentRead;
Public
Type
TConnectionIDAllocator = Procedure(out aID : String) of object;
class var IDAllocator : TConnectionIDAllocator;
public public
Class Var DefaultRequestUploadDir : String; Class Var DefaultRequestUploadDir : String;
constructor Create; override; constructor Create; override;
destructor destroy; override; destructor destroy; override;
Function GetNextPathInfo : String; Function GetNextPathInfo : String;
Property RequestID : String Read FRequestID;
Property RouteParams[AParam : String] : String Read GetRP Write SetRP; Property RouteParams[AParam : String] : String Read GetRP Write SetRP;
Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo; Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo;
Property LocalPathPrefix : string Read GetLocalPathPrefix; Property LocalPathPrefix : string Read GetLocalPathPrefix;
@ -2059,6 +2067,7 @@ begin
FFiles:=CreateUploadedFiles; FFiles:=CreateUploadedFiles;
FFiles.FRequest:=Self; FFiles.FRequest:=Self;
FLocalPathPrefix:='-'; FLocalPathPrefix:='-';
AllocateRequestID;
end; end;
function TRequest.CreateUploadedFiles: TUploadedFiles; function TRequest.CreateUploadedFiles: TUploadedFiles;
@ -2195,6 +2204,15 @@ begin
FRouteParams.Values[AParam]:=AValue; FRouteParams.Values[AParam]:=AValue;
end; end;
procedure TRequest.AllocateRequestID;
begin
if Assigned(IDAllocator) then
IDAllocator(FRequestID);
if FRequestID='' then
FRequestID:=IntToStr(InterlockedIncrement64(_RequestCount))
end;
function TRequest.AllowReadContent: Boolean; function TRequest.AllowReadContent: Boolean;
begin begin
Result:=True; Result:=True;