paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 22:49:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added TCustomApacheApplication.LogErrorMessage

Browse Source 
* Fixed AV in TCustomApacheApplication.GetModuleName, same as r11987 for 
   cgi-applications
 * Fixed output of streamed content

git-svn-id: trunk@12746 -
This commit is contained in:
joost 2009-02-16 20:47:54 +00:00
parent e58d8d6b92
commit b8d46defc5
1 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
packages/fcl-web/src/fpapache.pp
View File

@ -102,6 +102,7 @@ Type
Procedure SetModuleRecord(Var ModuleRecord : Module); Procedure SetModuleRecord(Var ModuleRecord : Module);
Procedure Initialize; override; Procedure Initialize; override;
Procedure ShowException(E : Exception); override; Procedure ShowException(E : Exception); override;
Procedure LogErrorMessage(Msg : String; LogLevel : integer = APLOG_INFO); virtual;
Procedure CreateForm(AClass : TComponentClass; Var Reference : TComponent); Procedure CreateForm(AClass : TComponentClass; Var Reference : TComponent);
Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); virtual; Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule; Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
@ -245,8 +246,16 @@ begin
end; end;
function TCustomApacheApplication.GetModuleName(Arequest: TRequest): string; function TCustomApacheApplication.GetModuleName(Arequest: TRequest): string;
var s : string;
begin begin
if (Pos('/', pchar(@ARequest.PathInfo[2])) <= 0) and AllowDefaultModule then Exit;//There is only 1 '/' in ARequest.PathInfo -> only ActionName is there -> use default module If (Result='') then
begin
S:=ARequest.PathInfo;
Delete(S,1,1);
if (Pos('/',S) <= 0) and AllowDefaultModule then
Exit;//There is only 1 '/' in ARequest.PathInfo -> only ActionName is there -> use default module
Result:=ARequest.GetNextPathInfo;
end;
Result:=ARequest.GetNextPathInfo; Result:=ARequest.GetNextPathInfo;
end; end;
@ -378,6 +387,12 @@ begin
ap_log_error(pchar(FModuleName),0,APLOG_ERR,0,Nil,'module: %s',[Pchar(E.Message)]); ap_log_error(pchar(FModuleName),0,APLOG_ERR,0,Nil,'module: %s',[Pchar(E.Message)]);
end; end;
procedure TCustomApacheApplication.LogErrorMessage(Msg: String;
LogLevel: integer);
begin
ap_log_error(pchar(FModuleName),0,LogLevel,0,Nil,'module: %s',[pchar(Msg)]);
end;
procedure TCustomApacheApplication.CreateForm(AClass: TComponentClass; procedure TCustomApacheApplication.CreateForm(AClass: TComponentClass;
var Reference: TComponent); var Reference: TComponent);
begin begin
@ -472,7 +487,10 @@ begin
end; end;
except except
On E : Exception do On E : Exception do
begin
ShowException(E);
ShowRequestException(AResponse,E); ShowRequestException(AResponse,E);
end;
end; end;
end; end;
@ -627,7 +645,7 @@ begin
S:=ContentType; S:=ContentType;
If (S<>'') then If (S<>'') then
FRequest^.content_type:=apr_pstrdup(FRequest^.pool,Pchar(S)); FRequest^.content_type:=apr_pstrdup(FRequest^.pool,Pchar(S));
If (ContentStream<>Nil) then If assigned(ContentStream) then
SendStream(Contentstream) SendStream(Contentstream)
else else
for I:=0 to Contents.Count-1 do for I:=0 to Contents.Count-1 do
@ -645,6 +663,7 @@ Var
Count : Integer; Count : Integer;
begin begin
S.Seek(0,soBeginning);
Repeat Repeat
Count:=S.Read(Buf,SizeOf(Buf)); Count:=S.Read(Buf,SizeOf(Buf));
If Count>0 then If Count>0 then