summaryrefslogtreecommitdiff
path: root/packages/fcl-web/src
diff options
context:
space:
mode:
authorjoost <joost@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-07-21 10:24:01 +0000
committerjoost <joost@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-07-21 10:24:01 +0000
commit1005cc067037208cf59094a3102865f9eacf6ef3 (patch)
tree95ca8d27e8c35d38ffcc20c6b8be4ba693248e02 /packages/fcl-web/src
parentbb9dac1603891ba898f4cfd49c08a386f3879630 (diff)
downloadfpc-1005cc067037208cf59094a3102865f9eacf6ef3.tar.gz
* Moved the handling of web-request from the TCustomWebApplication to a new class
TWebHandler. TCustomWebApplication and derivates are now a wrapper around the TWebHandler * Added TWebHandler.OnIdle event git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15621 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/fcl-web/src')
-rw-r--r--packages/fcl-web/src/base/custcgi.pp213
-rw-r--r--packages/fcl-web/src/base/custfcgi.pp86
-rw-r--r--packages/fcl-web/src/base/custweb.pp274
-rw-r--r--packages/fcl-web/src/base/fcgigate.pp104
-rw-r--r--packages/fcl-web/src/base/fpapache.pp213
5 files changed, 654 insertions, 236 deletions
diff --git a/packages/fcl-web/src/base/custcgi.pp b/packages/fcl-web/src/base/custcgi.pp
index 047ba81eca..9f3aa610b8 100644
--- a/packages/fcl-web/src/base/custcgi.pp
+++ b/packages/fcl-web/src/base/custcgi.pp
@@ -25,18 +25,18 @@ uses
Type
{ TCGIRequest }
- TCustomCGIApplication = Class;
+ TCGIHandler = Class;
TCGIRequest = Class(TRequest)
Private
- FCGI : TCustomCGIApplication;
+ FCGI : TCGIHandler;
function GetCGIVar(Index: integer): String;
Protected
Function GetFieldValue(Index : Integer) : String; override;
Procedure InitFromEnvironment;
procedure ReadContent; override;
Public
- Constructor CreateCGI(ACGI : TCustomCGIApplication);
+ Constructor CreateCGI(ACGI : TCGIHandler);
Property GatewayInterface : String Index 1 Read GetCGIVar;
Property RemoteIdent : String Index 2 read GetCGIVar;
Property RemoteUser : String Index 3 read GetCGIVar;
@@ -50,24 +50,22 @@ Type
TCGIResponse = Class(TResponse)
private
- FCGI : TCustomCGIApplication;
+ FCGI : TCGIHandler;
FOutput : TStream;
Protected
Procedure DoSendHeaders(Headers : TStrings); override;
Procedure DoSendContent; override;
Public
- Constructor CreateCGI(ACGI : TCustomCGIApplication; AStream : TStream);
+ Constructor CreateCGI(ACGI : TCGIHandler; AStream : TStream);
end;
{ TCustomCgiApplication }
- TCustomCGIApplication = Class(TCustomWebApplication)
+ TCgiHandler = Class(TWebHandler)
Private
FResponse : TCGIResponse;
FRequest : TCGIRequest;
FOutput : TStream;
- Function GetRequestVariable(Const VarName : String) : String;
- Function GetRequestVariableCount : Integer;
protected
Function GetEmail : String; override;
Function GetAdministrator : String; override;
@@ -76,20 +74,37 @@ Type
function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
Public
+ Procedure GetCGIVarList(List : TStrings);
Property Request : TCGIRequest read FRequest;
Property Response: TCGIResponse Read FResponse;
+ end;
+
+ { TCustomCgiApplication }
+
+ TCustomCGIApplication = Class(TCustomWebApplication)
+ private
+ function GetRequest: TCGIRequest;
+ function GetRequestVariable(VarName : String): String;
+ function GetRequestVariableCount: Integer;
+ function GetResponse: TCGIResponse;
+ protected
+ function InitializeWebHandler: TWebHandler; override;
+ public
+ Procedure ShowException(E: Exception);override;
+ Property Request : TCGIRequest read GetRequest;
+ Property Response: TCGIResponse Read GetResponse;
Procedure AddResponse(Const S : String);
Procedure AddResponse(Const Fmt : String; Args : Array of const);
Procedure AddResponseLn(Const S : String);
Procedure AddResponseLn(Const Fmt : String; Args : Array of const);
Procedure GetCGIVarList(List : TStrings);
- Procedure ShowException(E: Exception);override;
Function VariableIsUploadedFile(Const VarName : String) : boolean;
Function UploadedFileName(Const VarName : String) : String;
Property RequestVariables[VarName : String] : String Read GetRequestVariable;
Property RequestVariableCount : Integer Read GetRequestVariableCount;
end;
+
ResourceString
SWebMaster = 'webmaster';
SErrNoContentLength = 'No content length passed from server!';
@@ -143,7 +158,7 @@ Const
{ 36: 'XHTTPREQUESTEDWITH' } ''
);
-Procedure TCustomCGIApplication.GetCGIVarList(List : TStrings);
+Procedure TCgiHandler.GetCGIVarList(List : TStrings);
Var
I : Integer;
@@ -154,16 +169,7 @@ begin
List.Add(CGIVarNames[i]+'='+GetEnvironmentVariable(CGIVarNames[i]));
end;
-
-Procedure TCustomCGIApplication.ShowException(E: Exception);
-begin
- if assigned(FResponse) then
- ShowRequestException(FResponse,E)
- else
- inherited ShowException(E);
-end;
-
-Function TCustomCGIApplication.GetEmail : String;
+Function TCgiHandler.GetEmail : String;
Var
H : String;
@@ -178,7 +184,7 @@ begin
end;
end;
-Function TCustomCGIApplication.GetAdministrator : String;
+Function TCgiHandler.GetAdministrator : String;
begin
Result:=Inherited GetAdministrator;
@@ -186,17 +192,17 @@ begin
Result:=SWebMaster;
end;
-function TCustomCGIApplication.CreateResponse(AOutput : TStream): TCGIResponse;
+function TCgiHandler.CreateResponse(AOutput : TStream): TCGIResponse;
begin
- TCGIResponse.CreateCGI(Self,AOutput);
+ result := TCGIResponse.CreateCGI(Self,AOutput);
end;
-function TCustomCGIApplication.CreateRequest: TCGIRequest;
+function TCgiHandler.CreateRequest: TCGIRequest;
begin
Result:=TCGIRequest.CreateCGI(Self);
end;
-function TCustomCGIApplication.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+function TCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
begin
FRequest:=CreateRequest;
FRequest.InitFromEnvironment;
@@ -208,83 +214,19 @@ begin
Result := True;
end;
-procedure TCustomCGIApplication.EndRequest(ARequest: TRequest;
- AResponse: TResponse);
+procedure TCgiHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
begin
inherited;
FreeAndNil(FOutPut);
Terminate;
end;
-constructor TCGIRequest.CreateCGI(ACGI: TCustomCGIApplication);
+constructor TCgiRequest.CreateCGI(ACGI: TCgiHandler);
begin
Inherited Create;
FCGI:=ACGI;
end;
-Function TCustomCGIApplication.GetRequestVariable(Const VarName : String) : String;
-
-begin
- If Assigned(Request) then
- Result:=FRequest.QueryFields.Values[VarName]
- else
- Result:='';
-end;
-
-Function TCustomCGIApplication.GetRequestVariableCount : Integer;
-
-begin
- If Assigned(Request) then
- Result:=FRequest.QueryFields.Count
- else
- Result:=0;
-end;
-
-Procedure TCustomCGIApplication.AddResponse(Const S : String);
-
-Var
- L : Integer;
-
-begin
- L:=Length(S);
- If L>0 then
- Response.Content:=Response.Content+S;
-end;
-
-Procedure TCustomCGIApplication.AddResponse(Const Fmt : String; Args : Array of const);
-
-begin
- AddResponse(Format(Fmt,Args));
-end;
-
-Procedure TCustomCGIApplication.AddResponseLN(Const S : String);
-
-
-begin
- AddResponse(S+LineEnding);
-end;
-
-Procedure TCustomCGIApplication.AddResponseLN(Const Fmt : String; Args : Array of const);
-
-begin
- AddResponseLN(Format(Fmt,Args));
-end;
-
-Function TCustomCGIApplication.VariableIsUploadedFile(Const VarName : String) : boolean;
-
-begin
- Result:=FRequest.Files.IndexOfFile(VarName)<>-1;
-end;
-
-Function TCustomCGIApplication.UploadedFileName(Const VarName : String) : String;
-
-begin
- If VariableIsUploadedFile(VarName) then
- Result:=FRequest.Files.FileByName(VarName).LocalFileName
- else
- Result:='';
-end;
-
{ TCGIHTTPRequest }
function TCGIRequest.GetCGIVar(Index: integer): String;
@@ -433,13 +375,100 @@ begin
{$endif}
end;
-constructor TCGIResponse.CreateCGI(ACGI: TCustomCGIApplication; AStream: TStream);
+constructor TCGIResponse.CreateCGI(ACGI: TCgiHandler; AStream: TStream);
begin
inherited Create(ACGI.Request);
FCGI:=ACGI;
FOutput:=AStream;
end;
+{ TCustomCGIApplication }
+
+function TCustomCGIApplication.GetRequest: TCGIRequest;
+begin
+ result := TCgiHandler(WebHandler).Request;
+end;
+
+function TCustomCGIApplication.GetRequestVariable(VarName : String): String;
+begin
+ If Assigned(Request) then
+ Result:=Request.QueryFields.Values[VarName]
+ else
+ Result:='';
+end;
+
+function TCustomCGIApplication.GetRequestVariableCount: Integer;
+begin
+ If Assigned(Request) then
+ Result:=Request.QueryFields.Count
+ else
+ Result:=0;
+end;
+
+function TCustomCGIApplication.GetResponse: TCGIResponse;
+begin
+
+end;
+
+function TCustomCGIApplication.InitializeWebHandler: TWebHandler;
+begin
+ Result:=TCgiHandler.Create(self);
+end;
+
+Procedure TCustomCGIApplication.ShowException(E: Exception);
+var
+ CgiHandler: TCgiHandler;
+begin
+ CgiHandler := WebHandler as TCgiHandler;
+ if assigned(CgiHandler.FResponse) then
+ CgiHandler.ShowRequestException(CgiHandler.FResponse,E)
+ else
+ inherited ShowException(E);
+end;
+
+procedure TCustomCGIApplication.AddResponse(const S: String);
+Var
+ L : Integer;
+
+begin
+ L:=Length(S);
+ If L>0 then
+ Response.Content:=Response.Content+S;
+end;
+
+procedure TCustomCGIApplication.AddResponse(const Fmt: String; Args: array of const);
+begin
+ AddResponse(Format(Fmt,Args));
+end;
+
+procedure TCustomCGIApplication.AddResponseLn(const S: String);
+begin
+ AddResponse(S+LineEnding);
+end;
+
+procedure TCustomCGIApplication.AddResponseLn(const Fmt: String; Args: array of const);
+begin
+ AddResponseLN(Format(Fmt,Args));
+end;
+
+procedure TCustomCGIApplication.GetCGIVarList(List: TStrings);
+begin
+ TCgiHandler(WebHandler).GetCGIVarList(list);
+end;
+
+function TCustomCGIApplication.VariableIsUploadedFile(const VarName: String): boolean;
+begin
+ Result:=Request.Files.IndexOfFile(VarName)<>-1;
+end;
+
+function TCustomCGIApplication.UploadedFileName(const VarName: String): String;
+begin
+ If VariableIsUploadedFile(VarName) then
+ Result:=Request.Files.FileByName(VarName).LocalFileName
+ else
+ Result:='';
+end;
+
initialization
finalization
diff --git a/packages/fcl-web/src/base/custfcgi.pp b/packages/fcl-web/src/base/custfcgi.pp
index 4d92f2b9ad..2cab6f7355 100644
--- a/packages/fcl-web/src/base/custfcgi.pp
+++ b/packages/fcl-web/src/base/custfcgi.pp
@@ -75,9 +75,7 @@ Type
Response : TFCgiResponse;
end;
- { TCustomFCgiApplication }
-
- TCustomFCgiApplication = Class(TCustomWebApplication)
+ TFCgiHandler = class(TWebHandler)
Private
FOnUnknownRecord: TUnknownRecordEvent;
FPO: TProtoColOptions;
@@ -100,6 +98,27 @@ Type
Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
end;
+ { TCustomFCgiApplication }
+
+ TCustomFCgiApplication = Class(TCustomWebApplication)
+ private
+ function GetAddress: string;
+ function GetFPO: TProtoColOptions;
+ function GetOnUnknownRecord: TUnknownRecordEvent;
+ function GetPort: integer;
+ procedure SetAddress(const AValue: string);
+ procedure SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
+ procedure SetPort(const AValue: integer);
+ procedure SetPO(const AValue: TProtoColOptions);
+ protected
+ function InitializeWebHandler: TWebHandler; override;
+ Public
+ property Port: integer read GetPort write SetPort;
+ property Address: string read GetAddress write SetAddress;
+ Property ProtocolOptions : TProtoColOptions Read GetFPO Write SetPO;
+ Property OnUnknownRecord : TUnknownRecordEvent Read GetOnUnknownRecord Write SetOnUnknownRecord;
+ end;
+
ResourceString
SNoInputHandle = 'Failed to open input-handle passed from server. Socket Error: %d';
SNoSocket = 'Failed to open socket. Socket Error: %d';
@@ -372,9 +391,9 @@ begin
Write_FCGIRecord(PFCGI_Header(@EndRequest));
end;
-{ TCustomFCgiApplication }
+{ TFCgiHandler }
-constructor TCustomFCgiApplication.Create(AOwner: TComponent);
+constructor TFCgiHandler.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FRequestsAvail:=5;
@@ -382,7 +401,7 @@ begin
FHandle := THandle(-1);
end;
-destructor TCustomFCgiApplication.Destroy;
+destructor TFCgiHandler.Destroy;
begin
SetLength(FRequestsArray,0);
if (Socket<>0) then
@@ -393,7 +412,7 @@ begin
inherited Destroy;
end;
-procedure TCustomFCgiApplication.EndRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TFCgiHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
begin
with FRequestsArray[TFCGIRequest(ARequest).RequestID] do
begin
@@ -411,7 +430,7 @@ begin
Inherited;
end;
-function TCustomFCgiApplication.Read_FCGIRecord : PFCGI_Header;
+function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
var Header : FCGI_Header;
BytesRead : integer;
@@ -453,7 +472,7 @@ begin
Result := ResRecord;
end;
-function TCustomFCgiApplication.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+function TFCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
var
IAddress : TInetSockAddr;
AddressLength : tsocklen;
@@ -534,7 +553,54 @@ begin
Break;
end;
end;
- until Terminated;
+ until (1<>1);
+end;
+
+{ TCustomFCgiApplication }
+
+function TCustomFCgiApplication.GetAddress: string;
+begin
+ result := TFCgiHandler(WebHandler).Address;
+end;
+
+function TCustomFCgiApplication.GetFPO: TProtoColOptions;
+begin
+ result := TFCgiHandler(WebHandler).ProtocolOptions;
+end;
+
+function TCustomFCgiApplication.GetOnUnknownRecord: TUnknownRecordEvent;
+begin
+ result := TFCgiHandler(WebHandler).OnUnknownRecord;
+end;
+
+function TCustomFCgiApplication.GetPort: integer;
+begin
+ result := TFCgiHandler(WebHandler).Port;
+end;
+
+procedure TCustomFCgiApplication.SetAddress(const AValue: string);
+begin
+ TFCgiHandler(WebHandler).Address := AValue;
+end;
+
+procedure TCustomFCgiApplication.SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
+begin
+ TFCgiHandler(WebHandler).OnUnknownRecord := AValue;
+end;
+
+procedure TCustomFCgiApplication.SetPort(const AValue: integer);
+begin
+ TFCgiHandler(WebHandler).Port := AValue;
+end;
+
+procedure TCustomFCgiApplication.SetPO(const AValue: TProtoColOptions);
+begin
+ TFCgiHandler(WebHandler).ProtocolOptions := AValue;
+end;
+
+function TCustomFCgiApplication.InitializeWebHandler: TWebHandler;
+begin
+ Result:=TFCgiHandler.Create(self);
end;
end.
diff --git a/packages/fcl-web/src/base/custweb.pp b/packages/fcl-web/src/base/custweb.pp
index f7e2e9a8c1..048b3fde1d 100644
--- a/packages/fcl-web/src/base/custweb.pp
+++ b/packages/fcl-web/src/base/custweb.pp
@@ -71,13 +71,19 @@ Const
);
Type
+
{ TCustomWebApplication }
+
TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
Var ModuleClass : TCustomHTTPModuleClass) of object;
TOnShowRequestException = procedure(AResponse: TResponse; AnException: Exception; var handled: boolean);
- TCustomWebApplication = Class(TCustomApplication)
- Private
+ { TWebHandler }
+
+ TWebHandler = class(TComponent)
+ private
+ FOnIdle: TNotifyEvent;
+ FTerminated: boolean;
FAdministrator: String;
FAllowDefaultModule: Boolean;
FApplicationURL: String;
@@ -89,28 +95,23 @@ Type
FHandleGetOnPost : Boolean;
FRedirectOnError : Boolean;
FRedirectOnErrorURL : String;
- FEventLog: TEventLog;
- function GetEventLog: TEventLog;
+ FTitle: string;
protected
+ procedure Terminate;
Function GetModuleName(Arequest : TRequest) : string;
function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; virtual; abstract;
procedure EndRequest(ARequest : TRequest;AResponse : TResponse); virtual;
function FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;
Procedure SetBaseURL(AModule : TCustomHTTPModule; Const AModuleName : String; ARequest : TRequest); virtual;
function GetApplicationURL(ARequest : TRequest): String; virtual;
- Procedure DoRun; override;
procedure ShowRequestException(R: TResponse; E: Exception); virtual;
Function GetEmail : String; virtual;
Function GetAdministrator : String; virtual;
Public
constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- Procedure CreateForm(AClass : TComponentClass; out Reference);
- Procedure Initialize; override;
- Procedure ShowException(E: Exception);override;
+ Procedure Run; virtual;
Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse);
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
- Procedure Log(EventType: TEventType; Msg: String); override;
Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
@@ -120,8 +121,59 @@ Type
Property ModuleVariable : String Read FModuleVar Write FModuleVar;
Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
Property Email : String Read GetEmail Write FEmail;
+ property Title: string read FTitle write FTitle;
Property Administrator : String Read GetAdministrator Write FAdministrator;
property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
+ property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
+ end;
+
+ TCustomWebApplication = Class(TCustomApplication)
+ Private
+ FEventLog: TEventLog;
+ FWebHandler: TWebHandler;
+ function GetAdministrator: String;
+ function GetAllowDefaultModule: Boolean;
+ function GetApplicationURL: String;
+ function GetEmail: String;
+ function GetEventLog: TEventLog;
+ function GetHandleGetOnPost: Boolean;
+ function GetModuleVar: String;
+ function GetOnGetModule: TGetModuleEvent;
+ function GetOnShowRequestException: TOnShowRequestException;
+ function GetRedirectOnError: boolean;
+ function GetRedirectOnErrorURL: string;
+ procedure SetAdministrator(const AValue: String);
+ procedure SetAllowDefaultModule(const AValue: Boolean);
+ procedure SetApplicationURL(const AValue: String);
+ procedure SetEmail(const AValue: String);
+ procedure SetHandleGetOnPost(const AValue: Boolean);
+ procedure SetModuleVar(const AValue: String);
+ procedure SetOnGetModule(const AValue: TGetModuleEvent);
+ procedure SetOnShowRequestException(const AValue: TOnShowRequestException);
+ procedure SetRedirectOnError(const AValue: boolean);
+ procedure SetRedirectOnErrorURL(const AValue: string);
+ protected
+ Procedure DoRun; override;
+ function InitializeWebHandler: TWebHandler; virtual; abstract;
+ procedure SetTitle(const AValue: string); override;
+ property WebHandler: TWebHandler read FWebHandler write FWebHandler;
+ Public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ Procedure CreateForm(AClass : TComponentClass; out Reference);
+ Procedure Initialize; override;
+ Procedure Log(EventType: TEventType; Msg: String); override;
+
+ Property HandleGetOnPost : Boolean Read GetHandleGetOnPost Write SetHandleGetOnPost;
+ Property RedirectOnError : boolean Read GetRedirectOnError Write SetRedirectOnError;
+ Property RedirectOnErrorURL : string Read GetRedirectOnErrorURL Write SetRedirectOnErrorURL;
+ Property ApplicationURL : String Read GetApplicationURL Write SetApplicationURL;
+ Property AllowDefaultModule : Boolean Read GetAllowDefaultModule Write SetAllowDefaultModule;
+ Property ModuleVariable : String Read GetModuleVar Write SetModuleVar;
+ Property OnGetModule : TGetModuleEvent Read GetOnGetModule Write SetOnGetModule;
+ Property Email : String Read GetEmail Write SetEmail;
+ Property Administrator : String Read GetAdministrator Write SetAdministrator;
+ property OnShowRequestException: TOnShowRequestException read GetOnShowRequestException write SetOnShowRequestException;
Property EventLog: TEventLog read GetEventLog;
end;
@@ -173,18 +225,20 @@ begin
end;
end;
-procedure TCustomWebApplication.DoRun;
+procedure TWebHandler.Run;
var ARequest : TRequest;
AResponse : TResponse;
begin
- while not Terminated do
+ while not FTerminated do
begin
if WaitForRequest(ARequest,AResponse) then
DoHandleRequest(ARequest,AResponse);
+ if assigned(OnIdle) then
+ OnIdle(Self);
end;
end;
-procedure TCustomWebApplication.ShowRequestException(R: TResponse; E: Exception);
+procedure TWebHandler.ShowRequestException(R: TResponse; E: Exception);
Var
S : TStrings;
handled: boolean;
@@ -221,27 +275,17 @@ begin
end;
end;
-function TCustomWebApplication.GetEmail: String;
+function TWebHandler.GetEmail: String;
begin
Result := FEmail;
end;
-function TCustomWebApplication.GetAdministrator: String;
+function TWebHandler.GetAdministrator: String;
begin
Result := FAdministrator;
end;
-procedure TCustomWebApplication.ShowException(E: Exception);
-var Buf:ShortString;
-begin
-{$ifdef CGIDEBUG}
- SetLength(Buf,ExceptionErrorMessage(ExceptObject,ExceptAddr,@Buf[1],255));
- senddebug('Exception: ' + Buf);
-{$endif CGIDEBUG}
- inherited ShowException(E);
-end;
-
-procedure TCustomWebApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TWebHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
Var
MC : TCustomHTTPModuleClass;
M : TCustomHTTPModule;
@@ -285,33 +329,19 @@ begin
end;
end;
-procedure TCustomWebApplication.Log(EventType: TEventType; Msg: String);
-begin
- EventLog.log(EventType,Msg);
-end;
-
-Procedure TCustomWebApplication.Initialize;
-
-begin
- StopOnException:=True;
- Inherited;
-end;
-
-function TCustomWebApplication.GetEventLog: TEventLog;
-begin
- if not assigned(FEventLog) then
- FEventLog := TEventLog.Create(self);
- Result := FEventLog;
-end;
-
-function TCustomWebApplication.GetApplicationURL(ARequest: TRequest): String;
+function TWebHandler.GetApplicationURL(ARequest: TRequest): String;
begin
Result:=FApplicationURL;
If (Result='') then
Result:=ARequest.ScriptName;
end;
-function TCustomWebApplication.GetModuleName(Arequest: TRequest): string;
+procedure TWebHandler.Terminate;
+begin
+ FTerminated := true;
+end;
+
+function TWebHandler.GetModuleName(Arequest: TRequest): string;
Function GetDefaultModuleName : String;
@@ -344,13 +374,13 @@ begin
end;
end;
-procedure TCustomWebApplication.EndRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TWebHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
begin
AResponse.Free;
ARequest.Free;
end;
-function TCustomWebApplication.FindModule(ModuleClass: TCustomHTTPModuleClass): TCustomHTTPModule;
+function TWebHandler.FindModule(ModuleClass: TCustomHTTPModuleClass): TCustomHTTPModule;
Var
I : Integer;
begin
@@ -363,7 +393,7 @@ begin
Result:=Nil;
end;
-procedure TCustomWebApplication.SetBaseURL(AModule: TCustomHTTPModule;
+procedure TWebHandler.SetBaseURL(AModule: TCustomHTTPModule;
Const AModuleName : String; ARequest: TRequest);
Var
@@ -382,7 +412,7 @@ begin
AModule.BaseURL:=S+P;
end;
-procedure TCustomWebApplication.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TWebHandler.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
begin
HandleRequest(ARequest,AResponse);
If Not AResponse.ContentSent then
@@ -390,7 +420,7 @@ begin
EndRequest(ARequest,AResponse);
end;
-constructor TCustomWebApplication.Create(AOwner: TComponent);
+constructor TWebHandler.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FModuleVar:='Module'; // Do not localize
@@ -400,16 +430,152 @@ begin
FRedirectOnErrorURL := '';
end;
+{ TCustomWebApplication }
+
+function TCustomWebApplication.GetAdministrator: String;
+begin
+ result := FWebHandler.Administrator;
+end;
+
+function TCustomWebApplication.GetAllowDefaultModule: Boolean;
+begin
+ result := FWebHandler.AllowDefaultModule;
+end;
+
+function TCustomWebApplication.GetApplicationURL: String;
+begin
+ result := FWebHandler.ApplicationURL;
+end;
+
+function TCustomWebApplication.GetEmail: String;
+begin
+ result := FWebHandler.Email;
+end;
+
+function TCustomWebApplication.GetEventLog: TEventLog;
+begin
+ if not assigned(FEventLog) then
+ FEventLog := TEventLog.Create(self);
+ Result := FEventLog;
+end;
+
+function TCustomWebApplication.GetHandleGetOnPost: Boolean;
+begin
+ result := FWebHandler.HandleGetOnPost;
+end;
+
+function TCustomWebApplication.GetModuleVar: String;
+begin
+ result := FWebHandler.ModuleVariable;
+end;
+
+function TCustomWebApplication.GetOnGetModule: TGetModuleEvent;
+begin
+ result := FWebHandler.OnGetModule;
+end;
+
+function TCustomWebApplication.GetOnShowRequestException: TOnShowRequestException;
+begin
+ result := FWebHandler.OnShowRequestException;
+end;
+
+function TCustomWebApplication.GetRedirectOnError: boolean;
+begin
+ result := FWebHandler.RedirectOnError;
+end;
+
+function TCustomWebApplication.GetRedirectOnErrorURL: string;
+begin
+ result := FWebHandler.RedirectOnErrorURL;
+end;
+
+procedure TCustomWebApplication.SetAdministrator(const AValue: String);
+begin
+ FWebHandler.Administrator := AValue;
+end;
+
+procedure TCustomWebApplication.SetAllowDefaultModule(const AValue: Boolean);
+begin
+ FWebHandler.AllowDefaultModule := AValue;
+end;
+
+procedure TCustomWebApplication.SetApplicationURL(const AValue: String);
+begin
+ FWebHandler.ApplicationURL := AValue;
+end;
+
+procedure TCustomWebApplication.SetEmail(const AValue: String);
+begin
+ FWebHandler.Email := AValue;
+end;
+
+procedure TCustomWebApplication.SetHandleGetOnPost(const AValue: Boolean);
+begin
+ FWebHandler.HandleGetOnPost := AValue;
+end;
+
+procedure TCustomWebApplication.SetModuleVar(const AValue: String);
+begin
+ FWebHandler.ModuleVariable := AValue;
+end;
+
+procedure TCustomWebApplication.SetOnGetModule(const AValue: TGetModuleEvent);
+begin
+ FWebHandler.OnGetModule := AValue;
+end;
+
+procedure TCustomWebApplication.SetOnShowRequestException(const AValue: TOnShowRequestException);
+begin
+ FWebHandler.OnShowRequestException := AValue;
+end;
+
+procedure TCustomWebApplication.SetRedirectOnError(const AValue: boolean);
+begin
+ FWebHandler.RedirectOnError := AValue;
+end;
+
+procedure TCustomWebApplication.SetRedirectOnErrorURL(const AValue: string);
+begin
+ FWebHandler.RedirectOnErrorURL :=AValue;
+end;
+
+procedure TCustomWebApplication.DoRun;
+begin
+ FWebHandler.Run;
+end;
+
+procedure TCustomWebApplication.SetTitle(const AValue: string);
+begin
+ inherited SetTitle(AValue);
+ FWebHandler.Title := Title;
+end;
+
+constructor TCustomWebApplication.Create(AOwner: TComponent);
+begin
+ FWebHandler := InitializeWebHandler;
+end;
+
destructor TCustomWebApplication.Destroy;
begin
+ FWebHandler.Free;
if assigned(FEventLog) then
FEventLog.Free;
- inherited Destroy;
end;
procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; out Reference);
begin
- TComponent(Reference):=AClass.Create(Self);
+ TComponent(Reference):=AClass.Create(FWebHandler);
+end;
+
+procedure TCustomWebApplication.Initialize;
+begin
+ StopOnException:=True;
+ Inherited;
+end;
+
+procedure TCustomWebApplication.Log(EventType: TEventType; Msg: String);
+begin
+ EventLog.log(EventType,Msg);
end;
end.
diff --git a/packages/fcl-web/src/base/fcgigate.pp b/packages/fcl-web/src/base/fcgigate.pp
index 8a87d8229c..40c580f75b 100644
--- a/packages/fcl-web/src/base/fcgigate.pp
+++ b/packages/fcl-web/src/base/fcgigate.pp
@@ -54,7 +54,7 @@ uses
{$IFDEF CGIGDEBUG}
dbugintf,
{$endif}
- Classes, SysUtils,httpDefs,custcgi,fastcgi,ssockets,inifiles;
+ Classes, SysUtils,httpDefs,custcgi,fastcgi,ssockets,inifiles,custweb;
Type
@@ -67,7 +67,9 @@ Type
{ TFastCGIGatewayApplication }
- TFastCGIGatewayApplication = Class(TCustomCGIApplication)
+ { TFastCGIGatewayHandler }
+
+ TFastCGIGatewayHandler = Class(TCgiHandler)
private
FConfigFile: String;
FFastCGIBinary: String;
@@ -123,7 +125,7 @@ Type
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;
Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
- Procedure Initialize; override;
+ Procedure Initialize;
Property ConfigFileName : String Read FConfigFile Write SetConfigFile;
Property FastCGIBinary : String Read FFastCGIBinary Write FFastCGIBinary;
Property HostName : String Read FHostName Write SetHostname;
@@ -132,6 +134,13 @@ Type
Property Environment : TStrings Read FEnvironment Write SetEnvironment;
end;
+ TFastCGIGatewayApplication = Class(TCustomCGIApplication)
+ protected
+ function InitializeWebHandler: TWebHandler; override;
+ public
+ Procedure Initialize; override;
+ end;
+
Resourcestring
SErrCouldNotConnectToFCGI = 'Could not connect to FastCGI server.';
SErrNoConnectionData = 'No FastCGI connection data available.';
@@ -157,51 +166,51 @@ implementation
{ TCGIGateWayResponse }
-procedure TCGIGateWayResponse.DoSendHeaders(Headers: TStrings);
+procedure TCGIGatewayResponse.DoSendHeaders(Headers: TStrings);
begin
// Do nothing. Headers are in response from FastCGI and are sent as content;
end;
-procedure TFastCGIGatewayApplication.SetConfigFile(const AValue: String);
+procedure TFastCGIGatewayHandler.SetConfigFile(const AValue: String);
begin
if FConfigFile=AValue then exit;
CheckInitDone;
FConfigFile:=AValue;
end;
-procedure TFastCGIGatewayApplication.SetEnvironment(const AValue: TStrings);
+procedure TFastCGIGatewayHandler.SetEnvironment(const AValue: TStrings);
begin
FEnvironment.Assign(AValue);
end;
-procedure TFastCGIGatewayApplication.SetHostname(const AValue: String);
+procedure TFastCGIGatewayHandler.SetHostname(const AValue: String);
begin
if FHostName=AValue then exit;
CheckInitDone;
FHostName:=AValue;
end;
-procedure TFastCGIGatewayApplication.CheckInitDone;
+procedure TFastCGIGatewayHandler.CheckInitDone;
begin
If FInitDone then
RaiseError(SErrInitDone);
end;
-function TFastCGIGatewayApplication.CreateResponse(AOutput: TStream): TCGIResponse;
+function TFastCGIGatewayHandler.CreateResponse(AOutput: TStream): TCGIResponse;
begin
{$IFDEF CGIGDEBUG}SendMethodEnter('CreateResponse');{$ENDIF}
Result:=TCGIGatewayResponse.CreateCGI(Self,AOutput);
{$IFDEF CGIGDEBUG}SendMethodExit('CreateResponse');{$ENDIF}
end;
-Procedure TFastCGIGatewayApplication.StartFCGIBinary;
+Procedure TFastCGIGatewayHandler.StartFCGIBinary;
begin
ExecuteProcess(FastCGIBinary,'',[]);
end;
-Procedure TFastCGIGatewayApplication.ConnectToFCGI;
+Procedure TFastCGIGatewayHandler.ConnectToFCGI;
begin
try
@@ -237,7 +246,7 @@ begin
Result:=Result+Format('#%.3d',[Ord(S[i])]);
end;
-Function TFastCGIGatewayApplication.EncodeFastCGIParam(N,V : AnsiString) : String;
+Function TFastCGIGatewayHandler.EncodeFastCGIParam(N,V : AnsiString) : String;
Function CalcJump(ALen : Integer) : Integer;
begin
@@ -291,19 +300,19 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('EncodeFastCGIParam');{$ENDIF}
end;
-constructor TFastCGIGatewayApplication.Create(AOwner: TComponent);
+constructor TFastCGIGatewayHandler.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnvironment:=TStringList.Create;
end;
-destructor TFastCGIGatewayApplication.Destroy;
+destructor TFastCGIGatewayHandler.Destroy;
begin
FreeAndNil(FEnvironment);
inherited Destroy;
end;
-Function TFastCGIGatewayApplication.TransformRequestVars : String;
+Function TFastCGIGatewayHandler.TransformRequestVars : String;
Var
L : TStringList;
@@ -328,7 +337,7 @@ begin
end;
end;
-Procedure TFastCGIGatewayApplication.SendFastCGIRecord(P : PFCGI_Header);
+Procedure TFastCGIGatewayHandler.SendFastCGIRecord(P : PFCGI_Header);
Var
Len : Integer;
@@ -341,7 +350,7 @@ begin
end;
-Procedure TFastCGIGatewayApplication.InitFastCGIRecord(P : PFCGI_Header; Const AContentLength, APadLength : Word);
+Procedure TFastCGIGatewayHandler.InitFastCGIRecord(P : PFCGI_Header; Const AContentLength, APadLength : Word);
begin
{$IFDEF CGIGDEBUG}SendMethodEnter('InitFastCGIRecord');{$ENDIF}
@@ -353,7 +362,7 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('InitFastCGIRecord');{$ENDIF}
end;
-function TFastCGIGatewayApplication.CreateFastCGIRecord(const AContentLength: Word) : PFCGI_Header;
+function TFastCGIGatewayHandler.CreateFastCGIRecord(const AContentLength: Word) : PFCGI_Header;
Var
L,PL : INteger;
@@ -370,7 +379,7 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('CreateFastCGIRecord');{$ENDIF}
end;
-Procedure TFastCGIGatewayApplication.SendBeginRequest;
+Procedure TFastCGIGatewayHandler.SendBeginRequest;
Var
Req : FCGI_BeginRequestRecord;
@@ -386,7 +395,7 @@ begin
end;
-Procedure TFastCGIGatewayApplication.SendRequestData(Const ARequest : Trequest);
+Procedure TFastCGIGatewayHandler.SendRequestData(Const ARequest : Trequest);
Procedure SendString(S : String; RecType : Byte);
@@ -429,7 +438,7 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('SendRequestData');{$ENDIF}
end;
-Function TFastCGIGatewayApplication.ReadFastCGIRecord : PFCGI_Header;
+Function TFastCGIGatewayHandler.ReadFastCGIRecord : PFCGI_Header;
var
Header : FCGI_Header;
@@ -468,7 +477,7 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('ReadFastCGIRecord');{$ENDIF}
end;
-Procedure TFastCGIGatewayApplication.ProcessUnknownRecord(Const Rec : PFCGI_Header; Const AResponse : TResponse; Var EOR : Boolean);
+Procedure TFastCGIGatewayHandler.ProcessUnknownRecord(Const Rec : PFCGI_Header; Const AResponse : TResponse; Var EOR : Boolean);
begin
{$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
@@ -477,7 +486,7 @@ begin
{$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
end;
-Procedure TFastCGIGatewayApplication.ReadResponse(AResponse : TResponse);
+Procedure TFastCGIGatewayHandler.ReadResponse(AResponse : TResponse);
Var
Rec : PFCGI_Header;
@@ -518,7 +527,7 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('ReadResponse');{$ENDIF}
end;
-Procedure TFastCGIGatewayApplication.DisconnectfromFCGI;
+Procedure TFastCGIGatewayHandler.DisconnectfromFCGI;
begin
{$IFDEF CGIGDEBUG}SendMethodEnter('DisconnectfromFCGI');{$ENDIF}
@@ -526,7 +535,7 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('DisconnectfromFCGI');{$ENDIF}
end;
-Procedure TFastCGIGatewayApplication.HandleRequest(ARequest : Trequest; AResponse : TResponse);
+Procedure TFastCGIGatewayHandler.HandleRequest(ARequest : Trequest; AResponse : TResponse);
begin
{$IFDEF CGIGDEBUG}SendMethodEnter('Handle request');{$ENDIF}
@@ -541,15 +550,32 @@ begin
{$IFDEF CGIGDEBUG}SendMethodExit('Handle request');{$ENDIF}
end;
-procedure TFastCGIGatewayApplication.RaiseError(Const Msg : String);
+procedure TFastCGIGatewayHandler.Initialize;
+Var
+ Ini : TIniFile;
+begin
+ If (FConfigFile<>'') and FileExists(FConfigFile) then
+ begin
+ Ini:=TIniFile.Create(FConfigFile);
+ try
+ ReadConfigFile(Ini);
+ finally
+ Ini.Free;
+ end;
+ end;
+ if (Hostname='') or (Port=0) then
+ RaiseError(SErrNoConnectionData);
+ FInitDone:=True;
+end;
+
+procedure TFastCGIGatewayHandler.RaiseError(Const Msg : String);
begin
Raise HTTPError.Create(Msg);
end;
-procedure TFastCGIGatewayApplication.ReadConfigFile(Ini : TIniFile);
-
+procedure TFastCGIGatewayHandler.ReadConfigFile(Ini : TIniFile);
begin
With Ini do
begin
@@ -564,28 +590,18 @@ begin
end;
procedure TFastCGIGatewayApplication.Initialize;
-
-Var
- Ini : TIniFile;
-
begin
{$IFDEF CGIGDEBUG}SendMethodEnter('Initialize');{$ENDIF}
inherited Initialize;
- If (FConfigFile<>'') and FileExists(FConfigFile) then
- begin
- Ini:=TIniFile.Create(FConfigFile);
- try
- ReadConfigFile(Ini);
- finally
- Ini.Free;
- end;
- end;
- if (Hostname='') or (Port=0) then
- RaiseError(SErrNoConnectionData);
- FInitDone:=True;
+ TFastCGIGatewayHandler(WebHandler).Initialize;
{$IFDEF CGIGDEBUG}SendMethodExit('Initialize');{$ENDIF}
end;
+function TFastCGIGatewayApplication.InitializeWebHandler: TWebHandler;
+begin
+ Result:=TFastCGIGatewayHandler.Create(self);
+end;
+
Procedure InitCGIGateWay; // Initializes Application.
begin
diff --git a/packages/fcl-web/src/base/fpapache.pp b/packages/fcl-web/src/base/fpapache.pp
index ee05fb1539..143743328d 100644
--- a/packages/fcl-web/src/base/fpapache.pp
+++ b/packages/fcl-web/src/base/fpapache.pp
@@ -22,29 +22,29 @@ uses
Type
- TCustomApacheApplication = Class;
+ TApacheHandler = Class;
{ TApacheRequest }
TApacheRequest = Class(TRequest)
Private
- FApache : TCustomApacheApplication;
+ FApache : TApacheHandler;
FRequest : PRequest_rec;
Protected
Function GetFieldValue(Index : Integer) : String; override;
Procedure InitFromRequest;
procedure ReadContent; override;
Public
- Constructor CreateReq(App : TCustomApacheApplication; ARequest : PRequest_rec);
+ Constructor CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
Property ApacheRequest : Prequest_rec Read FRequest;
- Property ApacheApp : TCustomApacheApplication Read FApache;
+ Property ApacheApp : TApacheHandler Read FApache;
end;
{ TApacheResponse }
TApacheResponse = Class(TResponse)
private
- FApache : TCustomApacheApplication;
+ FApache : TApacheHandler;
FRequest : PRequest_rec;
procedure SendStream(S: TStream);
Protected
@@ -53,7 +53,7 @@ Type
Public
Constructor CreateApache(Req : TApacheRequest);
Property ApacheRequest : Prequest_rec Read FRequest;
- Property ApacheApp : TCustomApacheApplication Read FApache;
+ Property ApacheApp : TApacheHandler Read FApache;
end;
{ TCustomApacheApplication }
@@ -61,7 +61,7 @@ Type
TBeforeRequestEvent = Procedure(Sender : TObject; Const AHandler : String;
Var AllowRequest : Boolean) of object;
- TCustomApacheApplication = Class(TCustomWebApplication)
+ TApacheHandler = Class(TWebHandler)
private
FMaxRequests: Integer; //Maximum number of simultaneous web module requests (default=64, if set to zero no limit)
FWorkingWebModules: TList; //List of currently running web modules handling requests
@@ -80,16 +80,15 @@ Type
function GetWorkingModuleCount : Integer;
Protected
Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
- Procedure DoRun; override;
function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
function GetApplicationURL(ARequest : TRequest): String; override;
Public
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;
+ Procedure Run; override;
Procedure SetModuleRecord(Var ModuleRecord : Module);
- Procedure Initialize; override;
- Procedure ShowException(E : Exception); override;
+ Procedure Initialize;
Procedure LogErrorMessage(Msg : String; LogLevel : integer = APLOG_INFO); virtual;
Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); override;
Property HandlerPriority : THandlerPriority Read FPriority Write FPriority default hpMiddle;
@@ -104,6 +103,43 @@ Type
Property WorkingWebModuleCount: Integer read GetWorkingModuleCount;
end;
+ TCustomApacheApplication = Class(TCustomWebApplication)
+ private
+ function GetAfterModules: TStrings;
+ function GetBaseLocation: String;
+ function GetBeforeModules: TStrings;
+ function GetBeforeRequest: TBeforeRequestEvent;
+ function GetHandlerName: String;
+ function GetIdleModuleCount: Integer;
+ function GetMaxRequests: Integer;
+ function GetModuleName: String;
+ function GetPriority: THandlerPriority;
+ function GetWorkingModuleCount: Integer;
+ procedure SetAfterModules(const AValue: TStrings);
+ procedure SetBaseLocation(const AValue: String);
+ procedure SetBeforeModules(const AValue: TStrings);
+ procedure SetBeforeRequest(const AValue: TBeforeRequestEvent);
+ procedure SetHandlerName(const AValue: String);
+ procedure SetMaxRequests(const AValue: Integer);
+ procedure SetModuleName(const AValue: String);
+ procedure SetPriority(const AValue: THandlerPriority);
+ public
+ function InitializeWebHandler: TWebHandler; override;
+ procedure ShowException(E: Exception); override;
+ Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
+ Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
+ Property HandlerPriority : THandlerPriority Read GetPriority Write SetPriority default hpMiddle;
+ Property BeforeModules : TStrings Read GetBeforeModules Write SetBeforeModules;
+ Property AfterModules : TStrings Read GetAfterModules Write SetAfterModules;
+ Property BaseLocation : String Read GetBaseLocation Write SetBaseLocation;
+ Property ModuleName : String Read GetModuleName Write SetModuleName;
+ Property HandlerName : String Read GetHandlerName Write SetHandlerName;
+ Property BeforeRequest : TBeforeRequestEvent Read GetBeforeRequest Write SetBeforeRequest;
+ Property MaxRequests: Integer read GetMaxRequests write SetMaxRequests;
+ Property IdleWebModuleCount: Integer read GetIdleModuleCount;
+ Property WorkingWebModuleCount: Integer read GetWorkingModuleCount;
+ end;
+
TApacheApplication = Class(TCustomApacheApplication)
Public
Property HandlerPriority;
@@ -184,16 +220,16 @@ begin
ap_hook_handler(H,PP1,PP2,HPRIO[Application.HandlerPriority]);
end;
-{ TCustomApacheApplication }
+{ TApacheHandler }
-function TCustomApacheApplication.GetModules(Index: integer): TStrings;
+function TApacheHandler.GetModules(Index: integer): TStrings;
begin
If (FModules[Index]=Nil) then
FModules[Index]:=TStringList.Create;
Result:=FModules[Index];
end;
-procedure TCustomApacheApplication.SetModules(Index: integer;
+procedure TApacheHandler.SetModules(Index: integer;
const AValue: TStrings);
begin
If (FModules[Index]=Nil) then
@@ -201,7 +237,7 @@ begin
FModules[Index].Assign(AValue);
end;
-Function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec) : Integer;
+Function TApacheHandler.ProcessRequest(P: PRequest_Rec) : Integer;
Var
Req : TApacheRequest;
@@ -225,18 +261,18 @@ begin
end;
end;
-procedure TCustomApacheApplication.DoRun;
+procedure TApacheHandler.Run;
begin
// Do nothing. This is a library
+ Initialize;
end;
-function TCustomApacheApplication.WaitForRequest(out ARequest: TRequest;
- out AResponse: TResponse): boolean;
+function TApacheHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
begin
// Do nothing. Requests are triggered by Apache
end;
-function TCustomApacheApplication.AllowRequest(P: PRequest_Rec): Boolean;
+function TApacheHandler.AllowRequest(P: PRequest_Rec): Boolean;
Var
Hn : String;
@@ -248,15 +284,14 @@ begin
FBeforeRequest(Self,HN,Result);
end;
-function TCustomApacheApplication.GetApplicationURL(ARequest: TRequest
- ): String;
+function TApacheHandler.GetApplicationURL(ARequest: TRequest): String;
begin
Result:=inherited GetApplicationURL(ARequest);
If (Result='') then
Result:=BaseLocation;
end;
-constructor TCustomApacheApplication.Create(AOwner: TComponent);
+constructor TApacheHandler.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPriority:=hpMiddle;
@@ -266,7 +301,7 @@ begin
FCriticalSection:=TCriticalSection.Create;
end;
-destructor TCustomApacheApplication.Destroy;
+destructor TApacheHandler.Destroy;
var I:Integer;
begin
FCriticalSection.Free;
@@ -280,13 +315,13 @@ begin
end;
-procedure TCustomApacheApplication.SetModuleRecord(var ModuleRecord: Module);
+procedure TApacheHandler.SetModuleRecord(var ModuleRecord: Module);
begin
FModuleRecord:=@ModuleRecord;
FillChar(ModuleRecord,SizeOf(ModuleRecord),0);
end;
-procedure TCustomApacheApplication.Initialize;
+procedure TApacheHandler.Initialize;
begin
If (FModuleRecord=nil) then
@@ -299,18 +334,12 @@ begin
FModuleRecord^.register_hooks:=@RegisterApacheHooks;
end;
-procedure TCustomApacheApplication.ShowException(E: Exception);
-begin
- ap_log_error(pchar(FModuleName),0,APLOG_ERR,0,Nil,'module: %s',[Pchar(E.Message)]);
-end;
-
-procedure TCustomApacheApplication.LogErrorMessage(Msg: String;
- LogLevel: integer);
+procedure TApacheHandler.LogErrorMessage(Msg: String; LogLevel: integer);
begin
ap_log_error(pchar(FModuleName),0,LogLevel,0,Nil,'module: %s',[pchar(Msg)]);
end;
-function TCustomApacheApplication.GetIdleModuleCount : Integer;
+function TApacheHandler.GetIdleModuleCount : Integer;
begin
FCriticalSection.Enter;
try
@@ -320,7 +349,7 @@ begin
end;
end;
-function TCustomApacheApplication.GetWorkingModuleCount : Integer;
+function TApacheHandler.GetWorkingModuleCount : Integer;
begin
FCriticalSection.Enter;
try
@@ -330,7 +359,7 @@ begin
end;
end;
-procedure TCustomApacheApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TApacheHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
Var
MC : TCustomHTTPModuleClass;
@@ -399,7 +428,7 @@ begin
except
On E : Exception do
begin
- ShowException(E);
+ LogErrorMessage(E.Message,APLOG_ERR);
ShowRequestException(AResponse,E);
end;
end;
@@ -497,7 +526,7 @@ begin
ParseCookies;
end;
-Constructor TApacheRequest.CreateReq(App : TCustomApacheApplication; ARequest : PRequest_rec);
+Constructor TApacheRequest.CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
begin
FApache:=App;
@@ -584,6 +613,118 @@ begin
//empty
end;
+{ TCustomApacheApplication }
+
+function TCustomApacheApplication.GetAfterModules: TStrings;
+begin
+ result := TApacheHandler(WebHandler).AfterModules;
+end;
+
+function TCustomApacheApplication.GetBaseLocation: String;
+begin
+ result := TApacheHandler(WebHandler).BaseLocation;
+end;
+
+function TCustomApacheApplication.GetBeforeModules: TStrings;
+begin
+ result := TApacheHandler(WebHandler).BeforeModules;
+end;
+
+function TCustomApacheApplication.GetBeforeRequest: TBeforeRequestEvent;
+begin
+ result := TApacheHandler(WebHandler).BeforeRequest;
+end;
+
+function TCustomApacheApplication.GetHandlerName: String;
+begin
+ result := TApacheHandler(WebHandler).HandlerName;
+end;
+
+function TCustomApacheApplication.GetIdleModuleCount: Integer;
+begin
+ result := TApacheHandler(WebHandler).IdleWebModuleCount;
+end;
+
+function TCustomApacheApplication.GetMaxRequests: Integer;
+begin
+ result := TApacheHandler(WebHandler).MaxRequests;
+end;
+
+function TCustomApacheApplication.GetModuleName: String;
+begin
+ result := TApacheHandler(WebHandler).ModuleName;
+end;
+
+function TCustomApacheApplication.GetPriority: THandlerPriority;
+begin
+ result := TApacheHandler(WebHandler).HandlerPriority;
+end;
+
+function TCustomApacheApplication.GetWorkingModuleCount: Integer;
+begin
+ result := TApacheHandler(WebHandler).WorkingWebModuleCount;
+end;
+
+procedure TCustomApacheApplication.SetAfterModules(const AValue: TStrings);
+begin
+ TApacheHandler(WebHandler).AfterModules := AValue;
+end;
+
+procedure TCustomApacheApplication.SetBaseLocation(const AValue: String);
+begin
+ TApacheHandler(WebHandler).BaseLocation := AValue;
+end;
+
+procedure TCustomApacheApplication.SetBeforeModules(const AValue: TStrings);
+begin
+ TApacheHandler(WebHandler).BeforeModules := AValue;
+end;
+
+procedure TCustomApacheApplication.SetBeforeRequest(const AValue: TBeforeRequestEvent);
+begin
+ TApacheHandler(WebHandler).BeforeRequest := AValue;
+end;
+
+procedure TCustomApacheApplication.SetHandlerName(const AValue: String);
+begin
+ TApacheHandler(WebHandler).HandlerName := AValue;
+end;
+
+procedure TCustomApacheApplication.SetMaxRequests(const AValue: Integer);
+begin
+ TApacheHandler(WebHandler).MaxRequests := AValue;
+end;
+
+procedure TCustomApacheApplication.SetModuleName(const AValue: String);
+begin
+ TApacheHandler(WebHandler).ModuleName := AValue;
+end;
+
+procedure TCustomApacheApplication.SetPriority(const AValue: THandlerPriority);
+begin
+ TApacheHandler(WebHandler).HandlerPriority := AValue;
+end;
+
+function TCustomApacheApplication.InitializeWebHandler: TWebHandler;
+begin
+ Result:=TApacheHandler.Create(self);
+end;
+
+procedure TCustomApacheApplication.ShowException(E: Exception);
+begin
+ ap_log_error(pchar(TApacheHandler(WebHandler).ModuleName),0,APLOG_ERR,0,Nil,'module: %s',[Pchar(E.Message)]);
+end;
+
+function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec): Integer;
+begin
+ result := TApacheHandler(WebHandler).ProcessRequest(p);
+end;
+
+function TCustomApacheApplication.AllowRequest(P: PRequest_Rec): Boolean;
+begin
+ result := TApacheHandler(WebHandler).AllowRequest(p);
+end;
+
Initialization
BeginThread(@__dummythread);//crash prevention for simultaneous requests
sleep(300);