--- Merging r20217 into '.':

U    packages/fcl-web/src/base/custfcgi.pp
--- Merging r20300 into '.':
U    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r20494 into '.':
U    packages/fcl-web/src/base/fpweb.pp
U    packages/fcl-web/src/base/fphttp.pp
U    packages/fcl-web/src/base/custweb.pp
--- Merging r20495 into '.':
G    packages/fcl-web/src/base/custweb.pp

# revisions: 20217,20300,20494,20495
------------------------------------------------------------------------
r20217 | michael | 2012-02-02 20:19:21 +0100 (Thu, 02 Feb 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Fix for bug #0021210 (patch by Dmitry Ukolov
------------------------------------------------------------------------
------------------------------------------------------------------------
r20300 | michael | 2012-02-10 09:13:50 +0100 (Fri, 10 Feb 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Patch from Mattias Gaertner to handle Chunked transfer encoding
------------------------------------------------------------------------
------------------------------------------------------------------------
r20494 | michael | 2012-03-10 15:19:00 +0100 (Sat, 10 Mar 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp
   M /trunk/packages/fcl-web/src/base/fphttp.pp
   M /trunk/packages/fcl-web/src/base/fpweb.pp

* (Modified) Patch from Sven Barth to add AfterInitModule
------------------------------------------------------------------------
------------------------------------------------------------------------
r20495 | michael | 2012-03-10 15:58:14 +0100 (Sat, 10 Mar 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Added PreferModuleName
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@21019 -

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

@@ -350,7 +350,7 @@ const HttpToCGI : THttpToCGI =
      18,  //  1 'HTTP_ACCEPT'           - fieldAccept
      19,  //  2 'HTTP_ACCEPT_CHARSET'   - fieldAcceptCharset
      20,  //  3 'HTTP_ACCEPT_ENCODING'  - fieldAcceptEncoding
-      0,  //  4
+     26,  //  4 'HTTP_ACCEPT_LANGUAGE'  - fieldAcceptLanguage
       0,  //  5
       0,  //  6
       0,  //  7

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

@@ -78,12 +78,14 @@ Type
                                Var ModuleClass : TCustomHTTPModuleClass) of object;
   TOnShowRequestException = procedure(AResponse: TResponse; AnException: Exception; var handled: boolean);
   TLogEvent = Procedure (EventType: TEventType; const Msg: String) of object;
+  TInitModuleEvent = Procedure (Sender : TObject; Module: TCustomHTTPModule) of object;
 
   { TWebHandler }
 
   TWebHandler = class(TComponent)
   private
     FOnIdle: TNotifyEvent;
+    FOnInitModule: TInitModuleEvent;
     FOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
     FTerminated: boolean;
     FAdministrator: String;
@@ -99,6 +101,7 @@ Type
     FTitle: string;
     FOnTerminate : TNotifyEvent;
     FOnLog : TLogEvent;
+    FPreferModuleName : Boolean;
   protected
     procedure Terminate;
     Function GetModuleName(Arequest : TRequest) : string;
@@ -133,6 +136,8 @@ Type
     property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
     Property OnLog : TLogEvent Read FOnLog Write FOnLog;
     Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read FOnUnknownRequestEncoding Write FOnUnknownRequestEncoding;
+    Property OnInitModule: TInitModuleEvent Read FOnInitModule write FOnInitModule;
+    Property PreferModuleName : Boolean Read FPreferModuleName Write FPreferModuleName;
   end;
 
   TCustomWebApplication = Class(TCustomApplication)
@@ -151,6 +156,7 @@ Type
     function GetOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
     function GetRedirectOnError: boolean;
     function GetRedirectOnErrorURL: string;
+    function GetPreferModuleName: boolean;
     procedure SetAdministrator(const AValue: String);
     procedure SetAllowDefaultModule(const AValue: Boolean);
     procedure SetApplicationURL(const AValue: String);
@@ -162,6 +168,7 @@ Type
     procedure SetOnUnknownRequestEncoding(AValue: TOnUnknownEncodingEvent);
     procedure SetRedirectOnError(const AValue: boolean);
     procedure SetRedirectOnErrorURL(const AValue: string);
+    procedure SetPreferModuleName(const AValue: boolean);
     procedure DoOnTerminate(Sender : TObject);
   protected
     Procedure DoRun; override;
@@ -187,6 +194,7 @@ Type
     property OnShowRequestException: TOnShowRequestException read GetOnShowRequestException write SetOnShowRequestException;
     Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read GetOnUnknownRequestEncoding Write SetOnUnknownRequestEncoding;
     Property EventLog: TEventLog read GetEventLog;
+    Property PreferModuleName : Boolean Read GetPreferModuleName Write SetPreferModuleName;
   end;
 
   EFPWebError = Class(Exception);
@@ -343,6 +351,9 @@ begin
       else
         M:=MC.Create(Self);
     SetBaseURL(M,MN,ARequest);
+    if (OnInitModule<>Nil) then
+      OnInitModule(Self,M);
+    M.DoAfterInitModule(ARequest);
     if M.Kind=wkOneShot then
       begin
       try
@@ -398,7 +409,7 @@ begin
     If (I>0) and (S[I]='/') then
       Delete(S,I,1);                      //Delete the trailing '/' if exists
     I:=Pos('/',S);
-    if (I>0) then
+    if (I>0) or PreferModuleName then
       Result:=ARequest.GetNextPathInfo;
     end;
   If (Result='') then
@@ -531,6 +542,11 @@ begin
   result := FWebHandler.RedirectOnError;
 end;
 
+function TCustomWebApplication.GetPreferModuleName: boolean;
+begin
+  result := FWebHandler.PreferModuleName;
+end;
+
 function TCustomWebApplication.GetRedirectOnErrorURL: string;
 begin
   result := FWebHandler.RedirectOnErrorURL;
@@ -587,6 +603,11 @@ begin
   FWebHandler.RedirectOnError := AValue;
 end;
 
+procedure TCustomWebApplication.SetPreferModuleName(const AValue: boolean);
+begin
+  FWebHandler.PreferModuleName := AValue;
+end;
+
 procedure TCustomWebApplication.SetRedirectOnErrorURL(const AValue: string);
 begin
   FWebHandler.RedirectOnErrorURL :=AValue;

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

@@ -104,14 +104,18 @@ Type
   
   { TCustomHTTPModule }
 
+  TInitModuleEvent = Procedure (Sender : TObject; ARequest : TRequest) of object;
   TCustomHTTPModule = Class(TDataModule)
   private
+    FAfterInitModule : TInitModuleEvent;
     FBaseURL: String;
     FWebModuleKind: TWebModuleKind;
   public
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract;
+    Procedure DoAfterInitModule(ARequest : TRequest); virtual;
     property Kind: TWebModuleKind read FWebModuleKind write FWebModuleKind default wkPooled;
     Property BaseURL : String Read FBaseURL Write FBaseURL;
+    Property AfterInitModule : TInitModuleEvent Read FAfterInitModule Write FAfterInitModule;
   end;
   TCustomHTTPModuleClass = Class of TCustomHTTPModule;
 
@@ -244,6 +248,14 @@ begin
   Result:=GSM;
 end;
 
+{ TCustomHTTPModule }
+
+procedure TCustomHTTPModule.DoAfterInitModule(ARequest: TRequest);
+begin
+  If Assigned(FAfterInitModule) then
+    FAfterInitModule(Self, ARequest);
+end;
+
 { TSessionFactory }
 
 function TSessionFactory.CreateSession(ARequest: TRequest): TCustomSession;

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

@@ -45,6 +45,7 @@ Type
     FSocket : TInetSocket;
     FBuffer : Ansistring;
     function CheckContentLength: Integer;
+    function CheckTransferEncoding: string;
     function GetCookies: TStrings;
     procedure SetCookies(const AValue: TStrings);
     procedure SetRequestHeaders(const AValue: TStrings);
@@ -153,6 +154,8 @@ resourcestring
   SErrInvalidProtocolVersion = 'Invalid protocol version in response: "%s"';
   SErrInvalidStatusCode = 'Invalid response status code: %s';
   SErrUnexpectedResponse = 'Unexpected response status code: %d';
+  SErrChunkTooBig = 'Chunk too big';
+  SErrChunkLineEndMissing = 'Chunk line end missing';
 
 Const
   CRLF = #13#10;
@@ -257,9 +260,7 @@ end;
 procedure TFPCustomHTTPClient.AddHeader(const AHeader, AValue: String);
 
 Var
-  I,J,L : Integer;
-  H : String;
-
+  J: Integer;
 begin
   j:=IndexOfHeader(Aheader);
   if (J<>-1) then
@@ -540,6 +541,30 @@ begin
     end;
 end;
 
+Function TFPCustomHTTPClient.CheckTransferEncoding: string;
+
+Const CL ='transfer-encoding:';
+
+Var
+  S : String;
+  I : integer;
+
+begin
+  Result:='';
+  I:=0;
+  While (I<FResponseHeaders.Count) do
+    begin
+    S:=Trim(LowerCase(FResponseHeaders[i]));
+    If (Copy(S,1,Length(Cl))=Cl) then
+      begin
+      Delete(S,1,Length(CL));
+      Result:=Trim(S);
+      exit;
+      end;
+    Inc(I);
+    end;
+end;
+
 function TFPCustomHTTPClient.GetCookies: TStrings;
 begin
   If (FCookies=Nil) then
@@ -565,39 +590,145 @@ procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedRespons
       Stream.Write(FBuffer[1],Result);
   end;
 
+  Procedure ReadChunkedResponse;
+  { HTTP 1.1 chunked response:
+    There is no content-length. The response consists of several chunks of
+    data, each
+    - beginning with a line
+      - starting with a hex number DataSize,
+      - an optional parameter,
+      - ending with #13#10,
+    - followed by the data,
+    - ending with #13#10 (not in DataSize),
+    It ends when the DataSize is 0.
+    After the last chunk there can be a some optional entity header fields.
+    This trailer is not yet implemented. }
+  var
+    BufPos: Integer;
+
+    function FetchData(out Cnt: integer): boolean;
+
+    begin
+      SetLength(FBuffer,ReadBuflen);
+      Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
+      If Cnt<0 then
+        Raise EHTTPClient.Create(SErrReadingSocket);
+      SetLength(FBuffer,Cnt);
+      BufPos:=1;
+      Result:=Cnt>0;
+    end;
+
+    Function ReadData(Data: PByte; Cnt: integer): integer;
+
+    var
+      l: Integer;
+    begin
+      Result:=0;
+      while Cnt>0 do
+        begin
+        l:=length(FBuffer)-BufPos+1;
+        if l=0 then
+          if not FetchData(l) then
+            exit; // end of stream
+        if l>Cnt then
+          l:=Cnt;
+        System.Move(FBuffer[BufPos],Data^,l);
+        inc(BufPos,l);
+        inc(Data,l);
+        inc(Result,l);
+        dec(Cnt,l);
+      end;
+    end;
+
+  var
+    c: char;
+    ChunkSize: Integer;
+    l: Integer;
+  begin
+    BufPos:=1;
+    repeat
+      // read ChunkSize
+      ChunkSize:=0;
+      repeat
+        if ReadData(@c,1)<1 then exit;
+        case c of
+        '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
+        'a'..'f': ChunkSize:=ChunkSize*16+ord(c)-ord('a')+10;
+        'A'..'F': ChunkSize:=ChunkSize*16+ord(c)-ord('A')+10;
+        else break;
+        end;
+        if ChunkSize>1000000 then
+          Raise EHTTPClient.Create(SErrChunkTooBig);
+      until false;
+      // read till line end
+      while (c<>#10) do
+        if ReadData(@c,1)<1 then exit;
+      if ChunkSize=0 then exit;
+      // read data
+      repeat
+        l:=length(FBuffer)-BufPos+1;
+        if l=0 then
+          if not FetchData(l) then
+            exit; // end of stream
+        if l>ChunkSize then
+          l:=ChunkSize;
+        if l>0 then
+          begin
+          // copy chunk data to output
+          Stream.Write(FBuffer[BufPos],l);
+          inc(BufPos,l);
+          dec(ChunkSize,l);
+          end;
+      until ChunkSize=0;
+      // read #13#10
+      if ReadData(@c,1)<1 then exit;
+      if c<>#13 then
+        Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+      if ReadData(@c,1)<1 then exit;
+      if c<>#10 then
+        Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+      // next chunk
+    until false;
+  end;
+
 Var
   L,LB,R : Integer;
-  ResponseOK : Boolean;
-
 begin
   SetLength(FBuffer,0);
   FResponseStatusCode:=ReadResponseHeaders;
   if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
     Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
-  // Write remains of buffer to output.
-  LB:=Length(FBuffer);
-  If (LB>0) then
-    Stream.WriteBuffer(FBuffer[1],LB);
-  // Now read the rest, if any.
-  SetLength(FBuffer,ReadBuflen);
-  L:=CheckContentLength;
-  If (L>LB) then
+  if CompareText(CheckTransferEncoding,'chunked')=0 then
+    ReadChunkedResponse
+  else
     begin
-    // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
-    L:=L-LB;
-    Repeat
-      LB:=ReadBufLen;
-      If (LB>L) then
-        LB:=L;
-      R:=Transfer(LB);
-      L:=L-R;
-    until (L=0) or (R=0);
-    end
-  else if L<0 then
-    // No content-length, so we read till no more data available.
-    Repeat
-      R:=Transfer(ReadBufLen);
-    until (R=0);
+    // Write remains of buffer to output.
+    LB:=Length(FBuffer);
+    If (LB>0) then
+      Stream.WriteBuffer(FBuffer[1],LB);
+    // Now read the rest, if any.
+    SetLength(FBuffer,ReadBuflen);
+    L:=CheckContentLength;
+    If (L>LB) then
+      begin
+      // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
+      L:=L-LB;
+      Repeat
+        LB:=ReadBufLen;
+        If (LB>L) then
+          LB:=L;
+        R:=Transfer(LB);
+        L:=L-R;
+      until (L=0) or (R=0);
+      end
+    else if L<0 then
+      begin
+      // No content-length, so we read till no more data available.
+      Repeat
+        R:=Transfer(ReadBufLen);
+      until (R=0);
+      end;
+    end;
 end;
 
 procedure TFPCustomHTTPClient.DoMethod(Const AMethod,AURL: String; Stream: TStream; Const AllowedResponseCodes : Array of Integer);
@@ -720,9 +851,6 @@ end;
 procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
   const Response: TStream);
 
-Var
-  S : TStringStream;
-
 begin
   RequestBody:=TStringStream.Create(FormData);
   try
@@ -798,8 +926,6 @@ Var
   S, Sep : string;
   SS : TStringStream;
   F : TFileStream;
-  DS : TBase64EncodingStream;
-
 begin
   Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]);
   AddHeader('Content-type','multipart/form-data; boundary='+Sep);

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

@@ -150,6 +150,7 @@ Type
     property Kind;
     Property OnNewSession;
     Property OnSessionExpired;
+    Property AfterInitModule;
   end;
 
   EFPWebError = Class(HTTPError);