* Moved TCustomCGIApplication.InitPostVars, InitGetVars and InitRequestVars to

   TRequest, so that they are used for CGI-applications and Apache-modules
 * Use TRequest.ReadContent in cgi and apache modules to load the request-
   content

git-svn-id: trunk@12875 -

packages/fcl-web/src/custcgi.pp

@@ -80,8 +80,7 @@ Type
   Protected
     Function GetFieldValue(Index : Integer) : String; override;
     Procedure InitFromEnvironment;
-    Procedure InitPostVars;
-    Procedure InitGetVars;
+    procedure ReadContent; override;
   Public
     Constructor CreateCGI(ACGI : TCustomCGIApplication);
     Property GatewayInterface : String Index 1 Read GetCGIVar;
@@ -118,7 +117,6 @@ Type
     FHandleGetOnPost : Boolean;
     FRedirectOnError : Boolean;
     FRedirectOnErrorURL : String;
-    Procedure InitRequestVars;
     Function GetEmail : String;
     Function GetAdministrator : String;
     Function GetRequestVariable(Const VarName : String) : String;
@@ -157,9 +155,6 @@ ResourceString
   SError     = 'Error: ';
   SNotify    = 'Notify: ';
   SErrNoContentLength = 'No content length passed from server!';
-  SErrUnsupportedContentType = 'Unsupported content type: "%s"';
-  SErrNoRequestMethod = 'No REQUEST_METHOD passed from server.';
-  SErrInvalidRequestMethod = 'Invalid REQUEST_METHOD passed from server.';
 
 Implementation
 
@@ -270,7 +265,8 @@ begin
   StopOnException:=True;
   Inherited;
   FRequest:=TCGIRequest.CreateCGI(Self);
-  InitRequestVars;
+  FRequest.InitFromEnvironment;
+  FRequest.InitRequestVars;
   FOutput:=TIOStream.Create(iosOutput);
   FResponse:=TCGIResponse.CreateCGI(Self,Self.FOutput);
 end;
@@ -365,121 +361,12 @@ begin
     Result:=SWebMaster;
 end;
 
-Procedure TCustomCGIApplication.InitRequestVars;
-
-var
-  R : String;
-
-begin
-  R:=GetEnvironmentVariable('REQUEST_METHOD');
-  if (R='') then
-    Raise Exception.Create(SErrNoRequestMethod);
-  FRequest.InitFromEnvironment;
-  if CompareText(R,'POST')=0 then
-    begin
-    Request.InitPostVars;
-    if FHandleGetOnPost then
-      Request.InitGetVars;
-    end
-  else if CompareText(R,'GET')=0 then
-    Request.InitGetVars
-  else
-    Raise Exception.CreateFmt(SErrInvalidRequestMethod,[R]);
-end;
-
-
 constructor TCGIRequest.CreateCGI(ACGI: TCustomCGIApplication);
 begin
   Inherited Create;
   FCGI:=ACGI;
 end;
 
-
-Type
-  TCapacityStream = Class(TMemoryStream)
-  Public
-    Property Capacity;
-  end;
-
-Procedure TCGIRequest.InitPostVars;
-
-Var
-  M  : TCapacityStream;
-  I  : TIOStream;
-  Cl : Integer;
-  B  : Byte;
-  CT : String;
-
-begin
-{$ifdef CGIDEBUG}
-  SendMethodEnter('InitPostVars');
-{$endif}
-  CL:=ContentLength;
-  M:=TCapacityStream.Create;
-  Try
-    I:=TIOStream.Create(iosInput);
-    Try
-      if (CL<>0) then
-        begin
-        M.Capacity:=Cl;
-        M.CopyFrom(I,Cl);
-        end
-      else
-        begin
-        While (I.Read(B,1)>0) do
-          M.Write(B,1)
-        end;
-    Finally
-      I.Free;
-    end;
-    M.Position:=0;
-// joost, aug 20th: I've removed this. It doesn't work with windows and I think
-// it's a debug-only thing...
-{    With TFileStream.Create('/tmp/query',fmCreate) do
-      try
-        CopyFrom(M,0);
-        M.Position:=0;
-      Finally
-        Free;
-      end;}
-    CT:=ContentType;
-    if Pos('MULTIPART/FORM-DATA',Uppercase(CT))<>0 then
-      ProcessMultiPart(M,CT, ContentFields)
-    else if CompareText('APPLICATION/X-WWW-FORM-URLENCODED',CT)=0 then
-      ProcessUrlEncoded(M, ContentFields)
-    else
-      begin
-{$ifdef CGIDEBUG}
-      SendDebug('InitPostVars: unsupported content type:'+CT);
-{$endif}
-      Raise Exception.CreateFmt(SErrUnsupportedContentType,[CT]);
-      end;
-  finally
-    M.Free;
-  end;
-{$ifdef CGIDEBUG}
-  SendMethodExit('InitPostVars');
-{$endif}
-end;
-
-Procedure TCGIRequest.InitGetVars;
-
-Var
-  FQueryString : String;
-
-begin
-{$ifdef CGIDEBUG}
-  SendMethodEnter('InitGetVars');
-{$endif}
-  FQueryString:=GetEnvironmentVariable('QUERY_STRING');
-  If (FQueryString<>'') then
-    ProcessQueryString(FQueryString, QueryFields);
-{$ifdef CGIDEBUG}
-  SendMethodExit('InitGetVars');
-{$endif}
-end;
-
-
 Function TCustomCGIApplication.GetRequestVariable(Const VarName : String) : String;
 
 begin
@@ -593,6 +480,31 @@ begin
     end;
 end;
 
+procedure TCGIRequest.ReadContent;
+var
+  I : TIOStream;
+  Cl : Integer;
+  B : Byte;
+begin
+  Cl := ContentLength;
+  I:=TIOStream.Create(iosInput);
+  Try
+    if (CL<>0) then
+      begin
+      SetLength(FContent,Cl);
+      I.Read(FContent[1],Cl);
+      end
+    else
+      begin
+      FContent:='';
+      While (I.Read(B,1)>0) do
+        FContent:=FContent + chr(B);
+      end;
+  Finally
+    I.Free;
+  end;
+  FContentRead:=True;
+end;
 
 Function TCGIRequest.GetFieldValue(Index : Integer) : String;
 
@@ -610,6 +522,8 @@ begin
     28 : Result:=DecodeVar(9); // Property RemoteHost
     29 : Result:=DecodeVar(13); // Property ScriptName
     30 : Result:=DecodeVar(15); // Property ServerPort
+    31 : Result:=DecodeVar(12); // Property RequestMethod
+    33 : Result:=DecodeVar(7); // Property QueryString
   else
     Result:=Inherited GetFieldValue(Index);
   end;

packages/fcl-web/src/fpapache.pp

@@ -30,12 +30,10 @@ Type
   Private
     FApache : TCustomApacheApplication;
     FRequest : PRequest_rec;
-    FContent : String;
-    FContentRead : Boolean;
-    procedure ReadContent;
   Protected
     Function GetFieldValue(Index : Integer) : String; override;
     Procedure InitFromRequest;
+    procedure ReadContent; override;
   Public
     Constructor CreateReq(App : TCustomApacheApplication; ARequest : PRequest_rec);
     Property ApacheRequest : Prequest_rec Read FRequest;
@@ -231,6 +229,7 @@ Var
 begin
   Req:=TApacheRequest.CreateReq(Self,P);
   Try
+    Req.InitRequestVars;
     Resp:=TApacheResponse.CreateApache(Req);
     Try
       HandleRequest(Req,Resp);
@@ -504,7 +503,6 @@ var
   I : Integer;
   
 begin
-
   Result:='';
   If (Index in [1..NoHTTPFields]) then
     begin
@@ -538,11 +536,6 @@ begin
       32 : Result:=StrPas(FRequest^.unparsed_uri); // URL
       33 : Result:=StrPas(FRequest^.args); // Query
       34 : Result:=StrPas(FRequest^.HostName); // Host
-      35 : begin // Content
-           If Not FContentRead then
-             ReadContent;
-           Result:=FContent;
-           end;
     else
       Result:=inherited GetFieldValue(Index);
     end;

packages/fcl-web/src/httpdefs.pp

@@ -262,16 +262,24 @@ type
   private
     FCommand: String;
     FCommandLine: String;
+    FHandleGetOnPost: Boolean;
     FURI: String;
     FFiles : TUploadedFiles;
     FReturnedPathInfo : String;
     procedure ParseFirstHeaderLine(const line: String);override;
     function GetFirstHeaderLine: String;
   Protected
+    FContentRead : Boolean;
+    FContent : String;
+    procedure ReadContent; virtual;
+    Function GetFieldValue(AIndex : Integer) : String; override;
     Procedure ProcessMultiPart(Stream : TStream; Const Boundary : String;SL:TStrings); virtual;
     Procedure ProcessQueryString(Const FQueryString : String; SL:TStrings); virtual;
     procedure ProcessURLEncoded(Stream : TStream;SL:TStrings); virtual;
     Function  GetTempUploadFileName : String; virtual;
+    Procedure InitRequestVars; virtual;
+    Procedure InitPostVars; virtual;
+    Procedure InitGetVars; virtual;
     Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo;
   public
     constructor Create; override;
@@ -283,6 +291,7 @@ type
     Property  QueryString : String Index 33 read GetFieldValue Write SetFieldValue; // Alias
     Property  HeaderLine : String read GetFirstHeaderLine;
     Property  Files : TUploadedFiles Read FFiles;
+    Property  HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
   end;
 
 
@@ -374,7 +383,10 @@ Resourcestring
   SErrInternalUploadedFileError = 'Internal uploaded file configuration error';
   SErrNoSuchUploadedFile        = 'No such uploaded file : "%s"';
   SErrUnknownCookie             = 'Unknown cookie: "%s"';
-  
+  SErrUnsupportedContentType    = 'Unsupported content type: "%s"';
+  SErrNoRequestMethod           = 'No REQUEST_METHOD passed from server.';
+  SErrInvalidRequestMethod      = 'Invalid REQUEST_METHOD passed from server.';
+
 const
    hexTable = '0123456789ABCDEF';
 
@@ -871,6 +883,7 @@ end;
 constructor TRequest.create;
 begin
   inherited create;
+  FHandleGetOnPost:=True;
   FFiles:=TUploadedFiles.Create(TUPloadedFile);
 end;
 
@@ -942,6 +955,18 @@ begin
   end;
 end;
 
+function TRequest.GetFieldValue(AIndex: integer): String;
+begin
+  if AIndex = 35 then // Content
+    begin
+    If Not FContentRead then
+      ReadContent;
+    Result:=FContent;
+    end
+  else
+    Result:=inherited GetFieldValue(AIndex);
+end;
+
 function TRequest.GetFirstHeaderLine: String;
 begin
   Result := Command + ' ' + URI;
@@ -949,6 +974,11 @@ begin
     Result := Result + ' HTTP/' + HttpVersion;
 end;
 
+procedure TRequest.ReadContent;
+begin
+  // Implement in descendents
+end;
+
 Procedure TRequest.ProcessQueryString(Const FQueryString : String; SL:TStrings);
 
 
@@ -1072,6 +1102,90 @@ environment variable TEMP . For CGI programs you need to pass global environment
   Result := GetTempFileName(GetTempDir, 'CGI');
 end;
 
+procedure TRequest.InitRequestVars;
+
+var
+  R : String;
+
+begin
+  R:=Method;
+  if (R='') then
+    Raise Exception.Create(SErrNoRequestMethod);
+  if CompareText(R,'POST')=0 then
+    begin
+    InitPostVars;
+    if FHandleGetOnPost then
+      InitGetVars;
+    end
+  else if CompareText(R,'GET')=0 then
+    InitGetVars
+  else
+    Raise Exception.CreateFmt(SErrInvalidRequestMethod,[R]);
+end;
+
+Type
+  TCapacityStream = Class(TMemoryStream)
+  Public
+    Property Capacity;
+  end;
+
+procedure TRequest.InitPostVars;
+
+Var
+  M  : TCapacityStream;
+  Cl : Integer;
+  B  : Byte;
+  CT : String;
+
+begin
+{$ifdef CGIDEBUG}
+  SendMethodEnter('InitPostVars');
+{$endif}
+  CL:=ContentLength;
+  M:=TCapacityStream.Create;
+  Try
+    if CL<>0 then
+      begin
+      M.Capacity:=Cl;
+      M.WriteBuffer(Content[1], Cl);
+      end;
+    M.Position:=0;
+    CT:=ContentType;
+    if Pos('MULTIPART/FORM-DATA',Uppercase(CT))<>0 then
+      ProcessMultiPart(M,CT, ContentFields)
+    else if CompareText('APPLICATION/X-WWW-FORM-URLENCODED',CT)=0 then
+      ProcessUrlEncoded(M, ContentFields)
+    else
+      begin
+{$ifdef CGIDEBUG}
+      SendDebug('InitPostVars: unsupported content type:'+CT);
+{$endif}
+      Raise Exception.CreateFmt(SErrUnsupportedContentType,[CT]);
+      end;
+  finally
+    M.Free;
+  end;
+{$ifdef CGIDEBUG}
+  SendMethodExit('InitPostVars');
+{$endif}
+end;
+
+procedure TRequest.InitGetVars;
+Var
+  FQueryString : String;
+
+begin
+{$ifdef CGIDEBUG}
+  SendMethodEnter('InitGetVars');
+{$endif}
+  FQueryString:=QueryString;
+  If (FQueryString<>'') then
+    ProcessQueryString(FQueryString, QueryFields);
+{$ifdef CGIDEBUG}
+  SendMethodExit('InitGetVars');
+{$endif}
+end;
+
 
 Procedure TRequest.ProcessMultiPart(Stream : TStream; Const Boundary : String; SL:TStrings);