diff options
| author | joost <joost@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2010-07-21 10:24:01 +0000 |
|---|---|---|
| committer | joost <joost@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2010-07-21 10:24:01 +0000 |
| commit | 1005cc067037208cf59094a3102865f9eacf6ef3 (patch) | |
| tree | 95ca8d27e8c35d38ffcc20c6b8be4ba693248e02 /packages/fcl-web/src | |
| parent | bb9dac1603891ba898f4cfd49c08a386f3879630 (diff) | |
| download | fpc-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.pp | 213 | ||||
| -rw-r--r-- | packages/fcl-web/src/base/custfcgi.pp | 86 | ||||
| -rw-r--r-- | packages/fcl-web/src/base/custweb.pp | 274 | ||||
| -rw-r--r-- | packages/fcl-web/src/base/fcgigate.pp | 104 | ||||
| -rw-r--r-- | packages/fcl-web/src/base/fpapache.pp | 213 |
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); |
