{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.7    6/26/2004 12:11:16 AM  BGooijen
  updates for D8

  Rev 1.6    4/8/2004 4:00:40 PM  BGooijen
  Fix for D8

  Rev 1.5    07/04/2004 20:44:06  HHariri
  Updates

  Rev 1.4    07/04/2004 20:07:50  HHariri
  Updates for .NET

    Rev 1.3    10/19/2003 4:50:10 PM  DSiders
  Added localization comments.

  Rev 1.2    10/12/2003 1:49:48 PM  BGooijen
  Changed comment of last checkin

  Rev 1.1    10/12/2003 1:43:32 PM  BGooijen
  Changed IdCompilerDefines.inc to Core\IdCompilerDefines.inc

  Rev 1.0    11/13/2002 07:54:34 AM  JPMugaas
}

unit IdHTTPWebBrokerBridge;

{
Original Author: Dave Nottage.
Modified by: Grahame Grieve
Modified by: Chad Z. Hower (Kudzu)
}

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  HTTPApp,
  IdContext, IdCustomHTTPServer, IdException, IdTCPServer, IdIOHandlerSocket,
  {$IFDEF CLR}System.Text,{$ENDIF}
  WebBroker, WebReq;

type
  EWBBException = class(EIdException);
  EWBBInvalidIdxGetDateVariable = class(EWBBException);
  EWBBInvalidIdxSetDateVariable = class(EWBBException );
  EWBBInvalidIdxGetIntVariable = class(EWBBException );
  EWBBInvalidIdxSetIntVariable = class(EWBBException );
  EWBBInvalidIdxGetStrVariable = class(EWBBException);
  EWBBInvalidIdxSetStringVar = class(EWBBException);
  EWBBInvalidStringVar = class(EWBBException);

  TIdHTTPAppRequest = class(TWebRequest)
  protected
    FRequestInfo   : TIdHTTPRequestInfo;
    FResponseInfo  : TIdHTTPResponseInfo;
    FThread        : TIdContext;
    FContentStream : TStream;
    FFreeContentStream : Boolean;
    //
    function GetDateVariable(Index: Integer): TDateTime; override;
    function GetIntegerVariable(Index: Integer): Integer; override;
    function GetStringVariable(Index: Integer): AnsiString; override;
    {$IFDEF VCL_XE_OR_ABOVE}
    function GetRemoteIP: string; override;
    function GetRawPathInfo: AnsiString; override;
    {$ENDIF}
  public
    constructor Create(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
     AResponseInfo: TIdHTTPResponseInfo);
    destructor Destroy; override;
    function GetFieldByName(const Name: AnsiString): AnsiString; override;
    function ReadClient(var Buffer{$IFDEF CLR}: TBytes{$ENDIF}; Count: Integer): Integer; override;
    function ReadString(Count: Integer): AnsiString; override;
    {function ReadUnicodeString(Count: Integer): string;}
    function TranslateURI(const URI: string): string; override;
    function WriteClient(var ABuffer; ACount: Integer): Integer; override;

    {$IFDEF VCL_6_OR_ABOVE}
      {$DEFINE VCL_6_OR_ABOVE_OR_CLR}
    {$ENDIF}
    {$IFDEF CLR}
      {$DEFINE VCL_6_OR_ABOVE_OR_CLR}
    {$ENDIF}
    {$IFDEF VCL_6_OR_ABOVE_OR_CLR}
    function WriteHeaders(StatusCode: Integer; const ReasonString, Headers: AnsiString): Boolean; override;
    {$ENDIF}
    function WriteString(const AString: AnsiString): Boolean; override;
  end;

  TIdHTTPAppResponse = class(TWebResponse)
  protected
    FContent: string;
    FRequestInfo: TIdHTTPRequestInfo;
    FResponseInfo: TIdHTTPResponseInfo;
    FSent: Boolean;
    FThread: TIdContext;
    FContentType: AnsiString; // Workaround to preserve value of ContentType property
    //
    function GetContent: AnsiString; override;
    function GetDateVariable(Index: Integer): TDateTime; override;
    function GetStatusCode: Integer; override;
    function GetIntegerVariable(Index: Integer): Integer; override;
    function GetLogMessage: string; override;
    function GetStringVariable(Index: Integer): AnsiString; override;
    procedure SetContent(const AValue: AnsiString); override;
    procedure SetContentStream(AValue: TStream); override;
    procedure SetStatusCode(AValue: Integer); override;
    procedure SetStringVariable(Index: Integer; const Value: AnsiString); override;
    procedure SetDateVariable(Index: Integer; const Value: TDateTime); override;
    procedure SetIntegerVariable(Index: Integer; Value: Integer); override;
    procedure SetLogMessage(const Value: string); override;
    procedure MoveCookiesAndCustomHeaders;
  public
    constructor Create(AHTTPRequest: TWebRequest; AThread: TIdContext;
     ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure SendRedirect(const URI: AnsiString); override;
    procedure SendResponse; override;
    procedure SendStream(AStream: TStream); override;
    function Sent: Boolean; override;
  end;

  TIdHTTPWebBrokerBridge = class(TIdCustomHTTPServer)
  private
    procedure RunWebModuleClass(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
     AResponseInfo: TIdHTTPResponseInfo);
  protected
    FWebModuleClass: TComponentClass;
    //
    procedure DoCommandGet(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
     AResponseInfo: TIdHTTPResponseInfo); override;
    procedure DoCommandOther(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
     AResponseInfo: TIdHTTPResponseInfo); override;
    procedure InitComponent; override;
  public
    procedure RegisterWebModuleClass(AClass: TComponentClass);
  end;

implementation

uses
  IdResourceStringsProtocols,
  IdBuffer, IdHTTPHeaderInfo, IdGlobal, IdGlobalProtocols, IdCookie, IdStream,
  {$IFDEF STRING_IS_UNICODE}IdCharsets,{$ENDIF}
  SysUtils, Math
  {$IFDEF HAS_TNetEncoding}
  , System.NetEncoding
  {$ENDIF}
  ;

type
  // Make HandleRequest accessible
  TWebDispatcherAccess = class(TCustomWebDispatcher);

const
  INDEX_RESP_Version = 0;
  INDEX_RESP_ReasonString = 1;
  INDEX_RESP_Server = 2;
  INDEX_RESP_WWWAuthenticate = 3;
  INDEX_RESP_Realm = 4;
  INDEX_RESP_Allow = 5;
  INDEX_RESP_Location = 6;
  INDEX_RESP_ContentEncoding = 7;
  INDEX_RESP_ContentType = 8;
  INDEX_RESP_ContentVersion = 9;
  INDEX_RESP_DerivedFrom = 10;
  INDEX_RESP_Title = 11;
  //
  INDEX_RESP_ContentLength = 0;
  //
  INDEX_RESP_Date = 0;
  INDEX_RESP_Expires = 1;
  INDEX_RESP_LastModified = 2;
  //
  //Borland coder didn't define constants in HTTPApp
  INDEX_Method           = 0;
  INDEX_ProtocolVersion  = 1;
  INDEX_URL              = 2;
  INDEX_Query            = 3;
  INDEX_PathInfo         = 4;
  INDEX_PathTranslated   = 5;
  INDEX_CacheControl     = 6;
  INDEX_Date             = 7;
  INDEX_Accept           = 8;
  INDEX_From             = 9;
  INDEX_Host             = 10;
  INDEX_IfModifiedSince  = 11;
  INDEX_Referer          = 12;
  INDEX_UserAgent        = 13;
  INDEX_ContentEncoding  = 14;
  INDEX_ContentType      = 15;
  INDEX_ContentLength    = 16;
  INDEX_ContentVersion   = 17;
  INDEX_DerivedFrom      = 18;
  INDEX_Expires          = 19;
  INDEX_Title            = 20;
  INDEX_RemoteAddr       = 21;
  INDEX_RemoteHost       = 22;
  INDEX_ScriptName       = 23;
  INDEX_ServerPort       = 24;
  INDEX_Content          = 25;
  INDEX_Connection       = 26;
  INDEX_Cookie           = 27;
  INDEX_Authorization    = 28;

{ TIdHTTPAppRequest }

constructor TIdHTTPAppRequest.Create(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  i: Integer;
begin
  FThread := AThread;
  FRequestInfo := ARequestInfo;
  FResponseInfo := AResponseInfo;
  inherited Create;
  for i := 0 to ARequestInfo.Cookies.Count - 1 do begin
    CookieFields.Add(ARequestInfo.Cookies[i].ClientCookie);
  end;
  if Assigned(FRequestInfo.PostStream) then
  begin
    FContentStream := FRequestInfo.PostStream;
    FFreeContentStream := False;
  end else
  begin
    if FRequestInfo.FormParams <> '' then begin {do not localize}
      // an input form that was submitted as "application/www-url-encoded"...
      FContentStream := TStringStream.Create(FRequestInfo.FormParams);
    end else
    begin
      // anything else for now...
      FContentStream := TStringStream.Create(FRequestInfo.UnparsedParams);
    end;
    FFreeContentStream := True;
  end;
end;

destructor TIdHTTPAppRequest.Destroy;
begin
  if FFreeContentStream then begin
    FreeAndNil(FContentStream);
  end;
  inherited;
end;

function TIdHTTPAppRequest.GetDateVariable(Index: Integer): TDateTime;
var
  LValue: string;
begin
  LValue := string(GetStringVariable(Index));
  if Length(LValue) > 0 then begin
    Result := ParseDate(LValue);
  end else begin
    Result := -1;
  end;
end;

function TIdHTTPAppRequest.GetIntegerVariable(Index: Integer): Integer;
begin
  Result := StrToIntDef(string(GetStringVariable(Index)), -1)
end;

{$IFDEF VCL_XE_OR_ABOVE}
function TIdHTTPAppRequest.GetRawPathInfo: AnsiString;
begin
  Result := AnsiString(FRequestInfo.URI);
end;

function TIdHTTPAppRequest.GetRemoteIP: string;
begin
  Result := String(FRequestInfo.RemoteIP);
end;
{$ENDIF}

function TIdHTTPAppRequest.GetStringVariable(Index: Integer): AnsiString;
var
  s: string;
  LPos: TIdStreamSize;
  LBytes: TIdBytes;
begin
  LBytes := nil;
  case Index of
    INDEX_Method          : Result := AnsiString(FRequestInfo.Command);
    INDEX_ProtocolVersion : Result := AnsiString(FRequestInfo.Version);
    //INDEX_URL             : Result := AnsiString(FRequestInfo.Document);
    INDEX_URL             : Result := AnsiString(''); // Root - consistent with ISAPI which return path to root
    INDEX_Query           : Result := AnsiString(FRequestInfo.QueryParams);
    INDEX_PathInfo        : Result := AnsiString(FRequestInfo.Document);
    INDEX_PathTranslated  : Result := AnsiString(FRequestInfo.Document);             // it's not clear quite what should be done here - we can't translate to a path
    INDEX_CacheControl    : Result := GetFieldByName('Cache-Control');   {do not localize}
    INDEX_Date            : Result := GetFieldByName('Date');            {do not localize}
    INDEX_Accept          : Result := AnsiString(FRequestInfo.Accept);
    INDEX_From            : Result := AnsiString(FRequestInfo.From);
    INDEX_Host: begin
      s := FRequestInfo.Host;
      Result := AnsiString(Fetch(s, ':'));
    end;
    INDEX_IfModifiedSince : Result := GetFieldByName('If-Modified-Since'); {do not localize}
    INDEX_Referer         : Result := AnsiString(FRequestInfo.Referer);
    INDEX_UserAgent       : Result := AnsiString(FRequestInfo.UserAgent);
    INDEX_ContentEncoding : Result := AnsiString(FRequestInfo.ContentEncoding);
    INDEX_ContentType     : Result := AnsiString(FRequestInfo.ContentType);
    INDEX_ContentLength   : Result := AnsiString(IntToStr(FContentStream.Size));
    INDEX_ContentVersion  : Result := GetFieldByName('CONTENT_VERSION'); {do not localize}
    INDEX_DerivedFrom     : Result := GetFieldByName('Derived-From');    {do not localize}
    INDEX_Expires         : Result := GetFieldByName('Expires');         {do not localize}
    INDEX_Title           : Result := GetFieldByName('Title');           {do not localize}
    INDEX_RemoteAddr      : Result := AnsiString(FRequestInfo.RemoteIP);
    INDEX_RemoteHost      : Result := GetFieldByName('REMOTE_HOST');     {do not localize}
    INDEX_ScriptName      : Result := '';
    INDEX_ServerPort: begin
      s := FRequestInfo.Host;
      Fetch(s, ':');
      if Length(s) = 0 then begin
        s := IntToStr(FThread.Connection.Socket.Binding.Port);
        // Result := '80';
      end;
      Result := AnsiString(s);
    end;
    INDEX_Content: begin
      if FFreeContentStream then
      begin
        Result := AnsiString(TStringStream(FContentStream).DataString);
      end else
      begin
        LPos := FContentStream.Position;
        FContentStream.Position := 0;
        try
          // RLebeau 2/21/2009: not using ReadStringAsCharSet() anymore.  Since
          // this method returns an AnsiString, the stream data should not be
          // decoded to Unicode and then converted to Ansi.  That can lose
          // characters.  Also, for D2009+, the AnsiString payload should have
          // the proper codepage assigned to it as well so it can be converted
          // correctly if assigned to other string variables later on...

          // Result := ReadStringAsCharSet(FContentStream, FRequestInfo.CharSet);
          TIdStreamHelper.ReadBytes(FContentStream, LBytes);
          {$IFDEF DOTNET}
          // RLebeau: how to handle this correctly in .NET?
          Result := AnsiString(BytesToStringRaw(LBytes));
          {$ELSE}
          SetString(Result, PAnsiChar(LBytes), Length(LBytes));
            {$IFDEF VCL_2009_OR_ABOVE}
          SetCodePage(PRawByteString(@Result)^, CharsetToCodePage(FRequestInfo.CharSet), False);
            {$ENDIF}
          {$ENDIF}
        finally
          FContentStream.Position := LPos;
        end;
      end;
    end;
    INDEX_Connection      : Result := GetFieldByName('Connection');      {do not localize}
    INDEX_Cookie          : Result := '';  // not available at present. FRequestInfo.Cookies....;
    INDEX_Authorization   : Result := GetFieldByName('Authorization');   {do not localize}
  else
    Result := '';
  end;
end;

function TIdHTTPAppRequest.GetFieldByName(const Name: AnsiString): AnsiString;
begin
  Result := AnsiString(FRequestInfo.RawHeaders.Values[string(Name)]);
end;

function TIdHTTPAppRequest.ReadClient(var Buffer{$IFDEF CLR}: TBytes{$ENDIF};
  Count: Integer): Integer;
begin
  {$IFDEF CLR}
  Result := TIdStreamHelper.ReadBytes(FContentStream, Buffer, Count);
  {$ELSE}
  Result := FContentStream.Read(Buffer, Count);
  {$ENDIF}
  // well, it shouldn't be less than 0. but let's not take chances
  if Result < 0 then begin
    Result := 0;
  end;
end;

function TIdHTTPAppRequest.ReadString(Count: Integer): AnsiString;
var
  LBytes: TIdBytes;
begin
  // RLebeau 2/21/2009: not using ReadStringAsCharSet() anymore.  Since
  // this method returns an AnsiString, the stream data should not be
  // decoded to Unicode and then converted to Ansi.  That can lose
  // characters.

  // Result := AnsiString(ReadStringFromStream(FContentStream, Count));
  LBytes := nil;
  TIdStreamHelper.ReadBytes(FContentStream, LBytes, Count);
  {$IFDEF DOTNET}
  // RLebeau: how to handle this correctly in .NET?
  Result := AnsiString(BytesToStringRaw(LBytes));
  {$ELSE}
  SetString(Result, PAnsiChar(LBytes), Length(LBytes));
    {$IFDEF VCL_2009_OR_ABOVE}
  SetCodePage(PRawByteString(@Result)^, CharsetToCodePage(FRequestInfo.CharSet), False);
    {$ENDIF}
  {$ENDIF}
end;

function TIdHTTPAppRequest.TranslateURI(const URI: string): string;
begin
  // we don't have the concept of a path translation. It's not quite clear
  // what to do about this. Comments welcome (grahame@kestral.com.au)
  Result := URI;
end;

{$IFDEF VCL_6_OR_ABOVE_OR_CLR}
function TIdHTTPAppRequest.WriteHeaders(StatusCode: Integer; const ReasonString, Headers: AnsiString): Boolean;
begin
  FResponseInfo.ResponseNo := StatusCode;
  FResponseInfo.ResponseText := string(ReasonString);
  FResponseInfo.CustomHeaders.Add(string(Headers));
  FResponseInfo.WriteHeader;
  Result := True;
end;
{$ENDIF}

function TIdHTTPAppRequest.WriteString(const AString: AnsiString): Boolean;
begin
  FThread.Connection.IOHandler.Write(string(AString));
  Result := True;
end;

function TIdHTTPAppRequest.WriteClient(var ABuffer; ACount: Integer): Integer;
var
  LBuffer: TIdBytes;
begin
  SetLength(LBuffer, ACount);
{$IFNDEF CLR}
  Move(ABuffer, LBuffer[0], ACount);
{$ELSE}
  // RLebeau: this can't be right?  It is interpretting the source as a
  // null-terminated character string, which is likely not the case...
  CopyTIdBytes(ToBytes(string(ABuffer)), 0, LBuffer, 0, ACount);
{$ENDIF}
  FThread.Connection.IOHandler.Write(LBuffer);
  Result := ACount;
end;

{ TIdHTTPAppResponse }

constructor TIdHTTPAppResponse.Create(AHTTPRequest: TWebRequest; AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  FThread := AThread;
  FRequestInfo := ARequestInfo;
  FResponseInfo := AResponseInfo;
  inherited Create(AHTTPRequest);
  if Length(FHTTPRequest.ProtocolVersion) = 0 then begin
    Version := '1.0'; {do not localize}
  end;
  StatusCode := 200;
  LastModified := -1;
  Expires := -1;
  Date := -1;

  // RLebeau 8/13/2015: no longer setting a default ContentType here.  Doing so
  // sets a default CharSet, which would get carried over if the user assigns a
  // new *non-text* ContentType without an explicit charset.  TAppResponse does
  // not expose access to the FResponseInfo.CharSet property.  For example, if
  // the user sets TAppResponse.ContentType to 'image/jpeg', the resulting
  // Content-Type header woud be 'image/jpeg; charset=ISO-8859-1', which can
  // cause problems for some clients.  Besides, TIdHTTPResponseInfo.WriteHeader()
  // sets the ContentType to 'text/html; charset=ISO-8859-1' if no ContentType
  // has been provided but there is ContentText/ContentStream data, so this is
  // redundant here anyway...
  //
  // ContentType := 'text/html'; {do not localize}
end;

function TIdHTTPAppResponse.GetContent: AnsiString;
{$IFDEF STRING_IS_UNICODE}
var
  LEncoding: IIdTextEncoding;
  LBytes: TIdBytes;
{$ENDIF}
begin
  {$IFDEF STRING_IS_UNICODE}
  // RLebeau 2/21/2009: encode the content using the specified charset.
  // Also, the AnsiString payload should have the proper codepage assigned
  // to it as well so it can be converted correctly if assigned to other
  // string variables later on...
  Result := '';
  LEncoding := CharsetToEncoding(FResponseInfo.CharSet);
  LBytes := LEncoding.GetBytes(FResponseInfo.ContentText);
    {$IFDEF DOTNET}
  // RLebeau: how to handle this correctly in .NET?
  Result := AnsiString(BytesToStringRaw(LBytes));
    {$ELSE}
  SetString(Result, PAnsiChar(LBytes), Length(LBytes));
      {$IFDEF VCL_2009_OR_ABOVE}
  SetCodePage(PRawByteString(@Result)^, CharsetToCodePage(FResponseInfo.CharSet), False);
      {$ENDIF}
    {$ENDIF}
  {$ELSE}
  Result := FResponseInfo.ContentText;
  {$ENDIF}
end;

function TIdHTTPAppResponse.GetLogMessage: string;
begin
  Result := '';
end;

function TIdHTTPAppResponse.GetStatusCode: Integer;
begin
  Result := FResponseInfo.ResponseNo;
end;

function TIdHTTPAppResponse.GetDateVariable(Index: Integer): TDateTime;
  // WebBroker apps are responsible for conversion to GMT, Indy HTTP server expects apps to pas local time
  function ToGMT(ADateTime: TDateTime): TDateTime;
  begin
    Result := ADateTime;
    if Result <> -1 then
      Result := Result - OffsetFromUTC;
  end;
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Date             : Result := ToGMT(FResponseInfo.Date);
    INDEX_RESP_Expires          : Result := ToGMT(FResponseInfo.Expires);
    INDEX_RESP_LastModified     : Result := ToGMT(FResponseInfo.LastModified);
  else
    raise EWBBInvalidIdxGetDateVariable.Create( Format( RSWBBInvalidIdxGetDateVariable,[inttostr(Index)]));
  end;
end;

procedure TIdHTTPAppResponse.SetDateVariable(Index: Integer; const Value: TDateTime);
  // WebBroker apps are responsible for conversion to GMT, Indy HTTP server expects apps to pas local time
  function ToLocal(ADateTime: TDateTime): TDateTime;
  begin
    Result := ADateTime;
    if Result <> -1 then
      Result := Result + OffsetFromUTC;
  end;
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Date             : FResponseInfo.Date := ToLocal(Value);
    INDEX_RESP_Expires          : FResponseInfo.Expires := ToLocal(Value);
    INDEX_RESP_LastModified     : FResponseInfo.LastModified := ToLocal(Value);
  else
    raise EWBBInvalidIdxSetDateVariable.Create(Format(RSWBBInvalidIdxSetDateVariable,[inttostr(Index) ]));
  end;
end;

function TIdHTTPAppResponse.GetIntegerVariable(Index: Integer): Integer;
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_ContentLength: Result := FResponseInfo.ContentLength;
  else
    raise EWBBInvalidIdxGetIntVariable.Create( Format( RSWBBInvalidIdxGetIntVariable,[inttostr(Index)]));
  end;
end;

procedure TIdHTTPAppResponse.SetIntegerVariable(Index, Value: Integer);
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_ContentLength: FResponseInfo.ContentLength := Value;
  else
    raise EWBBInvalidIdxSetIntVariable.Create( Format(RSWBBInvalidIdxSetIntVariable,[inttostr(Index)]));  {do not localize}
  end;
end;

function TIdHTTPAppResponse.GetStringVariable(Index: Integer): AnsiString;
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Version           :Result := AnsiString(FRequestInfo.Version);
    INDEX_RESP_ReasonString      :Result := AnsiString(FResponseInfo.ResponseText);
    INDEX_RESP_Server            :Result := AnsiString(FResponseInfo.Server);
    INDEX_RESP_WWWAuthenticate   :Result := AnsiString(FResponseInfo.WWWAuthenticate.Text);
    INDEX_RESP_Realm             :Result := AnsiString(FResponseInfo.AuthRealm);
    INDEX_RESP_Allow             :Result := AnsiString(FResponseInfo.CustomHeaders.Values['Allow']);        {do not localize}
    INDEX_RESP_Location          :Result := AnsiString(FResponseInfo.Location);
    INDEX_RESP_ContentEncoding   :Result := AnsiString(FResponseInfo.ContentEncoding);
    INDEX_RESP_ContentType       :
    begin
      if FContentType <> '' then begin
        Result := FContentType;
      end else begin
        Result := AnsiString(FResponseInfo.ContentType);
      end;
    end;
    INDEX_RESP_ContentVersion    :Result := AnsiString(FResponseInfo.ContentVersion);
    INDEX_RESP_DerivedFrom       :Result := AnsiString(FResponseInfo.CustomHeaders.Values['Derived-From']); {do not localize}
    INDEX_RESP_Title             :Result := AnsiString(FResponseInfo.CustomHeaders.Values['Title']);        {do not localize}
  else
    raise EWBBInvalidIdxGetStrVariable.Create(Format(RSWBBInvalidIdxGetStrVariable,[ IntToStr(Index)]));
  end;
end;

procedure TIdHTTPAppResponse.SetStringVariable(Index: Integer; const Value: AnsiString);
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Version           :EWBBInvalidStringVar.Create(RSWBBInvalidStringVar);
    INDEX_RESP_ReasonString      :FResponseInfo.ResponseText := string(Value);
    INDEX_RESP_Server            :FResponseInfo.Server := string(Value);
    INDEX_RESP_WWWAuthenticate   :FResponseInfo.WWWAuthenticate.Text := string(Value);
    INDEX_RESP_Realm             :FResponseInfo.AuthRealm := string(Value);
    INDEX_RESP_Allow             :FResponseInfo.CustomHeaders.Values['Allow'] := string(Value); {do not localize}
    INDEX_RESP_Location          :FResponseInfo.Location := string(Value);
    INDEX_RESP_ContentEncoding   :FResponseInfo.ContentEncoding := string(Value);
    INDEX_RESP_ContentType       :
    begin
      FResponseInfo.ContentType := string(Value);
      FContentType := Value;
    end;
    INDEX_RESP_ContentVersion    :FResponseInfo.ContentVersion := string(Value);
    INDEX_RESP_DerivedFrom       :FResponseInfo.CustomHeaders.Values['Derived-From'] := string(Value);  {do not localize}
    INDEX_RESP_Title             :FResponseInfo.CustomHeaders.Values['Title'] := string(Value); {do not localize}
  else
    raise EWBBInvalidIdxSetStringVar.Create( Format(RSWBBInvalidIdxSetStringVar,[IntToStr(Index)]));                   {do not localize}
  end;
end;

procedure TIdHTTPAppResponse.SendRedirect(const URI: AnsiString);
begin
  FSent := True;
  MoveCookiesAndCustomHeaders;
  FResponseInfo.Redirect(string(URI));
end;

procedure TIdHTTPAppResponse.SendResponse;
begin
  FSent := True;
  // Reset to -1 so Indy will auto set it
  FResponseInfo.ContentLength := -1;
  MoveCookiesAndCustomHeaders;
  FResponseInfo.WriteContent;
end;

procedure TIdHTTPAppResponse.SendStream(AStream: TStream);
begin
  FThread.Connection.IOHandler.Write(AStream);
end;

function TIdHTTPAppResponse.Sent: Boolean;
begin
  Result := FSent;
end;

procedure TIdHTTPAppResponse.SetContent(const AValue: AnsiString);
var
  LValue : string;
begin
  {$IFDEF STRING_IS_UNICODE}
  // RLebeau 3/28/2013: decode the content using the specified charset.
  if FResponseInfo.CharSet <> '' then begin
    // AValue contains Encoded bytes
    if AValue <> '' then begin
      LValue := CharsetToEncoding(FResponseInfo.CharSet).GetString(RawToBytes(PAnsiChar(AValue)^, Length(AValue)));
    end;
  end else begin
    LValue := string(AValue);
  end;
  {$ELSE}
  LValue := string(AValue);
  {$ENDIF}
  FResponseInfo.ContentText := LValue;
  FResponseInfo.ContentLength := Length(LValue);
end;

procedure TIdHTTPAppResponse.SetLogMessage(const Value: string);
begin
  // logging not supported
end;

procedure TIdHTTPAppResponse.SetStatusCode(AValue: Integer);
begin
  FResponseInfo.ResponseNo := AValue;
end;

procedure TIdHTTPAppResponse.SetContentStream(AValue: TStream);
begin
  inherited;
  FResponseInfo.ContentStream := AValue;
end;

function DoHTTPEncode(const AStr: AnsiString): String;
begin
  {$IFDEF HAS_TNetEncoding}
  Result := TNetEncoding.URL.Encode(string(AStr));
  {$ELSE}
  Result := String(HTTPEncode(AStr));
  {$ENDIF}
end;

procedure TIdHTTPAppResponse.MoveCookiesAndCustomHeaders;
var
  i: Integer;
  LSrcCookie: TCookie;
  LDestCookie: TIdCookie;
begin
  for i := 0 to Cookies.Count - 1 do begin
    LSrcCookie := Cookies[i];
    LDestCookie := FResponseInfo.Cookies.Add;
    LDestCookie.CookieName := DoHTTPEncode(LSrcCookie.Name);
    LDestCookie.Value := DoHTTPEncode(LSrcCookie.Value);
    LDestCookie.Domain := String(LSrcCookie.Domain);
    LDestCookie.Path := String(LSrcCookie.Path);
    LDestCookie.Expires := LSrcCookie.Expires;
    LDestCookie.Secure := LSrcCookie.Secure;
    // TODO: LDestCookie.HttpOnly := LSrcCookie.HttpOnly;
  end;
  FResponseInfo.CustomHeaders.Clear;
  FResponseInfo.CustomHeaders.AddStdValues(CustomHeaders);
end;

{ TIdHTTPWebBrokerBridge }

procedure TIdHTTPWebBrokerBridge.DoCommandOther(AThread: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  DoCommandGet(AThread, ARequestInfo, AResponseInfo);

end;

procedure TIdHTTPWebBrokerBridge.InitComponent;
begin
  inherited InitComponent;
 // FOkToProcessCommand := True;
end;

type
  TIdHTTPWebBrokerBridgeRequestHandler = class(TWebRequestHandler)
  {$IFDEF HAS_CLASSVARS}
  private
   class var FWebRequestHandler: TIdHTTPWebBrokerBridgeRequestHandler;
  {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    {$IFDEF HAS_CLASSVARS}
      {$IFDEF HAS_CLASSDESTRUCTOR}
    class destructor Destroy;
      {$ENDIF}
    {$ENDIF}
    destructor Destroy; override;
    procedure Run(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  end;

{$IFNDEF HAS_CLASSVARS}
var
  IndyWebRequestHandler: TIdHTTPWebBrokerBridgeRequestHandler = nil;
{$ENDIF}

{ TIdHTTPWebBrokerBridgeRequestHandler }

procedure TIdHTTPWebBrokerBridgeRequestHandler.Run(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  LRequest: TIdHTTPAppRequest;
  LResponse: TIdHTTPAppResponse;
begin
  try
    LRequest := TIdHTTPAppRequest.Create(AThread, ARequestInfo, AResponseInfo);
    try
      LResponse := TIdHTTPAppResponse.Create(LRequest, AThread, ARequestInfo, AResponseInfo);
      try
        // WebBroker will free it and we cannot change this behaviour
        AResponseInfo.FreeContentStream := False;
        HandleRequest(LRequest, LResponse);
      finally
        FreeAndNil(LResponse);
      end;
    finally
      FreeAndNil(LRequest);
    end;
  except
    // Let Indy handle this exception
    raise;
  end;
end;

constructor TIdHTTPWebBrokerBridgeRequestHandler.Create(AOwner: TComponent);
begin
  inherited;
  Classes.ApplicationHandleException := HandleException;
end;

destructor TIdHTTPWebBrokerBridgeRequestHandler.Destroy;
begin
  Classes.ApplicationHandleException := nil;
  inherited;
end;

{$IFDEF HAS_CLASSVARS}
  {$IFDEF HAS_CLASSDESTRUCTOR}
class destructor TIdHTTPWebBrokerBridgeRequestHandler.Destroy;
begin
  FreeAndNil(FWebRequestHandler);
end;
  {$ENDIF}
{$ENDIF}

function IdHTTPWebBrokerBridgeRequestHandler: TWebRequestHandler;
begin
  {$IFDEF HAS_CLASSVARS}
  if not Assigned(TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler) then
    TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler := TIdHTTPWebBrokerBridgeRequestHandler.Create(nil);
  Result := TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler;
  {$ELSE}
  if not Assigned(IndyWebRequestHandler) then
    IndyWebRequestHandler := TIdHTTPWebBrokerBridgeRequestHandler.Create(nil);
  Result := IndyWebRequestHandler;
  {$ENDIF}
end;

procedure TIdHTTPWebBrokerBridge.DoCommandGet(AThread: TIdContext;
 ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  if FWebModuleClass <> nil then begin
    // FWebModuleClass, RegisterWebModuleClass supported for backward compatability
    RunWebModuleClass(AThread, ARequestInfo, AResponseInfo)
  end else
  begin
    {$IFDEF HAS_CLASSVARS}
    TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler.Run(AThread, ARequestInfo, AResponseInfo);
    {$ELSE}
    IndyWebRequestHandler.Run(AThread, ARequestInfo, AResponseInfo);
    {$ENDIF}
  end;
end;

procedure TIdHTTPWebBrokerBridge.RunWebModuleClass(AThread: TIdContext;
 ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  LRequest: TIdHTTPAppRequest;
  LResponse: TIdHTTPAppResponse;
  LWebModule: TCustomWebDispatcher;
  {$IFDEF VCL_6_OR_ABOVE}
  WebRequestHandler: IWebRequestHandler;
  {$ENDIF}
  Handled: Boolean;
begin
  LRequest := TIdHTTPAppRequest.Create(AThread, ARequestInfo, AResponseInfo);
  try
    LResponse := TIdHTTPAppResponse.Create(LRequest, AThread, ARequestInfo, AResponseInfo);
    try
      // WebBroker will free it and we cannot change this behaviour
      AResponseInfo.FreeContentStream := False;
      // There are better ways in D6, but this works in D5
      LWebModule := FWebModuleClass.Create(nil) as TCustomWebDispatcher;
      try
        {$IFDEF VCL_6_OR_ABOVE}
        if Supports(LWebModule, IWebRequestHandler, WebRequestHandler) then begin
          try
            Handled := WebRequestHandler.HandleRequest(LRequest, LResponse);
          finally
            WebRequestHandler := nil;
          end;
        end else begin
          Handled := TWebDispatcherAccess(LWebModule).DispatchAction(LRequest, LResponse);
        end;
        {$ELSE}
        Handled := TWebDispatcherAccess(LWebModule).DispatchAction(LRequest, LResponse);
        {$ENDIF}
        if Handled and (not LResponse.Sent) then begin
          LResponse.SendResponse;
        end;
      finally
        FreeAndNil(LWebModule);
      end;
    finally
      FreeAndNil(LResponse);
    end;
  finally
    FreeAndNil(LRequest);
  end;
end;

// FWebModuleClass, RegisterWebModuleClass supported for backward compatability
// Instead set WebModuleClass using: WebReq.WebRequestHandler.WebModuleClass := TWebModule1;
procedure TIdHTTPWebBrokerBridge.RegisterWebModuleClass(AClass: TComponentClass);
begin
  FWebModuleClass := AClass;
end;

initialization
  WebReq.WebRequestHandlerProc := IdHTTPWebBrokerBridgeRequestHandler;
{$IFDEF HAS_CLASSVARS}
  {$IFNDEF HAS_CLASSDESTRUCTOR}
finalization
  FreeAndNil(TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler);
  {$ENDIF}
{$ELSE}
finalization
  FreeAndNil(IndyWebRequestHandler);
{$ENDIF}

end.