* Implemented OnUnknownRequestEncoding

git-svn-id: trunk@19629 -

packages/fcl-web/src/base/custcgi.pp

@@ -205,10 +205,12 @@ end;
 function TCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 begin
   FRequest:=CreateRequest;
+  InitRequest(FRequest);
   FRequest.InitFromEnvironment;
   FRequest.InitRequestVars;
   FOutput:=TIOStream.Create(iosOutput);
   FResponse:=CreateResponse(FOutput);
+  InitResponse(FResponse);
   ARequest:=FRequest;
   AResponse:=FResponse;
   Result := True;

packages/fcl-web/src/base/custfcgi.pp

@@ -832,6 +832,7 @@ begin
     assert(not assigned(FRequestsArray[ARequestID].Request));
     assert(not assigned(FRequestsArray[ARequestID].Response));
     ATempRequest:=TFCGIRequest.Create;
+    InitRequest(ATempRequest);
     ATempRequest.RequestID:=ARequestID;
     ATempRequest.Handle:=FHandle;
     ATempRequest.ProtocolOptions:=Self.Protocoloptions;
@@ -848,6 +849,7 @@ begin
     begin
     ARequest:=FRequestsArray[ARequestID].Request;
     FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
+    InitResponse(FRequestsArray[ARequestID].Response);
     FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
     FRequestsArray[ARequestID].Response.FOnWrite:=@DoFastCGIWrite;
     AResponse:=FRequestsArray[ARequestID].Response;

packages/fcl-web/src/base/custhttpapp.pp

@@ -25,8 +25,17 @@ uses
 
 Type
   TCustomHTTPApplication = Class;
+  TFPHTTPServerHandler = Class;
+
+  { TEmbeddedHttpServer }
+
   TEmbeddedHttpServer = Class(TFPCustomHttpServer)
+  Private
+    FWebHandler: TFPHTTPServerHandler;
   protected
+    Procedure InitRequest(ARequest : TFPHTTPConnectionRequest); virtual;
+    Procedure InitResponse(AResponse : TFPHTTPConnectionResponse); virtual;
+    Property WebHandler : TFPHTTPServerHandler Read FWebHandler;
     Property Active;
   end;
 
@@ -49,6 +58,8 @@ Type
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
   protected
+    Procedure InitRequest(ARequest : TRequest); override;
+    Procedure InitResponse(AResponse : TResponse); override;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     Function CreateServer : TEmbeddedHttpServer; virtual;
     Property HTTPServer : TEmbeddedHttpServer Read FServer;
@@ -102,6 +113,19 @@ ResourceString
 
 Implementation
 
+{ TEmbeddedHttpServer }
+
+procedure TEmbeddedHttpServer.InitRequest(ARequest: TFPHTTPConnectionRequest);
+begin
+  WebHandler.InitRequest(ARequest);
+end;
+
+procedure TEmbeddedHttpServer.InitResponse(AResponse: TFPHTTPConnectionResponse
+  );
+begin
+  WebHandler.InitResponse(AResponse);
+end;
+
 {$ifdef CGIDEBUG}
 uses
   dbugintf;
@@ -215,6 +239,16 @@ begin
   FServer.Threaded:=AValue;
 end;
 
+procedure TFPHTTPServerHandler.InitRequest(ARequest: TRequest);
+begin
+  inherited InitRequest(ARequest);
+end;
+
+procedure TFPHTTPServerHandler.InitResponse(AResponse: TResponse);
+begin
+  inherited InitResponse(AResponse);
+end;
+
 function TFPHTTPServerHandler.WaitForRequest(out ARequest: TRequest;
   out AResponse: TResponse): boolean;
 begin
@@ -237,6 +271,7 @@ constructor TFPHTTPServerHandler.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FServer:=CreateServer;
+  FServer.FWebHandler:=Self;
   FServer.OnRequest:=@HTTPHandleRequest;
 end;
 

packages/fcl-web/src/base/custweb.pp

@@ -84,6 +84,7 @@ Type
   TWebHandler = class(TComponent)
   private
     FOnIdle: TNotifyEvent;
+    FOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
     FTerminated: boolean;
     FAdministrator: String;
     FAllowDefaultModule: Boolean;
@@ -92,7 +93,6 @@ Type
     FModuleVar: String;
     FOnGetModule: TGetModuleEvent;
     FOnShowRequestException: TOnShowRequestException;
-    FRequest : TRequest;
     FHandleGetOnPost : Boolean;
     FRedirectOnError : Boolean;
     FRedirectOnErrorURL : String;
@@ -108,6 +108,8 @@ Type
     Procedure SetBaseURL(AModule : TCustomHTTPModule; Const AModuleName : String; ARequest : TRequest); virtual;
     function GetApplicationURL(ARequest : TRequest): String; virtual;
     procedure ShowRequestException(R: TResponse; E: Exception); virtual;
+    Procedure InitRequest(ARequest : TRequest); virtual;
+    Procedure InitResponse(AResponse : TResponse); virtual;
     Function GetEmail : String; virtual;
     Function GetAdministrator : String; virtual;
     property Terminated: boolean read FTerminated;
@@ -121,7 +123,6 @@ Type
     Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
     Property ApplicationURL : String Read FApplicationURL Write FApplicationURL;
-    Property Request : TRequest read FRequest;
     Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
     Property ModuleVariable : String Read FModuleVar Write FModuleVar;
     Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
@@ -131,6 +132,7 @@ Type
     property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
     property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
     Property OnLog : TLogEvent Read FOnLog Write FOnLog;
+    Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read FOnUnknownRequestEncoding Write FOnUnknownRequestEncoding;
   end;
 
   TCustomWebApplication = Class(TCustomApplication)
@@ -146,6 +148,7 @@ Type
     function GetModuleVar: String;
     function GetOnGetModule: TGetModuleEvent;
     function GetOnShowRequestException: TOnShowRequestException;
+    function GetOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
     function GetRedirectOnError: boolean;
     function GetRedirectOnErrorURL: string;
     procedure SetAdministrator(const AValue: String);
@@ -156,6 +159,7 @@ Type
     procedure SetModuleVar(const AValue: String);
     procedure SetOnGetModule(const AValue: TGetModuleEvent);
     procedure SetOnShowRequestException(const AValue: TOnShowRequestException);
+    procedure SetOnUnknownRequestEncoding(AValue: TOnUnknownEncodingEvent);
     procedure SetRedirectOnError(const AValue: boolean);
     procedure SetRedirectOnErrorURL(const AValue: string);
     procedure DoOnTerminate(Sender : TObject);
@@ -181,6 +185,7 @@ Type
     Property Email : String Read GetEmail Write SetEmail;
     Property Administrator : String Read GetAdministrator Write SetAdministrator;
     property OnShowRequestException: TOnShowRequestException read GetOnShowRequestException write SetOnShowRequestException;
+    Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read GetOnUnknownRequestEncoding Write SetOnUnknownRequestEncoding;
     Property EventLog: TEventLog read GetEventLog;
   end;
 
@@ -289,6 +294,16 @@ begin
     end;
 end;
 
+procedure TWebHandler.InitRequest(ARequest: TRequest);
+begin
+  ARequest.OnUnknownEncoding:=Self.OnUnknownRequestEncoding;
+end;
+
+procedure TWebHandler.InitResponse(AResponse: TResponse);
+begin
+  // Do nothing
+end;
+
 function TWebHandler.GetEmail: String;
 begin
   Result := FEmail;
@@ -506,6 +521,11 @@ begin
   result := FWebHandler.OnShowRequestException;
 end;
 
+function TCustomWebApplication.GetOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
+begin
+  Result := FWebHandler.OnUnknownRequestEncoding
+end;
+
 function TCustomWebApplication.GetRedirectOnError: boolean;
 begin
   result := FWebHandler.RedirectOnError;
@@ -556,6 +576,12 @@ begin
   FWebHandler.OnShowRequestException := AValue;
 end;
 
+procedure TCustomWebApplication.SetOnUnknownRequestEncoding(
+  AValue: TOnUnknownEncodingEvent);
+begin
+  FWebHandler.OnUnknownRequestEncoding:=AValue;
+end;
+
 procedure TCustomWebApplication.SetRedirectOnError(const AValue: boolean);
 begin
   FWebHandler.RedirectOnError := AValue;

packages/fcl-web/src/base/fpapache.pp

@@ -254,9 +254,11 @@ Var
 begin
   Req:=TApacheRequest.CreateReq(Self,P);
   Try
+    InitRequest(Req);
     Req.InitRequestVars;
     Resp:=TApacheResponse.CreateApache(Req);
     Try
+      InitResponse(Resp);
       HandleRequest(Req,Resp);
       If Not Resp.ContentSent then
         Resp.SendContent;

packages/fcl-web/src/base/fphttpserver.pp

@@ -111,6 +111,8 @@ Type
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
   Protected
+    Procedure InitRequest(ARequest : TFPHTTPConnectionRequest); virtual;
+    Procedure InitResponse(AResponse : TFPHTTPConnectionResponse); virtual;
     // Create a connection handling object.
     function CreateConnection(Data : TSocketStream) : TFPHTTPConnection; virtual;
     // Create a connection handling thread.
@@ -429,6 +431,7 @@ Var
   StartLine,S : String;
 begin
   Result:=TFPHTTPConnectionRequest.Create;
+  Server.InitRequest(Result);
   Result.FConnection:=Self;
   StartLine:=ReadString;
   ParseStartLine(Result,StartLine);
@@ -471,6 +474,7 @@ begin
     // Create Response
     Resp:= TFPHTTPConnectionResponse.Create(Req);
     try
+      Server.InitResponse(Resp);
       Resp.FConnection:=Self;
       // And dispatch
       if Server.Active then
@@ -557,6 +561,17 @@ begin
   FThreaded:=AValue;
 end;
 
+procedure TFPCustomHttpServer.InitRequest(ARequest: TFPHTTPConnectionRequest);
+begin
+
+end;
+
+procedure TFPCustomHttpServer.InitResponse(AResponse: TFPHTTPConnectionResponse
+  );
+begin
+
+end;
+
 function TFPCustomHttpServer.CreateConnection(Data: TSocketStream): TFPHTTPConnection;
 begin
   Result:=TFPHTTPConnection.Create(Self,Data);

packages/fcl-web/src/base/fpwebfile.pp

@@ -98,13 +98,18 @@ Var
   D : String;
 
 begin
-  D:=Locations.Values[BaseURL];
-  If (D='') then
-    Result:=''
+  if (BaseURL='') then
+    Result:=AFileName
   else
     begin
-    Result:=D+AFileName;
-    DoDirSeparators(Result);
+    D:=Locations.Values[BaseURL];
+    If (D='') then
+      Result:=''
+    else
+      begin
+      Result:=D+AFileName;
+      DoDirSeparators(Result);
+      end;
     end;
 end;
 

packages/fcl-web/src/base/httpdefs.pp

@@ -92,6 +92,7 @@ Const
                 
 
 type
+  TRequest = Class;
 
   { TCookie }
 
@@ -261,7 +262,7 @@ type
     property QueryFields : TStrings read FQueryFields;
   end;
 
-
+  TOnUnknownEncodingEvent = Procedure (Sender : TRequest; Const ContentType : String;Stream : TStream) of object;
   { TRequest }
 
   TRequest = class(THttpHeader)
@@ -269,6 +270,7 @@ type
     FCommand: String;
     FCommandLine: String;
     FHandleGetOnPost: Boolean;
+    FOnUnknownEncoding: TOnUnknownEncodingEvent;
     FPathInfo,
     FURI: String;
     FFiles : TUploadedFiles;
@@ -280,6 +282,7 @@ type
   Protected
     FContentRead : Boolean;
     FContent : String;
+    procedure HandleUnknownEncoding(Const AContentType : String;Stream : TStream); virtual;
     procedure ParseFirstHeaderLine(const line: String);override;
     procedure ReadContent; virtual;
     Function GetFieldValue(AIndex : Integer) : String; override;
@@ -304,6 +307,7 @@ type
     Property  HeaderLine : String read GetFirstHeaderLine;
     Property  Files : TUploadedFiles Read FFiles;
     Property  HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
+    Property  OnUnknownEncoding : TOnUnknownEncodingEvent Read FOnUnknownEncoding Write FOnUnknownEncoding;
   end;
 
 
@@ -1065,6 +1069,12 @@ begin
     Result := Result + ' HTTP/' + HttpVersion;
 end;
 
+procedure TRequest.HandleUnknownEncoding(Const AContentType : String;Stream : TStream);
+begin
+  If Assigned(FOnUnknownEncoding) then
+    FOnUnknownEncoding(Self,AContentType,Stream);
+end;
+
 procedure TRequest.ReadContent;
 begin
   // Implement in descendents
@@ -1253,6 +1263,8 @@ begin
         ProcessMultiPart(M,CT, ContentFields)
       else if Pos('APPLICATION/X-WWW-FORM-URLENCODED',Uppercase(CT))<>0 then
         ProcessUrlEncoded(M, ContentFields)
+      else
+        HandleUnknownEncoding(CT,M)
     finally
      M.Free;
     end;
@@ -1260,7 +1272,7 @@ begin
 {$ifdef CGIDEBUG}
   SendMethodExit('InitPostVars');
 {$endif}
-        end;
+end;
 
 procedure TRequest.InitGetVars;
 Var