Browse Source

--- Merging r14489 into '.':
U packages/fcl-web/src/fpweb.pp
U packages/fcl-web/src/fphttp.pp
U packages/fcl-web/src/custweb.pp
--- Merging r14518 into '.':
G packages/fcl-web/src/fphttp.pp
G packages/fcl-web/src/custweb.pp
--- Merging r14520 into '.':
G packages/fcl-web/src/custweb.pp
--- Merging r14528 into '.':
G packages/fcl-web/src/fpweb.pp
--- Merging r14576 into '.':
U packages/fcl-web/src/websession.pp
--- Merging r14651 into '.':
U packages/fcl-web/src/custcgi.pp
U packages/fcl-web/src/custfcgi.pp
G packages/fcl-web/src/custweb.pp

# revisions: 14489,14518,14520,14528,14576,14651
------------------------------------------------------------------------
r14489 | joost | 2009-12-28 11:24:10 +0100 (Mon, 28 Dec 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/custweb.pp
M /trunk/packages/fcl-web/src/fphttp.pp
M /trunk/packages/fcl-web/src/fpweb.pp

* Implemented TCustomHTTPModule.Kind: wkPooled, wkOneShot
------------------------------------------------------------------------
------------------------------------------------------------------------
r14518 | joost | 2010-01-02 13:44:41 +0100 (Sat, 02 Jan 2010) | 2 lines
Changed paths:
M /trunk/packages/fcl-web/src/custweb.pp
M /trunk/packages/fcl-web/src/fphttp.pp

* Fixed streaming of TWebModule.Kind property
* Free the webmodule when Kind is wkOneShot and an exception occurs
------------------------------------------------------------------------
------------------------------------------------------------------------
r14520 | joost | 2010-01-02 13:53:41 +0100 (Sat, 02 Jan 2010) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/custweb.pp

* Removed double code introduced in r14518
------------------------------------------------------------------------
------------------------------------------------------------------------
r14528 | joost | 2010-01-03 12:39:26 +0100 (Sun, 03 Jan 2010) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/fpweb.pp

* Cleanup session for the case that a webmodule instance is used for more then one request (wkPooled)
------------------------------------------------------------------------
------------------------------------------------------------------------
r14576 | joost | 2010-01-08 16:20:41 +0100 (Fri, 08 Jan 2010) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/websession.pp

* Let TSessionHTTPModule.CheckSession really create a new session when there is none
------------------------------------------------------------------------
------------------------------------------------------------------------
r14651 | joost | 2010-01-15 20:42:23 +0100 (Fri, 15 Jan 2010) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/custcgi.pp
M /trunk/packages/fcl-web/src/custfcgi.pp
M /trunk/packages/fcl-web/src/custweb.pp

* Recognition of the XHTTPRequestedWith http header for CGI and FCGI
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14719 -

marco 15 years ago
parent
commit
7654f70d32

+ 4 - 1
packages/fcl-web/src/custcgi.pp

@@ -136,7 +136,9 @@ Const
     { 31: 'SERVER_ADMIN'           } '',
     { 31: 'SERVER_ADMIN'           } '',
     { 32: 'SCRIPT_FILENAME'        } '',
     { 32: 'SCRIPT_FILENAME'        } '',
     { 33: 'REMOTE_PORT'            } '',
     { 33: 'REMOTE_PORT'            } '',
-    { 34: 'REQUEST_URI'            } ''
+    { 34: 'REQUEST_URI'            } '',
+    { 35: 'CONTENT'                } '',
+    { 36: 'XHTTPREQUESTEDWITH'     } ''
   );
   );
 
 
 Procedure TCustomCGIApplication.GetCGIVarList(List : TStrings);
 Procedure TCustomCGIApplication.GetCGIVarList(List : TStrings);
@@ -357,6 +359,7 @@ begin
     30 : Result:=DecodeVar(15); // Property ServerPort
     30 : Result:=DecodeVar(15); // Property ServerPort
     31 : Result:=DecodeVar(12); // Property RequestMethod
     31 : Result:=DecodeVar(12); // Property RequestMethod
     33 : Result:=DecodeVar(7); // Property QueryString
     33 : Result:=DecodeVar(7); // Property QueryString
+    36 : Result:=DecodeVar(36); // Property XRequestedWith
   else
   else
     Result:=Inherited GetFieldValue(Index);
     Result:=Inherited GetFieldValue(Index);
   end;
   end;

+ 4 - 2
packages/fcl-web/src/custfcgi.pp

@@ -227,14 +227,16 @@ const HttpToCGI : THttpToCGI =
      12,  // 31 'REQUEST_METHOD'
      12,  // 31 'REQUEST_METHOD'
       0,  // 32
       0,  // 32
       7,  // 33 'QUERY_STRING'
       7,  // 33 'QUERY_STRING'
-     27   // 34 'HTTP_HOST'
+     27,  // 34 'HTTP_HOST'
+      0,  // 35 'CONTENT'
+     36   // 36 'XHTTPREQUESTEDWITH'
     );
     );
 
 
 var ACgiVarNr : Integer;
 var ACgiVarNr : Integer;
 
 
 begin
 begin
   Result := '';
   Result := '';
-  if assigned(FCGIParams) and (index < high(HttpToCGI)) and (index > 0) then
+  if assigned(FCGIParams) and (index < high(HttpToCGI)) and (index > 0) and (index<>35) then
     begin
     begin
     ACgiVarNr:=HttpToCGI[Index];
     ACgiVarNr:=HttpToCGI[Index];
     if ACgiVarNr>0 then
     if ACgiVarNr>0 then

+ 15 - 4
packages/fcl-web/src/custweb.pp

@@ -24,7 +24,7 @@ uses
   CustApp,Classes,SysUtils, httpdefs, fphttp;
   CustApp,Classes,SysUtils, httpdefs, fphttp;
 
 
 Const
 Const
-  CGIVarCount = 34;
+  CGIVarCount = 36;
 
 
 Type
 Type
   TCGIVarArray = Array[1..CGIVarCount] of String;
   TCGIVarArray = Array[1..CGIVarCount] of String;
@@ -65,7 +65,9 @@ Const
     { 31 } 'SERVER_ADMIN',
     { 31 } 'SERVER_ADMIN',
     { 32 } 'SCRIPT_FILENAME',
     { 32 } 'SCRIPT_FILENAME',
     { 33 } 'REMOTE_PORT',
     { 33 } 'REMOTE_PORT',
-    { 34 } 'REQUEST_URI'
+    { 34 } 'REQUEST_URI',
+    { 35 } 'CONTENT',
+    { 36 } 'HTTP_X_REQUESTED_WITH'
     );
     );
 
 
 Type
 Type
@@ -250,7 +252,16 @@ begin
     M:=FindModule(MC); // Check if a module exists already
     M:=FindModule(MC); // Check if a module exists already
     If (M=Nil) then
     If (M=Nil) then
       M:=MC.Create(Self);
       M:=MC.Create(Self);
-    M.HandleRequest(ARequest,AResponse);
+    if M.Kind=wkOneShot then
+      begin
+      try
+        M.HandleRequest(ARequest,AResponse);
+      finally
+        M.Free;
+      end;
+      end
+    else
+      M.HandleRequest(ARequest,AResponse);
   except
   except
     On E : Exception do
     On E : Exception do
       begin
       begin
@@ -294,7 +305,7 @@ Var
   I : Integer;
   I : Integer;
 begin
 begin
   I:=ComponentCount-1;
   I:=ComponentCount-1;
-  While (I>=0) and (Not (Components[i] is ModuleClass)) do
+  While (I>=0) and (Not ((Components[i] is ModuleClass) and (TCustomHTTPModule(Components[i]).Kind<>wkOneShot))) do
     Dec(i);
     Dec(i);
   if (I>=0) then
   if (I>=0) then
     Result:=Components[i] as TCustomHTTPModule
     Result:=Components[i] as TCustomHTTPModule

+ 7 - 0
packages/fcl-web/src/fphttp.pp

@@ -20,6 +20,8 @@ Interface
 uses sysutils,classes,httpdefs;
 uses sysutils,classes,httpdefs;
 
 
 Type
 Type
+{ TODO : Implement wkSession }
+  TWebModuleKind = (wkPooled, wkOneShot{, wkSession});
 
 
   { THTTPContentProducer }
   { THTTPContentProducer }
   TWebActionEvent = Procedure (Sender : TObject;
   TWebActionEvent = Procedure (Sender : TObject;
@@ -96,9 +98,14 @@ Type
     Property DefActionWhenUnknown : Boolean read FDefActionWhenUnknown write FDefActionWhenUnknown;
     Property DefActionWhenUnknown : Boolean read FDefActionWhenUnknown write FDefActionWhenUnknown;
   end;
   end;
   
   
+  { TCustomHTTPModule }
+
   TCustomHTTPModule = Class(TDataModule)
   TCustomHTTPModule = Class(TDataModule)
+  private
+    FWebModuleKind: TWebModuleKind;
   public
   public
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract;
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract;
+    property Kind: TWebModuleKind read FWebModuleKind write FWebModuleKind default wkPooled;
   end;
   end;
   
   
   TCustomHTTPModuleClass = Class of TCustomHTTPModule;
   TCustomHTTPModuleClass = Class of TCustomHTTPModule;

+ 7 - 3
packages/fcl-web/src/fpweb.pp

@@ -150,6 +150,7 @@ Type
     Property DefActionWhenUnknown;
     Property DefActionWhenUnknown;
     Property CreateSession;
     Property CreateSession;
     Property Session;
     Property Session;
+    property Kind;
     Property OnNewSession;
     Property OnNewSession;
     Property OnSessionExpired;
     Property OnSessionExpired;
   end;
   end;
@@ -464,14 +465,17 @@ begin
   UpdateSession(AResponse);
   UpdateSession(AResponse);
   FRequest := Nil;
   FRequest := Nil;
   FResponse := Nil;
   FResponse := Nil;
+  // Clean up session for the case the webmodule is used again
+  if assigned(Session) then
+    begin
+    Session.Free;
+    Session := nil;
+    end;
 {$ifdef cgidebug}
 {$ifdef cgidebug}
   SendMethodExit('WebModule('+Name+').handlerequest');
   SendMethodExit('WebModule('+Name+').handlerequest');
 {$endif cgidebug}
 {$endif cgidebug}
 end;
 end;
 
 
-
-
-
 { TTemplateVar }
 { TTemplateVar }
 
 
 procedure TTemplateVar.Assign(Source: TPersistent);
 procedure TTemplateVar.Assign(Source: TPersistent);

+ 2 - 2
packages/fcl-web/src/websession.pp

@@ -342,8 +342,8 @@ procedure TSessionHTTPModule.CheckSession(ARequest : TRequest);
 
 
 begin
 begin
 {$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').CheckSession');{$endif}
 {$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').CheckSession');{$endif}
-  If CreateSession and Assigned(FSession) then
-    FSession.InitSession(ARequest,FOnNewSession,FOnSessionExpired);
+  If CreateSession and Assigned(Session) then
+    Session.InitSession(ARequest,FOnNewSession,FOnSessionExpired);
 {$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').CheckSession');{$endif}
 {$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').CheckSession');{$endif}
 end;
 end;