introducing new HeadersUnFiltered optional parameter to THttpServer.C…

…reate

- as an alternative to #293

SQLite3/mORMotHttpServer.pas

@@ -253,11 +253,12 @@   TSQLHttpServer = class(TSynPersistentLock)
     // - optional aAdditionalURL parameter can be used e.g. to registry an URI
     // to server static file content, by overriding TSQLHttpServer.Request
     // - for THttpApiServer, you can specify an optional name for the HTTP queue
+    // - for THttpServer, you can force aHeadersUnFiltered flag
     constructor Create(const aPort: AnsiString;
       const aServers: array of TSQLRestServer; const aDomainName: AnsiString='+';
       aHttpServerKind: TSQLHttpServerOptions=HTTP_DEFAULT_MODE; ServerThreadPoolCount: Integer=32;
-      aHttpServerSecurity: TSQLHttpServerSecurity=secNone;
-      const aAdditionalURL: AnsiString=''; const aQueueName: SynUnicode=''); reintroduce; overload;
+      aHttpServerSecurity: TSQLHttpServerSecurity=secNone; const aAdditionalURL: AnsiString='';
+      const aQueueName: SynUnicode=''; aHeadersUnFiltered: boolean=false); reintroduce; overload;
     /// create a Server instance, binded and listening on a TCP port to HTTP requests
     // - raise a EHttpServer exception if binding failed
     // - specify one TSQLRestServer server class to be used
@@ -583,7 +584,7 @@ constructor TSQLHttpServer.Create(const aPort: AnsiString;
   const aServers: array of TSQLRestServer; const aDomainName: AnsiString;
   aHttpServerKind: TSQLHttpServerOptions; ServerThreadPoolCount: Integer;
   aHttpServerSecurity: TSQLHttpServerSecurity; const aAdditionalURL: AnsiString;
-  const aQueueName: SynUnicode);
+  const aQueueName: SynUnicode; aHeadersUnFiltered: boolean);
 var i,j: integer;
     ServersRoot: RawUTF8;
     ErrMsg: RawUTF8;
@@ -657,7 +658,7 @@ constructor TSQLHttpServer.Create(const aPort: AnsiString;
       fHttpServer := TWebSocketServerRest.Create(
         fPort,HttpThreadStart,HttpThreadTerminate,GetDBServerNames) else
       fHttpServer := THttpServer.Create(fPort,HttpThreadStart,HttpThreadTerminate,
-        GetDBServerNames,ServerThreadPoolCount);
+        GetDBServerNames,ServerThreadPoolCount,30000,aHeadersUnFiltered);
     {$ifdef USETCPPREFIX}
     THttpServer(fHttpServer).TCPPrefix := 'magic';
     {$endif}

SynBidirSock.pas

@@ -1071,7 +1071,7 @@   TWebSocketServer = class(THttpServer)
     // once it has been upgraded to WebSockets
     constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
       const ProcessName: SockString; ServerThreadPoolCount: integer=2;
-      KeepAliveTimeOut: integer=30000); override;
+      KeepAliveTimeOut: integer=30000; HeadersNotFiltered: boolean=false); override;
     /// close the server
     destructor Destroy; override;
     /// will send a given frame to all connected clients
@@ -3147,7 +3147,8 @@ function HttpServerWebSocketUpgrade(ClientSock: THttpServerSocket;
 { TWebSocketServer }
 
 constructor TWebSocketServer.Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
-  const ProcessName: SockString; ServerThreadPoolCount, KeepAliveTimeOut: integer);
+  const ProcessName: SockString; ServerThreadPoolCount, KeepAliveTimeOut: integer;
+  HeadersNotFiltered: boolean);
 begin
   // override with custom processing classes
   fSocketClass := TWebSocketServerSocket;
@@ -3159,7 +3160,8 @@ constructor TWebSocketServer.Create(const aPort: SockString; OnStart,OnStop: TNo
   fSettings.HeartbeatDelay := 20000;
   fCanNotifyCallback := true;
   // start the server
-  inherited Create(aPort,OnStart,OnStop,ProcessName,ServerThreadPoolCount,KeepAliveTimeOut);
+  inherited Create(aPort,OnStart,OnStop,ProcessName,ServerThreadPoolCount,
+    KeepAliveTimeOut,HeadersNotFiltered);
 end;
 
 function TWebSocketServer.WebSocketProcessUpgrade(ClientSock: THttpServerSocket;
@@ -3551,7 +3553,7 @@ function THttpClientWebSockets.WebSocketsUpgrade(const aWebSocketsURI,
       SockSend; // CRLF
       SockSendFlush('');
       SockRecvLn(cmd);
-      GetHeader;
+      GetHeader(false);
       prot := HeaderGetValue('SEC-WEBSOCKET-PROTOCOL');
       result := 'Invalid HTTP Upgrade Header';
       if not IdemPChar(pointer(cmd),'HTTP/1.1 101') or

SynCrtSock.pas

@@ -574,7 +574,8 @@   THttpSocket = class(TCrtSocket)
     /// map the presence of some HTTP headers, but retrieved during Request
     HeaderFlags: set of(transferChuked, connectionClose, connectionUpgrade, connectionKeepAlive);
     /// retrieve the HTTP headers into Headers[] and fill most properties below
-    procedure GetHeader;
+    // - only relevant headers are indexed, unless HeadersUnFiltered is set
+    procedure GetHeader(HeadersUnFiltered: boolean=false);
     /// retrieve the HTTP body (after uncompression if necessary) into Content
     procedure GetBody;
     /// add an header entry, returning the just entered entry index in Headers[]
@@ -1126,7 +1127,7 @@   THttpServerGeneric = class(TServerGeneric)
   public
     /// initialize the server instance, in non suspended state
     constructor Create(CreateSuspended: boolean; OnStart,OnStop: TNotifyThreadEvent;
-      const ProcessName: SockString); override;
+      const ProcessName: SockString); virtual; reintroduce;
     /// override this function to customize your http server
     // - InURL/InMethod/InContent properties are input parameters
     // - OutContent/OutContentType/OutCustomHeader are output parameters
@@ -1189,7 +1190,7 @@   THttpServerGeneric = class(TServerGeneric)
     // - if handler returns value > 0 it will override the OnProcess response code
     // - warning: this handler must be thread-safe (can be called by several
     // threads simultaneously)
-    property OnAfterRequest: TOnHttpServerRequest  read fOnAfterRequest write SetOnAfterRequest;
+    property OnAfterRequest: TOnHttpServerRequest read fOnAfterRequest write SetOnAfterRequest;
     /// event handler called after response is sent back to client
     // - main purpose is to apply post-response analysis, logging, etc.
     // - warning: this handler must be thread-safe (can be called by several
@@ -1849,6 +1850,7 @@   THttpServer = class(THttpServerGeneric)
     fExecuteFinished: boolean;
     fStats: array[THttpServerSocketGetRequestResult] of integer;
     fSocketClass: THttpServerSocketClass;
+    fHeadersNotFiltered: boolean;
     function GetStat(one: THttpServerSocketGetRequestResult): integer;
     function GetHTTPQueueLength: Cardinal; override;
     procedure SetHTTPQueueLength(aValue: Cardinal); override;
@@ -1877,10 +1879,11 @@   THttpServer = class(THttpServerGeneric)
     // incoming connections. Default is 32, which may be sufficient for most
     // cases, maximum is 256. If you set 0, the thread pool will be disabled
     // and one thread will be created for any incoming connection
-    // - you can also tune (or disable with 0) HTTP/1.1 keep alive delay
+    // - you can also tune (or disable with 0) HTTP/1.1 keep alive delay and
+    // how incoming request Headers[] are pushed to the processing method
     constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
       const ProcessName: SockString; ServerThreadPoolCount: integer=32;
-      KeepAliveTimeOut: integer=30000); reintroduce; virtual;
+      KeepAliveTimeOut: integer=30000; HeadersUnFiltered: boolean=false); reintroduce; virtual;
     /// enable NGINX X-Accel internal redirection for HTTP_RESP_STATICFILE
     // - will define internally a matching OnSendFile event handler
     // - generating "X-Accel-Redirect: " header, trimming any supplied left
@@ -1895,6 +1898,11 @@   THttpServer = class(THttpServerGeneric)
     procedure NginxSendFileFrom(const FileNameLeftTrim: TFileName);
     /// release all memory and handlers
     destructor Destroy; override;
+    /// by default, only relevant headers are added to internal headers list
+    // - for instance, Content-Length, Content-Type and Content-Encoding are
+    // stored as fields in this THttpSocket, but not included in its Headers[]
+    // - set this property to true to include all incoming headers
+    property HeadersNotFiltered: boolean read fHeadersNotFiltered;
     /// access to the main server low-level Socket
     // - it's a raw TCrtSocket, which only need a socket to be bound, listening
     // and accept incoming request
@@ -5663,7 +5671,7 @@ procedure DoRetry(Error: integer; const msg: SockString);
         DoRetry(STATUS_HTTPVERSIONNONSUPPORTED,Command); // 505=wrong format
         exit;
       end;
-      GetHeader; // read all other headers
+      GetHeader(false); // read all other headers
       if (result<>STATUS_NOCONTENT) and not IdemPChar(pointer(method),'HEAD') then
         GetBody; // get content if necessary (not HEAD method)
     except
@@ -6093,7 +6101,8 @@ function THttpServerGeneric.NextConnectionID: integer;
 
 constructor THttpServer.Create(const aPort: SockString; OnStart,
   OnStop: TNotifyThreadEvent; const ProcessName: SockString;
-  ServerThreadPoolCount: integer; KeepAliveTimeOut: integer);
+  ServerThreadPoolCount: integer; KeepAliveTimeOut: integer;
+  HeadersUnFiltered: boolean);
 begin
   fInternalHttpServerRespList := {$ifdef FPC}TFPList{$else}TList{$endif}.Create;
   InitializeCriticalSection(fProcessCS);
@@ -6112,6 +6121,7 @@ constructor THttpServer.Create(const aPort: SockString; OnStart,
     fThreadPool := TSynThreadPoolTHttpServer.Create(self,ServerThreadPoolCount);
     fHTTPQueueLength := 1000;
   end;
+  fHeadersNotFiltered := HeadersUnFiltered;
   inherited Create(false,OnStart,OnStop,ProcessName);
 end;
 
@@ -6727,7 +6737,7 @@ procedure THttpSocket.GetBody;
   {$I+}
 end;
 
-procedure THttpSocket.GetHeader;
+procedure THttpSocket.GetHeader(HeadersUnFiltered: boolean);
 var s,c: SockString;
     i, n: integer;
     P: PAnsiChar;
@@ -6746,7 +6756,7 @@ procedure THttpSocket.GetHeader;
     SockRecvLn(s);
     if s='' then
       break; // headers end with a void line
-    P := pointer(s); // P := nil below to store in Headers[]
+    P := pointer(s); // set P=nil below to store in Headers[]
     case IdemPCharArray(P,['CONTENT-', 'TRANSFER-ENCODING: CHUNKED', 'CONNECTION: ',
       'ACCEPT-ENCODING:', 'UPGRADE:', 'SERVER-INTERNALSTATE:', 'X-POWERED-BY']) of
     0: case IdemPCharArray(P+8,['LENGTH:', 'TYPE:', 'ENCODING:']) of
@@ -6790,7 +6800,7 @@ procedure THttpSocket.GetHeader;
     6: XPoweredBy := s; // not in headers
     else P := nil;
     end;
-    if P=nil then begin // only store meaningful header
+    if (P=nil) or HeadersUnFiltered then begin // only store meaningful headers
       if length(Headers)<=n then
         SetLength(Headers,n+n shr 3+16);
       Headers[n] := s;
@@ -6931,6 +6941,7 @@ function THttpServerSocket.GetRequest(withBody: boolean; headerMaxTix: Int64): T
     status: cardinal;
     pending: integer;
     reason, allheaders: SockString;
+    noheaderfilter: boolean;
 begin
   result := grError;
   try
@@ -6941,7 +6952,9 @@ function THttpServerSocket.GetRequest(withBody: boolean; headerMaxTix: Int64): T
       pending := SockInPending(100,{alsosocket=}true);
       if (pending<0) or (fServer=nil) or fServer.Terminated then
         exit;
-    end;
+      noheaderfilter := fServer.HeadersNotFiltered;
+    end else
+      noheaderfilter := false;
     // 1st line is command: 'GET /path HTTP/1.1' e.g.
     SockRecvLn(Command);
     if TCPPrefix<>'' then
@@ -6957,7 +6970,7 @@ function THttpServerSocket.GetRequest(withBody: boolean; headerMaxTix: Int64): T
        IdemPChar(P,'HTTP/1.1');
     Content := '';
     // get headers and content
-    GetHeader;
+    GetHeader(noheaderfilter);
     if fServer<>nil then begin // nil from TRTSPOverHTTPServer
       if fServer.fRemoteIPHeaderUpper<>'' then begin
         P := FindHeader(pointer(Headers),length(Headers),fServer.fRemoteIPHeaderUpper);
@@ -8771,6 +8784,7 @@ constructor THttpApiServer.CreateClone(From: THttpApiServer);
   fOnBeforeRequest := From.fOnBeforeRequest;
   fOnAfterRequest := From.fOnAfterRequest;
   fCanNotifyCallback := From.fCanNotifyCallback;
+  fHeadersNotFiltered := From.fHeadersNotFiltered;
   fCompress := From.fCompress;
   fCompressAcceptEncoding := From.fCompressAcceptEncoding;
   fReceiveBufferSize := From.fReceiveBufferSize;

SynProtoRTSPHTTP.pas

@@ -407,7 +407,7 @@   TReq = record
           'Cache-Control: no-cache'#13#10#13#10);
         get.SockRecvLn(text);
         test.Check(text = 'HTTP/1.0 200 OK');
-        get.GetHeader;
+        get.GetHeader(false);
         test.Check(connectionClose in get.HeaderFlags);
         test.Check(get.SockConnected);
         test.Check(get.ContentType = RTSP_MIME);

SynopseCommit.inc

@@ -1 +1 @@
-'1.18.5877'
+'1.18.5878'