paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 19:19:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented OnUnknownRequestEncoding

Browse Source 
git-svn-id: trunk@19629 -
This commit is contained in:
michael 2011-11-12 12:40:12 +00:00
parent 9fc66414b5
commit 3040d9746b
8 changed files with 108 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-web/src/base/custcgi.pp
View File

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

2
packages/fcl-web/src/base/custfcgi.pp
View File

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

35
packages/fcl-web/src/base/custhttpapp.pp
View File

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

30
packages/fcl-web/src/base/custweb.pp
View File

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

2
packages/fcl-web/src/base/fpapache.pp
View File

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

15
packages/fcl-web/src/base/fphttpserver.pp
View File

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

15
packages/fcl-web/src/base/fpwebfile.pp
View File

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

16
packages/fcl-web/src/base/httpdefs.pp
View File

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