Browse Source

* Request ID and connection ID for logging purposes

Michaël Van Canneyt 4 years ago
parent
commit
a68a6415f2

+ 1 - 1
packages/fcl-web/examples/httpserver/testhttpserver.pas

@@ -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;

+ 33 - 1
packages/fcl-web/src/base/fphttpserver.pp

@@ -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

+ 19 - 1
packages/fcl-web/src/base/httpdefs.pp

@@ -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;