mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 07:19:27 +02:00
* Version of apache module application that works with Apache 2.4
git-svn-id: trunk@23208 -
This commit is contained in:
michael
parent
5180320841
commit
17ec1d4266
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2887,6 +2887,7 @@ packages/fcl-web/src/base/custweb.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/ezcgi.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fcgigate.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fpapache.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fpapache24.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fpcgi.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fpdatasetform.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fpfcgi.pp svneol=native#text/plain
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -9,7 +9,7 @@ version=2.7.1
|
||||
[target]
|
||||
units=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb \
|
||||
webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver \
|
||||
fphttpclient custhttpapp fphttpapp fpwebfile
|
||||
fphttpclient custhttpapp fphttpapp fpwebfile fpapache24
|
||||
rsts=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
|
||||
|
||||
# these units are listed separately because they don't work for
|
||||
@ -26,7 +26,7 @@ units_win64=custfcgi fpfcgi
|
||||
units_aix=custfcgi fpfcgi
|
||||
|
||||
[require]
|
||||
packages=fcl-base fcl-xml fcl-db fcl-process httpd22 fastcgi fcl-net
|
||||
packages=fcl-base fcl-xml fcl-db fcl-process httpd22 fastcgi fcl-net httpd24
|
||||
packages_darwin=univint
|
||||
packages_iphonesim=univint
|
||||
|
||||
|
||||
781
packages/fcl-web/src/base/fpapache24.pp
Normal file
781
packages/fcl-web/src/base/fpapache24.pp
Normal file
@ -0,0 +1,781 @@
|
||||
{
|
||||
$Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 1999-2000 by the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
unit fpapache24;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, CustWeb, httpDefs, fpHTTP, httpd24, apr24, SyncObjs;
|
||||
|
||||
Type
|
||||
|
||||
TApacheHandler = Class;
|
||||
|
||||
{ TApacheRequest }
|
||||
|
||||
TApacheRequest = Class(TRequest)
|
||||
Private
|
||||
FApache : TApacheHandler;
|
||||
FRequest : PRequest_rec;
|
||||
Protected
|
||||
Function GetFieldValue(Index : Integer) : String; override;
|
||||
Procedure InitFromRequest;
|
||||
procedure ReadContent; override;
|
||||
Public
|
||||
Constructor CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
|
||||
Property ApacheRequest : Prequest_rec Read FRequest;
|
||||
Property ApacheApp : TApacheHandler Read FApache;
|
||||
end;
|
||||
|
||||
{ TApacheResponse }
|
||||
|
||||
TApacheResponse = Class(TResponse)
|
||||
private
|
||||
FApache : TApacheHandler;
|
||||
FRequest : PRequest_rec;
|
||||
procedure SendStream(S: TStream);
|
||||
Protected
|
||||
Procedure DoSendHeaders(Headers : TStrings); override;
|
||||
Procedure DoSendContent; override;
|
||||
Public
|
||||
Constructor CreateApache(Req : TApacheRequest);
|
||||
Property ApacheRequest : Prequest_rec Read FRequest;
|
||||
Property ApacheApp : TApacheHandler Read FApache;
|
||||
end;
|
||||
|
||||
{ TCustomApacheApplication }
|
||||
THandlerPriority = (hpFirst,hpMiddle,hpLast);
|
||||
TBeforeRequestEvent = Procedure(Sender : TObject; Const AHandler : String;
|
||||
Var AllowRequest : Boolean) of object;
|
||||
|
||||
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
|
||||
FIdleWebModules: TList; //List of idle web modules available
|
||||
FCriticalSection: TCriticalSection;
|
||||
FBaseLocation: String;
|
||||
FBeforeRequest: TBeforeRequestEvent;
|
||||
FHandlerName: String;
|
||||
FModuleName: String;
|
||||
FModules : Array[0..1] of TStrings;
|
||||
FPriority: THandlerPriority;
|
||||
FModuleRecord : PModule;
|
||||
function GetModules(Index: integer): TStrings;
|
||||
procedure SetModules(Index: integer; const AValue: TStrings);
|
||||
function GetIdleModuleCount : Integer;
|
||||
function GetWorkingModuleCount : Integer;
|
||||
Protected
|
||||
Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
|
||||
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;
|
||||
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;
|
||||
Property BeforeModules : TStrings Index 0 Read GetModules Write SetModules;
|
||||
Property AfterModules : TStrings Index 1 Read GetModules Write SetModules;
|
||||
Property BaseLocation : String Read FBaseLocation Write FBaseLocation;
|
||||
Property ModuleName : String Read FModuleName Write FModuleName;
|
||||
Property HandlerName : String Read FHandlerName Write FHandlerName;
|
||||
Property BeforeRequest : TBeforeRequestEvent Read FBeforeRequest Write FBeforeRequest;
|
||||
Property MaxRequests: Integer read FMaxRequests write FMaxRequests;
|
||||
Property IdleWebModuleCount: Integer read GetIdleModuleCount;
|
||||
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 Initialize;override;
|
||||
procedure ShowException(E: Exception); override;
|
||||
Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
|
||||
Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
|
||||
Procedure SetModuleRecord(Var ModuleRecord : Module);
|
||||
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;
|
||||
Property BeforeModules;
|
||||
Property AfterModules;
|
||||
Property AllowDefaultModule;
|
||||
Property OnGetModule;
|
||||
Property BaseLocation;
|
||||
Property ModuleName;
|
||||
Property MaxRequests;
|
||||
Property IdleWebModuleCount;
|
||||
Property WorkingWebModuleCount;
|
||||
end;
|
||||
|
||||
|
||||
EFPApacheError = Class(Exception);
|
||||
|
||||
Var
|
||||
Application : TCustomApacheApplication = Nil;
|
||||
ShowCleanUpErrors : Boolean = False;
|
||||
AlternateHandler : ap_hook_handler_t = Nil;
|
||||
|
||||
Implementation
|
||||
|
||||
uses CustApp;
|
||||
|
||||
resourcestring
|
||||
SErrNoModuleNameForRequest = 'Could not determine HTTP module name for request';
|
||||
SErrNoModuleForRequest = 'Could not determine HTTP module for request "%s"';
|
||||
SErrNoModuleRecord = 'No module record location set.';
|
||||
SErrNoModuleName = 'No module name set';
|
||||
SErrTooManyRequests = 'Too many simultaneous requests.';
|
||||
|
||||
const
|
||||
HPRIO : Array[THandlerPriority] of Integer
|
||||
= (APR_HOOK_FIRST,APR_HOOK_MIDDLE,APR_HOOK_LAST);
|
||||
|
||||
|
||||
Procedure InitApache;
|
||||
|
||||
begin
|
||||
Application:=TCustomApacheApplication.Create(Nil);
|
||||
if not assigned(CustomApplication) then
|
||||
CustomApplication := Application;
|
||||
end;
|
||||
|
||||
Procedure DoneApache;
|
||||
|
||||
begin
|
||||
Try
|
||||
if CustomApplication=Application then
|
||||
CustomApplication := nil;
|
||||
FreeAndNil(Application);
|
||||
except
|
||||
if ShowCleanUpErrors then
|
||||
Raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function DefaultApacheHandler(P : PRequest_Rec) : integer;cdecl;
|
||||
|
||||
begin
|
||||
If (AlternateHandler<>Nil) then
|
||||
Result:=AlternateHandler(P)
|
||||
else
|
||||
If Application.AllowRequest(P) then
|
||||
Result:=Application.ProcessRequest(P)
|
||||
else
|
||||
Result:=DECLINED;
|
||||
end;
|
||||
|
||||
Procedure RegisterApacheHooks(P: PApr_pool_t);cdecl;
|
||||
|
||||
Var
|
||||
H : ap_hook_handler_t;
|
||||
PP1,PP2 : PPChar;
|
||||
|
||||
begin
|
||||
H:=AlternateHandler;
|
||||
If (H=Nil) then
|
||||
H:=@DefaultApacheHandler;
|
||||
PP1:=Nil;
|
||||
PP2:=Nil;
|
||||
ap_hook_handler(H,PP1,PP2,HPRIO[Application.HandlerPriority]);
|
||||
end;
|
||||
|
||||
{ TApacheHandler }
|
||||
|
||||
function TApacheHandler.GetModules(Index: integer): TStrings;
|
||||
begin
|
||||
If (FModules[Index]=Nil) then
|
||||
FModules[Index]:=TStringList.Create;
|
||||
Result:=FModules[Index];
|
||||
end;
|
||||
|
||||
procedure TApacheHandler.SetModules(Index: integer;
|
||||
const AValue: TStrings);
|
||||
begin
|
||||
If (FModules[Index]=Nil) then
|
||||
FModules[Index]:=TStringList.Create;
|
||||
FModules[Index].Assign(AValue);
|
||||
end;
|
||||
|
||||
Function TApacheHandler.ProcessRequest(P: PRequest_Rec) : Integer;
|
||||
|
||||
Var
|
||||
Req : TApacheRequest;
|
||||
Resp : TApacheResponse;
|
||||
|
||||
begin
|
||||
Req:=TApacheRequest.CreateReq(Self,P);
|
||||
Try
|
||||
InitRequest(Req);
|
||||
Req.InitRequestVars;
|
||||
Resp:=TApacheResponse.CreateApache(Req);
|
||||
Try
|
||||
InitResponse(Resp);
|
||||
HandleRequest(Req,Resp);
|
||||
If Not Resp.ContentSent then
|
||||
Resp.SendContent;
|
||||
Finally
|
||||
Result:=OK;
|
||||
Resp.Free;
|
||||
end;
|
||||
Finally
|
||||
Req.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TApacheHandler.Run;
|
||||
begin
|
||||
// Do nothing. This is a library
|
||||
Initialize;
|
||||
end;
|
||||
|
||||
function TApacheHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
|
||||
begin
|
||||
Result:=False;
|
||||
ARequest:=Nil;
|
||||
AResponse:=Nil;
|
||||
end;
|
||||
|
||||
function TApacheHandler.AllowRequest(P: PRequest_Rec): Boolean;
|
||||
|
||||
Var
|
||||
Hn : String;
|
||||
|
||||
begin
|
||||
HN:=StrPas(p^.Handler);
|
||||
Result:=CompareText(HN,FHandlerName)=0;
|
||||
If Assigned(FBeforeRequest) then
|
||||
FBeforeRequest(Self,HN,Result);
|
||||
end;
|
||||
|
||||
function TApacheHandler.GetApplicationURL(ARequest: TRequest): String;
|
||||
begin
|
||||
Result:=inherited GetApplicationURL(ARequest);
|
||||
If (Result='') then
|
||||
Result:=BaseLocation;
|
||||
end;
|
||||
|
||||
constructor TApacheHandler.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FPriority:=hpMiddle;
|
||||
FMaxRequests:=64;
|
||||
FWorkingWebModules:=TList.Create;
|
||||
FIdleWebModules:=TList.Create;
|
||||
FCriticalSection:=TCriticalSection.Create;
|
||||
end;
|
||||
|
||||
destructor TApacheHandler.Destroy;
|
||||
var I:Integer;
|
||||
begin
|
||||
FCriticalSection.Free;
|
||||
for I := FIdleWebModules.Count - 1 downto 0 do
|
||||
TComponent(FIdleWebModules[I]).Free;
|
||||
FIdleWebModules.Free;
|
||||
for I := FWorkingWebModules.Count - 1 downto 0 do
|
||||
TComponent(FWorkingWebModules[I]).Free;
|
||||
FWorkingWebModules.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
procedure TApacheHandler.SetModuleRecord(var ModuleRecord: Module);
|
||||
begin
|
||||
FModuleRecord:=@ModuleRecord;
|
||||
FillChar(ModuleRecord,SizeOf(ModuleRecord),0);
|
||||
end;
|
||||
|
||||
procedure TApacheHandler.Initialize;
|
||||
|
||||
begin
|
||||
If (FModuleRecord=nil) then
|
||||
Raise EFPApacheError.Create(SErrNoModuleRecord);
|
||||
if (FModuleName='') and (FModuleRecord^.Name=Nil) then
|
||||
Raise EFPApacheError.Create(SErrNoModuleName);
|
||||
STANDARD20_MODULE_STUFF(FModuleRecord^);
|
||||
If (StrPas(FModuleRecord^.name)<>FModuleName) then
|
||||
FModuleRecord^.Name:=PChar(FModuleName);
|
||||
FModuleRecord^.register_hooks:=@RegisterApacheHooks;
|
||||
end;
|
||||
|
||||
procedure TApacheHandler.LogErrorMessage(Msg: String; LogLevel: integer);
|
||||
var a: ap_version_t;
|
||||
begin
|
||||
ap_log_error(pchar(FModuleName), //The file in which this function is called
|
||||
0, //The line number on which this function is called
|
||||
0, //The module_index of the module generating this message
|
||||
LogLevel, //The level of this error message
|
||||
0, //The status code from the previous command
|
||||
Nil, //The server on which we are logging
|
||||
'module: %s', //The format string
|
||||
[pchar(Msg)]) //The arguments to use to fill out fmt.
|
||||
end;
|
||||
|
||||
function TApacheHandler.GetIdleModuleCount : Integer;
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
Result := FIdleWebModules.Count;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TApacheHandler.GetWorkingModuleCount : Integer;
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
Result := FWorkingWebModules.Count;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TApacheHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
|
||||
|
||||
Var
|
||||
MC : TCustomHTTPModuleClass;
|
||||
M : TCustomHTTPModule;
|
||||
MN : String;
|
||||
MI : TModuleItem;
|
||||
|
||||
Procedure GetAWebModule;
|
||||
Var II:Integer;
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
if (FMaxRequests>0) and (FWorkingWebModules.Count>=FMaxRequests) then
|
||||
Raise EFPApacheError.Create(SErrTooManyRequests);
|
||||
if (FIdleWebModules.Count>0) then
|
||||
begin
|
||||
II := FIdleWebModules.Count - 1;
|
||||
while (II>=0) and not (TComponent(FIdleWebModules[II]) is MC) do
|
||||
Dec(II);
|
||||
if (II>=0) then
|
||||
begin
|
||||
M:=TCustomHTTPModule(FIdleWebModules[II]);
|
||||
FIdleWebModules.Delete(II);
|
||||
end;
|
||||
end;
|
||||
if (M=nil) then
|
||||
begin
|
||||
M:=MC.Create(Self);
|
||||
M.Name := '';
|
||||
end;
|
||||
FWorkingWebModules.Add(M);
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
try
|
||||
MC:=Nil;
|
||||
M := Nil;
|
||||
If (OnGetModule<>Nil) then
|
||||
OnGetModule(Self,ARequest,MC);
|
||||
If (MC=Nil) then
|
||||
begin
|
||||
MN:=GetModuleName(ARequest);
|
||||
If (MN='') and Not AllowDefaultModule then
|
||||
Raise EFPApacheError.Create(SErrNoModuleNameForRequest);
|
||||
MI:=ModuleFactory.FindModule(MN);
|
||||
If (MI=Nil) and (ModuleFactory.Count=1) then
|
||||
MI:=ModuleFactory[0];
|
||||
if (MI=Nil) then
|
||||
Raise EFPApacheError.CreateFmt(SErrNoModuleForRequest,[MN]);
|
||||
|
||||
MC:=MI.ModuleClass;
|
||||
end;
|
||||
GetAWebModule;
|
||||
M.HandleRequest(ARequest,AResponse);
|
||||
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
FWorkingWebModules.Remove(M);
|
||||
FIdleWebModules.Add(M);
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
except
|
||||
On E : Exception do
|
||||
begin
|
||||
LogErrorMessage(E.Message,APLOG_ERR);
|
||||
ShowRequestException(AResponse,E);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TApacheRequest }
|
||||
|
||||
function TApacheRequest.GetFieldValue(Index: Integer): String;
|
||||
|
||||
Function MaybeP(P : Pchar) : String;
|
||||
|
||||
begin
|
||||
If (P<>Nil) then
|
||||
Result:=StrPas(P);
|
||||
end;
|
||||
|
||||
var
|
||||
FN : String;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
If (Index in [1..NoHTTPFields]) then
|
||||
begin
|
||||
FN:=HTTPFieldNames[Index];
|
||||
Result:=MaybeP(apr_table_get(FRequest^.headers_in,pchar(FN)));
|
||||
end;
|
||||
if (Result='') and Assigned(FRequest) then
|
||||
case Index of
|
||||
0 : Result:=MaybeP(FRequest^.protocol); // ProtocolVersion
|
||||
7 : Result:=MaybeP(FRequest^.content_encoding); //ContentEncoding
|
||||
25 : Result:=MaybeP(FRequest^.path_info); // PathInfo
|
||||
26 : Result:=MaybeP(FRequest^.filename); // PathTranslated
|
||||
27 : // RemoteAddr
|
||||
If (FRequest^.Connection<>Nil) then
|
||||
Result:=MaybeP(FRequest^.Connection^.remote_ip);
|
||||
28 : // RemoteHost
|
||||
If (FRequest^.Connection<>Nil) then
|
||||
begin
|
||||
Result:=MaybeP(ap_get_remote_host(FRequest^.Connection,
|
||||
FRequest^.per_dir_config,
|
||||
// nil,
|
||||
REMOTE_NAME,@i));
|
||||
end;
|
||||
29 : begin // ScriptName
|
||||
Result:=MaybeP(FRequest^.unparsed_uri);
|
||||
I:=Pos('?',Result)-1;
|
||||
If (I=-1) then
|
||||
I:=Length(Result);
|
||||
Result:=Copy(Result,1,I-Length(PathInfo));
|
||||
end;
|
||||
30 : Result:=IntToStr(ap_get_server_port(FRequest)); // ServerPort
|
||||
31 : Result:=MaybeP(FRequest^.method); // Method
|
||||
32 : Result:=MaybeP(FRequest^.unparsed_uri); // URL
|
||||
33 : Result:=MaybeP(FRequest^.args); // Query
|
||||
34 : Result:=MaybeP(FRequest^.HostName); // Host
|
||||
else
|
||||
Result:=inherited GetFieldValue(Index);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TApacheRequest.ReadContent;
|
||||
|
||||
Function MinS(A,B : Integer) : Integer;
|
||||
|
||||
begin
|
||||
If A<B then
|
||||
Result:=A
|
||||
else
|
||||
Result:=B;
|
||||
end;
|
||||
|
||||
Var
|
||||
Left,Len,Count,Bytes : Integer;
|
||||
P : Pchar;
|
||||
|
||||
begin
|
||||
ap_setup_client_block(FRequest,REQUEST_CHUNKED_DECHUNK);
|
||||
If (ap_should_client_block(FRequest)=1) then
|
||||
begin
|
||||
Len:=ContentLength;
|
||||
If (Len>0) then
|
||||
begin
|
||||
SetLength(FContent,Len);
|
||||
P:=PChar(FContent);
|
||||
Left:=Len;
|
||||
Count:=0;
|
||||
Repeat
|
||||
Bytes:=ap_get_client_block(FRequest,P,MinS(10*1024,Left));
|
||||
Dec(Left,Bytes);
|
||||
Inc(P,Bytes);
|
||||
Inc(Count,Bytes);
|
||||
Until (Count>=Len) or (Bytes=0);
|
||||
SetLength(FContent,Count);
|
||||
end;
|
||||
end;
|
||||
FContentRead:=True;
|
||||
end;
|
||||
|
||||
procedure TApacheRequest.InitFromRequest;
|
||||
begin
|
||||
ParseCookies;
|
||||
end;
|
||||
|
||||
Constructor TApacheRequest.CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
|
||||
|
||||
begin
|
||||
FApache:=App;
|
||||
FRequest:=Arequest;
|
||||
ReturnedPathInfo:=App.BaseLocation;
|
||||
Inherited Create;
|
||||
InitFromRequest;
|
||||
end;
|
||||
|
||||
{ TApacheResponse }
|
||||
|
||||
procedure TApacheResponse.DoSendHeaders(Headers: TStrings);
|
||||
|
||||
Var
|
||||
I,P : Integer;
|
||||
N,V : String;
|
||||
|
||||
begin
|
||||
For I:=0 to Headers.Count-1 do
|
||||
begin
|
||||
V:=Headers[i];
|
||||
P:=Pos(':',V);
|
||||
If (P<>0) and (P<Length(V)) then
|
||||
begin
|
||||
N:=Copy(V,1,P-1);
|
||||
System.Delete(V,1,P);
|
||||
V := Trim(V);//no need space before the value, apache puts it there
|
||||
apr_table_set(FRequest^.headers_out,Pchar(N),Pchar(V));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TApacheResponse.DoSendContent;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
S:=ContentType;
|
||||
If (S<>'') then
|
||||
FRequest^.content_type:=apr_pstrdup(FRequest^.pool,Pchar(S));
|
||||
S:=ContentEncoding;
|
||||
If (S<>'') then
|
||||
FRequest^.content_encoding:=apr_pstrdup(FRequest^.pool,Pchar(S));
|
||||
If Code <> 200 then
|
||||
FRequest^.status := Code;
|
||||
If assigned(ContentStream) then
|
||||
SendStream(Contentstream)
|
||||
else
|
||||
for I:=0 to Contents.Count-1 do
|
||||
begin
|
||||
S:=Contents[i]+LineEnding;
|
||||
// If there is a null, it's written also with ap_rwrite
|
||||
ap_rwrite(PChar(S),Length(S),FRequest);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TApacheResponse.SendStream(S : TStream);
|
||||
|
||||
Var
|
||||
Buf : Array[0..(10*1024)-1] of Byte;
|
||||
Count : Integer;
|
||||
|
||||
begin
|
||||
S.Seek(0,soBeginning);
|
||||
Repeat
|
||||
Count:=S.Read(Buf,SizeOf(Buf));
|
||||
If Count>0 then
|
||||
ap_rwrite(@Buf,Count,FRequest);
|
||||
Until (Count=0);
|
||||
end;
|
||||
|
||||
|
||||
Constructor TApacheResponse.CreateApache(Req : TApacheRequest);
|
||||
begin
|
||||
FApache:=Req.ApacheApp;
|
||||
Frequest:=Req.ApacheRequest;
|
||||
Inherited Create(Req);
|
||||
end;
|
||||
|
||||
function __dummythread(p: pointer): ptrint;
|
||||
begin
|
||||
sleep(1000);
|
||||
Result:=0;
|
||||
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.Initialize;
|
||||
begin
|
||||
Inherited;
|
||||
TApacheHandler(WebHandler).Initialize;
|
||||
end;
|
||||
|
||||
procedure TCustomApacheApplication.ShowException(E: Exception);
|
||||
begin
|
||||
ap_log_error(PChar(TApacheHandler(WebHandler).ModuleName), //The file in which this function is called
|
||||
0, //The line number on which this function is called
|
||||
0, //The module_index of the module generating this message
|
||||
APLOG_ERR, //The level of this error message
|
||||
0, //The status code from the previous command
|
||||
Nil, //The server on which we are logging
|
||||
'module: %s', //The format string
|
||||
[Pchar(E.Message)]); //The arguments to use to fill out fmt.
|
||||
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;
|
||||
|
||||
procedure TCustomApacheApplication.SetModuleRecord(var ModuleRecord: Module);
|
||||
begin
|
||||
TApacheHandler(WebHandler).SetModuleRecord(ModuleRecord);
|
||||
end;
|
||||
|
||||
Initialization
|
||||
BeginThread(@__dummythread);//crash prevention for simultaneous requests
|
||||
InitApache;
|
||||
|
||||
Finalization
|
||||
DoneApache;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user