* Cleaner interface to set request content. Allow not reading content.

git-svn-id: trunk@26562 -

packages/fcl-web/src/base/custcgi.pp

@@ -311,7 +311,10 @@ var
   B : Byte;
   retrycount: integer;
   BytesRead, a: longint;
+  S : String;
+
 begin
+  S:='';
   Cl := ContentLength;
   I:=TIOStream.Create(iosInput);
   Try
@@ -319,19 +322,19 @@ begin
       begin
       // It can be that the complete content is not yet send by the server so repeat the read
       // until all data is really read
-      SetLength(FContent,Cl);
+      SetLength(S,Cl);
       BytesRead:=0;
       repeat
-      a := I.Read(FContent[BytesRead+1],Cl-BytesRead);
+      a := I.Read(S[BytesRead+1],Cl-BytesRead);
       BytesRead:=BytesRead+a;
       if a=0 then // In fact this can not happen, but the content could be delayed...
         begin
         sleep(10);
-        a := I.Read(FContent[BytesRead+1],Cl-BytesRead);
+        a := I.Read(S[BytesRead+1],Cl-BytesRead);
         if a=0 then for retrycount := 0 to 149 do // timeout of about 15 seconds
           begin
           sleep(100);
-          a := I.Read(FContent[BytesRead+1],Cl-BytesRead);
+          a := I.Read(S[BytesRead+1],Cl-BytesRead);
           if a<>0 then break;
           end;
         BytesRead:=BytesRead+a;
@@ -339,19 +342,18 @@ begin
       until (BytesRead>=Cl) or (a=0);
       // In fact the request is incomplete, but this is not the place thrown an error for that
       if BytesRead<Cl then
-        SetLength(FContent,BytesRead);
+        SetLength(S,BytesRead);
       end
     else
       begin
-      FContent:='';
       B:=0;
       While (I.Read(B,1)>0) do
-        FContent:=FContent + chr(B);
+        S:=S + chr(B);
       end;
+    InitContent(S);
   Finally
     I.Free;
   end;
-  FContentRead:=True;
 end;
 
 Function TCGIRequest.GetFieldValue(Index : Integer) : String;

packages/fcl-web/src/base/custfcgi.pp

@@ -61,6 +61,7 @@ Type
     FCGIParams : TSTrings;
     FUR: TUnknownRecordEvent;
     FLog : TLogEvent;
+    FSTDin : String;
     procedure GetNameValuePairsFromContentRecord(const ARecord : PFCGI_ContentRecord; NameValueList : TStrings);
   Protected
     Procedure Log(EventType : TEventType; Const Msg : String);
@@ -280,11 +281,11 @@ begin
                           end
                         else
                           begin
-                          cl := length(FContent);
+                          cl := length(FSTDin);
                           rcl := BetoN(PFCGI_ContentRecord(AFCGIRecord)^.header.contentLength);
-                          SetLength(FContent, rcl+cl);
-                          move(PFCGI_ContentRecord(AFCGIRecord)^.ContentData[0],FContent[cl+1],rcl);
-                          FContentRead:=True;
+                          SetLength(FSTDin, rcl+cl);
+                          move(PFCGI_ContentRecord(AFCGIRecord)^.ContentData[0],FSTDin[cl+1],rcl);
+                          InitContent(FSTDin);
                           end;
                         end;
   else

packages/fcl-web/src/base/fpapache.pp

@@ -516,6 +516,7 @@ procedure TApacheRequest.ReadContent;
 Var
   Left,Len,Count,Bytes : Integer;
   P : Pchar;
+  S : String;
   
 begin
   ap_setup_client_block(FRequest,REQUEST_CHUNKED_DECHUNK);
@@ -524,8 +525,8 @@ begin
     Len:=ContentLength;
     If (Len>0) then
       begin
-      SetLength(FContent,Len);
-      P:=PChar(FContent);
+      SetLength(S,Len);
+      P:=PChar(S);
       Left:=Len;
       Count:=0;
       Repeat
@@ -534,10 +535,10 @@ begin
         Inc(P,Bytes);
         Inc(Count,Bytes);
       Until (Count>=Len) or (Bytes=0);
-      SetLength(FContent,Count);
+      SetLength(S,Count);
       end;
     end;
-  FContentRead:=True;
+  InitContent(S);
 end;
 
 procedure TApacheRequest.InitFromRequest;

packages/fcl-web/src/base/fpapache24.pp

@@ -524,7 +524,8 @@ procedure TApacheRequest.ReadContent;
 Var
   Left,Len,Count,Bytes : Integer;
   P : Pchar;
-  
+  S : String;
+    
 begin
   ap_setup_client_block(FRequest,REQUEST_CHUNKED_DECHUNK);
   If (ap_should_client_block(FRequest)=1) then
@@ -532,8 +533,8 @@ begin
     Len:=ContentLength;
     If (Len>0) then
       begin
-      SetLength(FContent,Len);
-      P:=PChar(FContent);
+      SetLength(S,Len);
+      P:=PChar(S);
       Left:=Len;
       Count:=0;
       Repeat
@@ -542,10 +543,10 @@ begin
         Inc(P,Bytes);
         Inc(Count,Bytes);
       Until (Count>=Len) or (Bytes=0);
-      SetLength(FContent,Count);
+      SetLength(S,Count);
       end;
     end;
-  FContentRead:=True;
+  InitContent(S);  
 end;
 
 procedure TApacheRequest.InitFromRequest;

packages/fcl-web/src/base/fphttpserver.pp

@@ -43,7 +43,6 @@ Type
     function GetFieldValue(Index: Integer): String; override;
     procedure SetFieldValue(Index: Integer; Value: String);override;
     Procedure InitRequestVars; override;
-    procedure SetContent(AValue : String);
   published
     Property Connection : TFPHTTPConnection Read FConnection;
   end;
@@ -292,13 +291,6 @@ begin
   end;
 end;
 
-procedure TFPHTTPConnectionRequest.SetContent(AValue : String);
-
-begin
-  FContent:=Avalue;
-  FContentRead:=true;
-end;
-
 
 Procedure TFPHTTPConnectionRequest.SetFieldValue(Index : Integer; Value : String);
 
@@ -519,8 +511,7 @@ begin
         end;
       end;  
     end;
-  ARequest.SetContent(S);
-
+  ARequest.InitContent(S);
 end;
 
 function TFPHTTPConnection.ReadRequestHeaders: TFPHTTPConnectionRequest;

packages/fcl-web/src/base/httpdefs.pp

@@ -335,11 +335,12 @@ type
     FReturnedPathInfo : String;
     FLocalPathPrefix : string;
     FServerPort : String;
+    FContentRead : Boolean;
+    FContent : String;
     function GetLocalPathPrefix: string;
     function GetFirstHeaderLine: String;
   Protected
-    FContentRead : Boolean;
-    FContent : String;
+    Function AllowReadContent : Boolean; virtual;
     Function CreateUploadedFiles : TUploadedFiles; virtual;
     Function CreateMimeItems : TMimeItems; virtual;
     procedure HandleUnknownEncoding(Const AContentType : String;Stream : TStream); virtual;
@@ -357,6 +358,8 @@ type
     Procedure InitRequestVars; virtual;
     Procedure InitPostVars; virtual;
     Procedure InitGetVars; virtual;
+    Procedure InitContent(Var AContent : String);
+    Property ContentRead : Boolean Read FContentRead Write FContentRead;
   public
     constructor Create; override;
     destructor destroy; override;
@@ -1182,7 +1185,7 @@ end;
   TRequest
   -------------------------------------------------------------------}
   
-constructor TRequest.create;
+constructor TRequest.Create;
 begin
   inherited create;
   FHandleGetOnPost:=True;
@@ -1191,7 +1194,7 @@ begin
   FLocalPathPrefix:='-';
 end;
 
-Function  TRequest.CreateUploadedFiles : TUploadedFiles;
+function TRequest.CreateUploadedFiles: TUploadedFiles;
 
 Var
   CC : TUploadedFilesClass;
@@ -1298,15 +1301,18 @@ begin
   result := FLocalPathPrefix;
 end;
 
-function TRequest.GetFieldValue(AIndex: integer): String;
+function TRequest.GetFieldValue(AIndex: Integer): String;
 begin
   Case AIndex of
     25 : Result:=FPathInfo;
     31 : Result:=FCommand;
     32 : Result:=FURI;
     35 : begin
-         If Not FContentRead then
+         If Not FContentRead and AllowReadContent then
+           begin
            ReadContent;
+           FContentRead:=True; // in case InitContent was not called.
+           end;
          Result:=FContent;
          end
   else
@@ -1333,7 +1339,13 @@ begin
     Result := Result + ' HTTP/' + HttpVersion;
 end;
 
-procedure TRequest.HandleUnknownEncoding(Const AContentType : String;Stream : TStream);
+function TRequest.AllowReadContent: Boolean;
+begin
+  Result:=True;
+end;
+
+procedure TRequest.HandleUnknownEncoding(const AContentType: String;
+  Stream: TStream);
 begin
   If Assigned(FOnUnknownEncoding) then
     FOnUnknownEncoding(Self,AContentType,Stream);
@@ -1344,7 +1356,7 @@ begin
   // Implement in descendents
 end;
 
-Procedure TRequest.ProcessQueryString(Const FQueryString : String; SL:TStrings);
+procedure TRequest.ProcessQueryString(const FQueryString: String; SL: TStrings);
 
 
 var
@@ -1453,13 +1465,14 @@ begin
 {$ifdef CGIDEBUG}SendMethodExit('ProcessQueryString');{$endif CGIDEBUG}
 end;
 
-Function TRequest.RequestUploadDir : String;
+function TRequest.RequestUploadDir: String;
 
 begin
   Result:='';
 end;
 
-Function TRequest.GetTempUploadFileName(Const AName, AFileName : String; ASize : Int64): String;
+function TRequest.GetTempUploadFileName(const AName, AFileName: String;
+  ASize: Int64): String;
 
 Var
   D : String;
@@ -1471,7 +1484,7 @@ begin
   Result:=GetTempFileName(D, 'CGI');
 end;
 
-Procedure TRequest.DeleteTempUploadedFiles;
+procedure TRequest.DeleteTempUploadedFiles;
 begin
   FFiles.DeleteTempUploadedFiles;
 end;
@@ -1559,8 +1572,15 @@ begin
 {$endif}
 end;
 
+procedure TRequest.InitContent(var AContent: String);
+begin
+  FContent:=AContent;
+  FContentRead:=True;
+end;
+
 
-Procedure TRequest.ProcessMultiPart(Stream : TStream; Const Boundary : String; SL:TStrings);
+procedure TRequest.ProcessMultiPart(Stream: TStream; const Boundary: String;
+  SL: TStrings);
 
 Var
   L : TMimeItems;
@@ -1602,7 +1622,7 @@ begin
 {$ifdef CGIDEBUG}  SendMethodExit('ProcessMultiPart');{$endif CGIDEBUG}
 end;
 
-Procedure TRequest.ProcessURLEncoded(Stream: TStream; SL:TStrings);
+procedure TRequest.ProcessURLEncoded(Stream: TStream; SL: TStrings);
 
 var
   S : String;