* Made TCustomCGIApplication a child of TCustomWebApplication

git-svn-id: trunk@12981 -

packages/fcl-web/src/custcgi.pp

@@ -21,53 +21,7 @@ unit custcgi;
 Interface
 
 uses
-  CustApp,Classes,SysUtils, httpdefs;
-
-Const
-  CGIVarCount = 34;
-
-Type
-  TCGIVarArray = Array[1..CGIVarCount] of String;
-
-Const
-  CgiVarNames : TCGIVarArray =
-   ({ 1  } 'AUTH_TYPE',
-    { 2  } 'CONTENT_LENGTH',
-    { 3  } 'CONTENT_TYPE',
-    { 4  } 'GATEWAY_INTERFACE',
-    { 5  } 'PATH_INFO',
-    { 6  } 'PATH_TRANSLATED',
-    { 7  } 'QUERY_STRING',
-    { 8  } 'REMOTE_ADDR',
-    { 9  } 'REMOTE_HOST',
-    { 10 } 'REMOTE_IDENT',
-    { 11 } 'REMOTE_USER',
-    { 12 } 'REQUEST_METHOD',
-    { 13 } 'SCRIPT_NAME',
-    { 14 } 'SERVER_NAME',
-    { 15 } 'SERVER_PORT',
-    { 16 } 'SERVER_PROTOCOL',
-    { 17 } 'SERVER_SOFTWARE',
-    { 18 } 'HTTP_ACCEPT',
-    { 19 } 'HTTP_ACCEPT_CHARSET',
-    { 20 } 'HTTP_ACCEPT_ENCODING',
-    { 21 } 'HTTP_IF_MODIFIED_SINCE',
-    { 22 } 'HTTP_REFERER',
-    { 23 } 'HTTP_USER_AGENT',
-    { 24 } 'HTTP_COOKIE',
-     // Additional Apache vars
-    { 25 } 'HTTP_CONNECTION',
-    { 26 } 'HTTP_ACCEPT_LANGUAGE',
-    { 27 } 'HTTP_HOST',
-    { 28 } 'SERVER_SIGNATURE',
-    { 29 } 'SERVER_ADDR',
-    { 30 } 'DOCUMENT_ROOT',
-    { 31 } 'SERVER_ADMIN',
-    { 32 } 'SCRIPT_FILENAME',
-    { 33 } 'REMOTE_PORT',
-    { 34 } 'REQUEST_URI'
-    );
-    
+  CustWeb,Classes,SysUtils, httpdefs;
 
 Type
   { TCGIRequest }
@@ -107,53 +61,35 @@ Type
 
   { TCustomCgiApplication }
 
-  TCustomCGIApplication = Class(TCustomApplication)
+  TCustomCGIApplication = Class(TCustomWebApplication)
   Private
     FResponse : TCGIResponse;
     FRequest : TCGIRequest;
-    FEmail : String;
-    FAdministrator : String;
     FOutput : TStream;
-    FHandleGetOnPost : Boolean;
-    FRedirectOnError : Boolean;
-    FRedirectOnErrorURL : String;
-    Function GetEmail : String;
-    Function GetAdministrator : String;
     Function GetRequestVariable(Const VarName : String) : String;
     Function GetRequestVariableCount : Integer;
+  protected
+    Function GetEmail : String; override;
+    Function GetAdministrator : String; override;
+    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
+    procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
   Public
-    constructor Create(AOwner: TComponent); override;
-    Destructor Destroy; override;
     Property Request : TCGIRequest read FRequest;
     Property Response: TCGIResponse Read FResponse;
     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 Initialize; override;
     Procedure GetCGIVarList(List : TStrings);
     Procedure ShowException(E: Exception);override;
-    Procedure DeleteFormFiles;
-    Procedure DoRun; override;
-    Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
-    Function GetTempCGIFileName : String;
     Function VariableIsUploadedFile(Const VarName : String) : boolean;
     Function UploadedFileName(Const VarName : String) : String;
-    Property Email : String Read GetEmail Write FEmail;
-    Property Administrator : String Read GetAdministrator Write FAdministrator;
-    Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
     Property RequestVariables[VarName : String] : String Read GetRequestVariable;
     Property RequestVariableCount : Integer Read GetRequestVariableCount;
-    Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
-    Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
   end;
 
 ResourceString
   SWebMaster = 'webmaster';
-  SCGIError  = 'CGI Error';
-  SAppEncounteredError = 'The application encountered the following error:';
-  SError     = 'Error: ';
-  SNotify    = 'Notify: ';
   SErrNoContentLength = 'No content length passed from server!';
 
 Implementation
@@ -203,74 +139,6 @@ Const
     { 34: 'REQUEST_URI'            } ''
   );
 
-
-Destructor TCustomCGIApplication.Destroy;
-
-begin
-  DeleteFormFiles;
-  FreeAndNil(FRequest);
-  FreeAndNil(FResponse);
-  FreeAndNil(FOutPut);
-  Inherited;
-end;
-
-Function TCustomCGIApplication.GetTempCGIFileName : String;
-
-begin
-//Result:=GetTempFileName('/tmp/','CGI') {Hard coded path no good for all OS-es}
-{
-GetTempDir returns the OS temporary directory if possible, or from the
-environment variable TEMP . For CGI programs you need to pass global environment
- variables, it is not automatic. For example in the Apache httpd.conf with a
-"PassEnv TEMP" or "SetEnv TEMP /pathtotmpdir" line so the web server passes this
- global environment variable to the CGI programs' local environment variables.
-}
-  Result := GetTempFileName(GetTempDir, 'CGI');
-end;
-
-Procedure TCustomCGIApplication.DeleteFormFiles;
-
-Var
-  I : Integer;
-  FN : String;
-
-begin
-  If Assigned(FRequest) then
-    For I:=0 to FRequest.Files.Count-1 do
-      begin
-      FN:=FRequest.Files[I].LocalFileName;
-      If FileExists(FN) then
-        DeleteFile(FN);
-      end;
-end;
-
-procedure TCustomCGIApplication.DoRun;
-begin
-  HandleRequest(FRequest,FResponse);
-  If Not FResponse.ContentSent then
-    begin
-    FResponse.SendContent;
-    end;
-  Terminate;
-end;
-
-procedure TCustomCGIApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
-begin
-  // Needs overriding;
-end;
-
-Procedure TCustomCGIApplication.Initialize;
-
-begin
-  StopOnException:=True;
-  Inherited;
-  FRequest:=TCGIRequest.CreateCGI(Self);
-  FRequest.InitFromEnvironment;
-  FRequest.InitRequestVars;
-  FOutput:=TIOStream.Create(iosOutput);
-  FResponse:=TCGIResponse.CreateCGI(Self,Self.FOutput);
-end;
-
 Procedure TCustomCGIApplication.GetCGIVarList(List : TStrings);
 
 Var
@@ -284,54 +152,8 @@ end;
 
 
 Procedure TCustomCGIApplication.ShowException(E: Exception);
-
-Var
-  TheEmail : String;
-  FrameCount: integer;
-  Frames: PPointer;
-  FrameNumber:Integer;
-  S : TStrings;
-
 begin
-  If RedirectOnError and not FResponse.HeadersSent then
-    begin
-    FResponse.Location := RedirectOnErrorURL;
-    FResponse.Code := 301;
-    FResponse.SendContent;
-    Exit;
-    end;
-  If not FResponse.HeadersSent then
-    FResponse.ContentType:='text/html';
-  If (FResponse.ContentType='text/html') then
-    begin
-    S:=TStringList.Create;
-    Try
-      With S do
-        begin
-        Add('<html><head><title>'+Title+': '+SCGIError+'</title></head>'+LineEnding);
-        Add('<body>');
-        Add('<center><hr><h1>'+Title+': ERROR</h1><hr></center><br><br>');
-        Add(SAppEncounteredError+'<br>');
-        Add('<ul>');
-        Add('<li>'+SError+' <b>'+E.Message+'</b>');
-        Add('<li> Stack trace:<br>');
-        Add(BackTraceStrFunc(ExceptAddr)+'<br>');
-        FrameCount:=ExceptFrameCount;
-        Frames:=ExceptFrames;
-        for FrameNumber := 0 to FrameCount-1 do
-          Add(BackTraceStrFunc(Frames[FrameNumber])+'<br>');
-        Add('</ul><hr>');
-        TheEmail:=Email;
-        If (TheEmail<>'') then
-          Add('<h5><p><i>'+SNotify+Administrator+': <a href="mailto:'+TheEmail+'">'+TheEmail+'</a></i></p></h5>');
-        Add('</body></html>');
-        end;
-      FResponse.Content:=S.Text;
-      FResponse.SendContent;
-    Finally
-      FreeAndNil(S);
-    end;
-    end;
+  ShowRequestException(FResponse,E);
 end;
 
 Function TCustomCGIApplication.GetEmail : String;
@@ -340,27 +162,43 @@ Var
   H : String;
 
 begin
-  If (FEmail='') then
+  Result:=inherited GetEmail;
+  If (Result='') then
     begin
     H:=Request.ServerName;
     If (H<>'') then
       Result:=Administrator+'@'+H
-    else
-      Result:='';
-    end
-  else
-    Result:=Email;
+    end;
 end;
 
 Function TCustomCGIApplication.GetAdministrator : String;
 
 begin
-  If (FADministrator<>'') then
-    Result:=FAdministrator
-  else
+  Result:=Inherited GetAdministrator;
+  If (result='') then
     Result:=SWebMaster;
 end;
 
+function TCustomCGIApplication.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+begin
+  FRequest:=TCGIRequest.CreateCGI(Self);
+  FRequest.InitFromEnvironment;
+  FRequest.InitRequestVars;
+  FOutput:=TIOStream.Create(iosOutput);
+  FResponse:=TCGIResponse.CreateCGI(Self,Self.FOutput);
+  ARequest:=FRequest;
+  AResponse:=FResponse;
+  Result := True;
+end;
+
+procedure TCustomCGIApplication.EndRequest(ARequest: TRequest;
+  AResponse: TResponse);
+begin
+  inherited;
+  FreeAndNil(FOutPut);
+  Terminate;
+end;
+
 constructor TCGIRequest.CreateCGI(ACGI: TCustomCGIApplication);
 begin
   Inherited Create;
@@ -385,14 +223,6 @@ begin
     Result:=0;
 end;
 
-constructor TCustomCGIApplication.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FHandleGetOnPost := True;
-  FRedirectOnError := False;
-  FRedirectOnErrorURL := '';
-end;
-
 Procedure TCustomCGIApplication.AddResponse(Const S : String);
 
 Var

packages/fcl-web/src/custfcgi.pp

@@ -69,7 +69,7 @@ Type
     FHandle : THandle;
     function Read_FCGIRecord : PFCGI_Header;
   protected
-    function WaitForRequest(var ARequest : TRequest; var AResponse : TResponse) : boolean; override;
+    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
   Public
     constructor Create(AOwner: TComponent); override;
@@ -387,7 +387,7 @@ begin
   Result := ResRecord;
 end;
 
-function TCustomFCgiApplication.WaitForRequest(var ARequest: TRequest; var AResponse: TResponse): boolean;
+function TCustomFCgiApplication.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 var
   Address       : TInetSockAddr;
   AddressLength : tsocklen;

packages/fcl-web/src/custweb.pp

@@ -86,11 +86,13 @@ Type
     FRedirectOnErrorURL : String;
   protected
     Function GetModuleName(Arequest : TRequest) : string;
-    function WaitForRequest(var ARequest : TRequest; var AResponse : TResponse) : boolean; virtual; abstract;
+    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; virtual; abstract;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); virtual;
     function FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;
     Procedure DoRun; override;
     procedure ShowRequestException(R: TResponse; E: Exception); virtual;
+    Function GetEmail : String; virtual;
+    Function GetAdministrator : String; virtual;
   Public
     constructor Create(AOwner: TComponent); override;
     Procedure CreateForm(AClass : TComponentClass; Var Reference : TComponent);
@@ -104,8 +106,8 @@ Type
     Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
     Property ModuleVariable : String Read FModuleVar Write FModuleVar;
     Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
-    Property Email : String Read FEmail Write FEmail;
-    Property Administrator : String Read FAdministrator Write FAdministrator;
+    Property Email : String Read GetEmail Write FEmail;
+    Property Administrator : String Read GetAdministrator Write FAdministrator;
   end;
 
   EFPWebError = Class(Exception);
@@ -150,6 +152,14 @@ Var
  S : TStrings;
 
 begin
+  if R.ContentSent then exit;
+  If RedirectOnError and not R.HeadersSent then
+    begin
+    R.Location := format(RedirectOnErrorURL,[HTTPEncode(E.Message)]);
+    R.Code := 301;
+    R.SendContent;
+    Exit;
+    end;
   If not R.HeadersSent then
     begin
     R.ContentType:='text/html';
@@ -187,6 +197,16 @@ begin
     end;
 end;
 
+function TCustomWebApplication.GetEmail: String;
+begin
+  Result := FEmail;
+end;
+
+function TCustomWebApplication.GetAdministrator: String;
+begin
+  Result := FAdministrator;
+end;
+
 procedure TCustomWebApplication.ShowException(E: Exception);
 var Buf:ShortString;
 begin

packages/fcl-web/src/fpapache.pp

@@ -81,7 +81,7 @@ Type
   Protected
     Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
     Procedure DoRun; override;
-    function WaitForRequest(var ARequest : TRequest; var AResponse : TResponse) : boolean; override;
+    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
   Public
     Constructor Create(AOwner : TComponent); override;
@@ -229,8 +229,8 @@ begin
   // Do nothing. This is a library
 end;
 
-function TCustomApacheApplication.WaitForRequest(var ARequest: TRequest;
-  var AResponse: TResponse): boolean;
+function TCustomApacheApplication.WaitForRequest(out ARequest: TRequest;
+  out AResponse: TResponse): boolean;
 begin
   // Do nothing. Requests are triggered by Apache
 end;

packages/fcl-web/src/fpcgi.pp

@@ -17,43 +17,21 @@ unit fpcgi;
 
 interface
 
-uses SysUtils,Classes,CustCgi,httpDefs,fpHTTP;
+uses SysUtils,Classes,CustCgi;
 
 Type
 
   { TCGIApplication }
-  TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
-                               Var ModuleClass : TCustomHTTPModuleClass) of object;
 
   TCGIApplication = Class(TCustomCGIApplication)
-  private
-    FModuleVar: String;
-    FOnGetModule: TGetModuleEvent;
-    FAllowDefaultModule: Boolean;
-  Protected
-    Function GetModuleName(Arequest : TRequest) : string;
-    function FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;
-  Public
-    Constructor Create(AOwner : TComponent); override;
-    Procedure CreateForm(AClass : TComponentClass; Var Reference : TComponent);
-    Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); override;
-    Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
-    Property ModuleVariable : String Read FModuleVar Write FModuleVar;
-    Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
   end;
 
-  EFPCGIError = Class(Exception);
-  
 Var
   Application : TCGIApplication;
   ShowCleanUpErrors : Boolean = False;
   
 Implementation
 
-resourcestring
-  SErrNoModuleNameForRequest = 'Could not determine HTTP module name for request';
-  SErrNoModuleForRequest = 'Could not determine HTTP module for request "%s"';
-
 Procedure InitCGI;
 
 begin
@@ -71,86 +49,6 @@ begin
   end;
 end;
 
-{ TCGIApplication }
-
-function TCGIApplication.GetModuleName(Arequest: TRequest): string;
-
-var
-  S : String;
-begin
-  If (FModuleVar<>'') then
-    Result:=ARequest.QueryFields.Values[FModuleVar];//Module name from query parameter using the FModuleVar as parameter name (default is '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;
-end;
-
-function TCGIApplication.FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;
-
-Var
-  I : Integer;
-
-begin
-  I:=ComponentCount-1;
-  While (I>=0) and (Not (Components[i] is ModuleClass)) do
-    Dec(i);
-  if (I>=0) then
-    Result:=Components[i] as TCustomHTTPModule
-  else
-    Result:=Nil;
-end;
-
-constructor TCGIApplication.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FModuleVar:='Module'; // Do not localize
-  FAllowDefaultModule:=True;
-end;
-
-procedure TCGIApplication.CreateForm(AClass: TComponentClass;
-  var Reference: TComponent);
-begin
-  Reference:=AClass.Create(Self);
-end;
-
-procedure TCGIApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
-
-Var
-  MC : TCustomHTTPModuleClass;
-  M  : TCustomHTTPModule;
-  MN : String;
-  MI : TModuleItem;
-  
-begin
-  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 EFPCGIError.Create(SErrNoModuleNameForRequest);
-    MI:=ModuleFactory.FindModule(MN);
-    If (MI=Nil) and (ModuleFactory.Count=1) then
-      MI:=ModuleFactory[0];
-    if (MI=Nil) then
-      begin
-      Raise EFPCGIError.CreateFmt(SErrNoModuleForRequest,[MN]);
-      end;
-    MC:=MI.ModuleClass;
-    end;
-  M:=FindModule(MC); // Check if a module exists already
-  If (M=Nil) then
-    M:=MC.Create(Self);
-  M.HandleRequest(ARequest,AResponse);
-end;
-
 Initialization
   InitCGI;