From 3040d9746b416ea6d9f598f89fc73ef0780ec81a Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 12 Nov 2011 12:40:12 +0000 Subject: [PATCH] * Implemented OnUnknownRequestEncoding git-svn-id: trunk@19629 - --- packages/fcl-web/src/base/custcgi.pp | 2 ++ packages/fcl-web/src/base/custfcgi.pp | 2 ++ packages/fcl-web/src/base/custhttpapp.pp | 35 +++++++++++++++++++++++ packages/fcl-web/src/base/custweb.pp | 30 +++++++++++++++++-- packages/fcl-web/src/base/fpapache.pp | 2 ++ packages/fcl-web/src/base/fphttpserver.pp | 15 ++++++++++ packages/fcl-web/src/base/fpwebfile.pp | 15 ++++++---- packages/fcl-web/src/base/httpdefs.pp | 16 +++++++++-- 8 files changed, 108 insertions(+), 9 deletions(-) diff --git a/packages/fcl-web/src/base/custcgi.pp b/packages/fcl-web/src/base/custcgi.pp index 9fe72d7ee6..caf84bf30a 100644 --- a/packages/fcl-web/src/base/custcgi.pp +++ b/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; diff --git a/packages/fcl-web/src/base/custfcgi.pp b/packages/fcl-web/src/base/custfcgi.pp index ffff70a1b1..f6031bc065 100644 --- a/packages/fcl-web/src/base/custfcgi.pp +++ b/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; diff --git a/packages/fcl-web/src/base/custhttpapp.pp b/packages/fcl-web/src/base/custhttpapp.pp index e5ff832ae7..f233e5aafa 100644 --- a/packages/fcl-web/src/base/custhttpapp.pp +++ b/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; diff --git a/packages/fcl-web/src/base/custweb.pp b/packages/fcl-web/src/base/custweb.pp index abc8b59f76..bda75f91ec 100644 --- a/packages/fcl-web/src/base/custweb.pp +++ b/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; diff --git a/packages/fcl-web/src/base/fpapache.pp b/packages/fcl-web/src/base/fpapache.pp index 16d62c4797..011c0841d0 100644 --- a/packages/fcl-web/src/base/fpapache.pp +++ b/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; diff --git a/packages/fcl-web/src/base/fphttpserver.pp b/packages/fcl-web/src/base/fphttpserver.pp index 7d9a7ad04e..cbeba30f8d 100644 --- a/packages/fcl-web/src/base/fphttpserver.pp +++ b/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); diff --git a/packages/fcl-web/src/base/fpwebfile.pp b/packages/fcl-web/src/base/fpwebfile.pp index 1e79ca17fe..c276c6103b 100644 --- a/packages/fcl-web/src/base/fpwebfile.pp +++ b/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; diff --git a/packages/fcl-web/src/base/httpdefs.pp b/packages/fcl-web/src/base/httpdefs.pp index a7e9e17f23..7c05a6fe1c 100644 --- a/packages/fcl-web/src/base/httpdefs.pp +++ b/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