restemplate/indy/Protocols/IdHTTPHeaderInfo.pas

{
  $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.9    2/16/2005 7:58:56 AM  DSiders
  Modified TIdRequestHeaderInfo to restore the Range property.
  Modified TIdRequestHeaderInfo methods AssignTo, Clear, ProcessHeaders, and
    SetHeaders to include Range property.

  Rev 1.8    11/11/2004 12:55:38 AM  DSiders
  Modified TIdEntityHeaderInfo to fix problems with content-range header
    handling.
  Added ContentRangeInstanceLength property.
  Added HasContentRange property (read-ony).
  Added HasContentRangeInstance property (read-only).
  Moved reading and writing methods to ProcessHeaders and SetHeaders in
    TIdEntityHeaderInfo.

  Rev 1.7    6/8/2004 10:35:46 AM  BGooijen
  fixed overflow

  Rev 1.6    2004.02.03 5:43:46 PM  czhower
  Name changes

  Rev 1.5    1/22/2004 7:10:08 AM  JPMugaas
  Tried to fix AnsiSameText depreciation.

  Rev 1.4    13.1.2004 ã. 17:17:44  DBondzhev
  moved few methods into protected section to remove some warnings

  Rev 1.3    10/17/2003 12:09:28 AM  DSiders
  Added localization comments.

  Rev 1.2    20/4/2003 3:46:34 PM  SGrobety
  Fix to previous fix... (Dumb me)

  Rev 1.1    20/4/2003 3:33:58 PM  SGrobety
  Changed Content-type default in TIdEntityHeaderInfo back to empty string
    and changed the default of the response object. Solved compatibility
    issue with Netscape servers

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

unit IdHTTPHeaderInfo;

{
  HTTP Header definition - RFC 2616
  Author: Doychin Bondzhev (doychin@dsoft-bg.com)
}

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdAuthentication,
  IdGlobal,
  IdGlobalProtocols,
  IdHeaderList;

type
  TIdEntityHeaderInfo = class(TPersistent)
  protected
    {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FOwner: TPersistent;
    FCacheControl: String;
    FRawHeaders: TIdHeaderList;
    FCharSet: String;
    FConnection: string;
    FContentDisposition: string;
    FContentEncoding: string;
    FContentLanguage: string;
    FContentLength: Int64;
    FContentRangeEnd: Int64;
    FContentRangeStart: Int64;
    FContentRangeInstanceLength: Int64;
    FContentRangeUnits: String;
    FContentType: string;
    FContentVersion: string;
    FCustomHeaders: TIdHeaderList;
    FDate: TDateTime;
    FExpires: TDateTime;
    FETag: string;
    FLastModified: TDateTime;
    FPragma: string;
    FHasContentLength: Boolean;
    FTransferEncoding: String;
    //
    procedure AssignTo(Destination: TPersistent); override;
    procedure ProcessHeaders; virtual;
    procedure SetHeaders; virtual;
    function GetOwner: TPersistent; override;
    function GetOwnerComponent: TComponent;

    procedure SetContentLength(const AValue: Int64);
    procedure SetContentType(const AValue: String);
    procedure SetCustomHeaders(const AValue: TIdHeaderList);
    function GetHasContentRange: Boolean;
    function GetHasContentRangeInstance: Boolean;
  public
    procedure AfterConstruction; override;
    procedure Clear; virtual;
    constructor Create(AOwner: TPersistent); virtual;
    destructor Destroy; override;
    //
    property OwnerComponent: TComponent read GetOwnerComponent;
    property HasContentLength: Boolean read FHasContentLength;
    property HasContentRange: Boolean read GetHasContentRange;
    property HasContentRangeInstance: Boolean read GetHasContentRangeInstance;
    property RawHeaders: TIdHeaderList read FRawHeaders;
  published
    property CacheControl: String read FCacheControl write FCacheControl;
    property CharSet: String read FCharSet write FCharSet;
    property Connection: string read FConnection write FConnection;
    property ContentDisposition: string read FContentDisposition write FContentDisposition;
    property ContentEncoding: string read FContentEncoding write FContentEncoding;
    property ContentLanguage: string read FContentLanguage write FContentLanguage;
    property ContentLength: Int64 read FContentLength write SetContentLength;
    property ContentRangeEnd: Int64 read FContentRangeEnd write FContentRangeEnd;
    property ContentRangeStart: Int64 read FContentRangeStart write FContentRangeStart;
    property ContentRangeInstanceLength: Int64 read FContentRangeInstanceLength write FContentRangeInstanceLength;
    property ContentRangeUnits: String read FContentRangeUnits write FContentRangeUnits;
    property ContentType: string read FContentType write SetContentType;
    property ContentVersion: string read FContentVersion write FContentVersion;
    property CustomHeaders: TIdHeaderList read FCustomHeaders write SetCustomHeaders;
    property Date: TDateTime read FDate write FDate;
    property ETag: string read FETag write FETag;
    property Expires: TDateTime read FExpires write FExpires;
    property LastModified: TDateTime read FLastModified write FLastModified;
    property Pragma: string read FPragma write FPragma;
    property TransferEncoding: string read FTransferEncoding write FTransferEncoding;
  end;

  TIdProxyConnectionInfo = class(TPersistent)
  protected
    FAuthentication: TIdAuthentication;
    FPassword: string;
    FPort: Integer;
    FServer: string;
    FUsername: string;
    FBasicByDefault: Boolean;

    procedure AssignTo(Destination: TPersistent); override;
    procedure SetProxyPort(const Value: Integer);
    procedure SetProxyServer(const Value: string);
  public
    procedure AfterConstruction; override;
    constructor Create;
    procedure Clear;
    destructor Destroy; override;
    procedure SetHeaders(Headers: TIdHeaderList);
    //
    property Authentication: TIdAuthentication read FAuthentication write FAuthentication;
  published

    property BasicAuthentication: boolean read FBasicByDefault write FBasicByDefault;
    property ProxyPassword: string read FPassword write FPassword;
    property ProxyPort: Integer read FPort write SetProxyPort;
    property ProxyServer: string read FServer write SetProxyServer;
    property ProxyUsername: string read FUsername write FUserName;
  end;

  TIdEntityRange = class(TCollectionItem)
  protected
    FStartPos: Int64;
    FEndPos: Int64;
    FSuffixLength: Int64;
    function GetText: String;
    procedure SetText(const AValue: String);
  public
    constructor Create(Collection: TCollection); override;
  published
    property StartPos: Int64 read FStartPos write FStartPos;
    property EndPos: Int64 read FEndPos write FEndPos;
    property SuffixLength: Int64 read FSuffixLength write FSuffixLength;
    property Text: String read GetText write SetText;
  end;

  TIdEntityRanges = class(TOwnedCollection)
  protected
    FUnits: String;
    function GetRange(Index: Integer): TIdEntityRange;
    procedure SetRange(Index: Integer; AValue: TIdEntityRange);
    function GetText: String;
    procedure SetText(const AValue: String);
    procedure SetUnits(const AValue: String);
  public
    constructor Create(AOwner: TPersistent); reintroduce;
    function Add: TIdEntityRange; reintroduce;
    property Ranges[Index: Integer]: TIdEntityRange read GetRange write SetRange; default;
  published
    property Text: String read GetText write SetText;
    property Units: String read FUnits write SetUnits;
  end;

  TIdRequestHeaderInfo = class(TIdEntityHeaderInfo)
  protected
    FAccept: String;
    FAcceptCharSet: String;
    FAcceptEncoding: String;
    FAcceptLanguage: String;
    FExpect: String;
    FFrom: String;
    FPassword: String;
    FReferer: String;
    FUserAgent: String;
    FUserName: String;
    FHost: String;
    FProxyConnection: String;
    FRanges: TIdEntityRanges;
    FBasicByDefault: Boolean;
    FAuthentication: TIdAuthentication;
    FMethodOverride: String;
    //
    procedure AssignTo(Destination: TPersistent); override;
    procedure ProcessHeaders; override;
    procedure SetHeaders; override;
    function GetRange: String;
    procedure SetRange(const AValue: String);
    procedure SetRanges(AValue: TIdEntityRanges);
  public
    //
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Clear; override;
    property Authentication: TIdAuthentication read FAuthentication write FAuthentication;
  published
    property Accept: String read FAccept write FAccept;
    property AcceptCharSet: String read FAcceptCharSet write FAcceptCharSet;
    property AcceptEncoding: String read FAcceptEncoding write FAcceptEncoding;
    property AcceptLanguage: String read FAcceptLanguage write FAcceptLanguage;
    property BasicAuthentication: boolean read FBasicByDefault write FBasicByDefault;
    property Host: String read FHost write FHost;
    property From: String read FFrom write FFrom;
    property Password: String read FPassword write FPassword;
    property Referer: String read FReferer write FReferer;
    property UserAgent: String read FUserAgent write FUserAgent;
    property Username: String read FUsername write FUsername;
    property ProxyConnection: String read FProxyConnection write FProxyConnection;
    property Range: String read GetRange write SetRange; //deprecated 'Use Ranges property';
    property Ranges: TIdEntityRanges read FRanges write SetRanges;
    property MethodOverride: String read FMethodOverride write FMethodOverride;
  end;

  TIdResponseHeaderInfo = class(TIdEntityHeaderInfo)
  protected
    FAcceptPatch: string;
    FAcceptRanges: string;
    FLocation: string;
    FServer: string;
    FProxyConnection: string;
    FProxyAuthenticate: TIdHeaderList;
    FWWWAuthenticate: TIdHeaderList;
    //
    procedure SetProxyAuthenticate(const Value: TIdHeaderList);
    procedure SetWWWAuthenticate(const Value: TIdHeaderList);
    procedure SetAcceptPatch(const Value: string);
    procedure SetAcceptRanges(const Value: string);
    procedure ProcessHeaders; override;
    procedure SetHeaders; override;
  public

    procedure Clear; override;
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
  published
    property AcceptPatch: string read FAcceptPatch write SetAcceptPatch;
    property AcceptRanges: string read FAcceptRanges write SetAcceptRanges;
    property Location: string read FLocation write FLocation;
    property ProxyConnection: string read FProxyConnection write FProxyConnection;
    property ProxyAuthenticate: TIdHeaderList read FProxyAuthenticate write SetProxyAuthenticate;
    property Server: string read FServer write FServer;
    property WWWAuthenticate: TIdHeaderList read FWWWAuthenticate write SetWWWAuthenticate;
  end;

  TIdMetaHTTPEquiv = class(TIdEntityHeaderInfo)
  public
    procedure ProcessMetaHTTPEquiv(AStream: TStream);
  end;

var
  GIdDefaultUserAgent: String = 'Mozilla/3.0 (compatible; Indy Library)'; {do not localize}

implementation

uses
  SysUtils;

{ TIdEntityHeaderInfo }

constructor TIdEntityHeaderInfo.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  // HTTP does not fold headers based on line length
  FRawHeaders := TIdHeaderList.Create(QuoteHTTP);
  FRawHeaders.FoldLength := MaxInt;
  FCustomHeaders := TIdHeaderList.Create(QuoteHTTP);
  FCustomHeaders.FoldLength := MaxInt;
end;

procedure TIdEntityHeaderInfo.AfterConstruction;
begin
  inherited AfterConstruction;
  Clear;
end;

destructor TIdEntityHeaderInfo.Destroy;
begin
  FreeAndNil(FRawHeaders);
  FreeAndNil(FCustomHeaders);
  inherited Destroy;
end;

procedure TIdEntityHeaderInfo.AssignTo(Destination: TPersistent);
var
  LDest: TIdEntityHeaderInfo;
begin
  if Destination is TIdEntityHeaderInfo then
  begin
    LDest := TIdEntityHeaderInfo(Destination);
    LDest.FRawHeaders.Assign(FRawHeaders);
    LDest.FCustomHeaders.Assign(FCustomHeaders);
    LDest.FCacheControl := FCacheControl;
    LDest.FCharSet := FCharSet;
    LDest.FContentDisposition := FContentDisposition;
    LDest.FContentEncoding := FContentEncoding;
    LDest.FContentLanguage := FContentLanguage;
    LDest.FContentType := FContentType;
    LDest.FContentVersion := FContentVersion;
    LDest.FContentLength := FContentLength;
    LDest.FContentRangeEnd:= FContentRangeEnd;
    LDest.FContentRangeStart:= FContentRangeStart;
    LDest.FContentRangeInstanceLength := FContentRangeInstanceLength;
    LDest.FContentRangeUnits := FContentRangeUnits;
    LDest.FDate := FDate;
    LDest.FETag := FETag;
    LDest.FExpires := FExpires;
    LDest.FLastModified := FLastModified;
  end else
  begin
    inherited AssignTo(Destination);
  end;
end;

procedure TIdEntityHeaderInfo.Clear;
begin
  FCacheControl := '';
  FCharSet := '';
  FConnection := '';
  FContentVersion := '';
  FContentDisposition := '';
  FContentEncoding := '';
  FContentLanguage := '';

  { S.G. 20/4/2003

    Was FContentType := 'Text/HTML'

    Shouldn't be set here but in response.
    Requests, by default, have NO content-type.
    This caused problems with some netscape servers
  }
  FContentType := '';

  FContentLength := -1;
  FContentRangeStart := -1;
  FContentRangeEnd := -1;
  FContentRangeInstanceLength := -1;
  FContentRangeUnits := '';
  FDate := 0;
  FLastModified := 0;
  FETag := '';
  FExpires := 0;
  FRawHeaders.Clear;
end;

procedure TIdEntityHeaderInfo.ProcessHeaders;
var
  LSecs: Int64;
  lValue: string;
  lCRange: string;
  lILength: string;
begin
  FCacheControl := FRawHeaders.Values['Cache-control']; {do not localize}
  FConnection := FRawHeaders.Values['Connection']; {do not localize}
  FContentVersion := FRawHeaders.Values['Content-Version']; {do not localize}
  FContentDisposition := FRawHeaders.Values['Content-Disposition']; {do not localize}
  FContentEncoding := FRawHeaders.Values['Content-Encoding']; {do not localize}
  FContentLanguage := FRawHeaders.Values['Content-Language']; {do not localize}
  ContentType := FRawHeaders.Values['Content-Type']; {do not localize}
  FContentLength := IndyStrToInt64(FRawHeaders.Values['Content-Length'], -1); {do not localize}
  FHasContentLength := FContentLength >= 0;

  FContentRangeStart := -1;
  FContentRangeEnd := -1;
  FContentRangeInstanceLength := -1;
  FContentRangeUnits := '';

  {
   handle content-range headers, like:

   content-range: bytes 1-65536/102400
   content-range: bytes */102400
   content-range: bytes 1-65536/*
  }
  lValue := FRawHeaders.Values['Content-Range']; {do not localize}
  if lValue <> '' then
  begin
    // strip the bytes unit, and keep the range and instance info
    FContentRangeUnits := Fetch(lValue);
    lCRange := Fetch(lValue, '/');
    lILength := Fetch(lValue);

    FContentRangeStart := IndyStrToInt64(Fetch(lCRange, '-'), -1);
    FContentRangeEnd := IndyStrToInt64(lCRange, -1);
    FContentRangeInstanceLength := IndyStrToInt64(lILength, -1);
  end;

  // RLebeau 03/04/2009: RFC 2616 Section 14.18 says:
  //
  // "A received message that does not have a Date header field MUST be
  // assigned one by the recipient if the message will be cached by that
  // recipient or gatewayed via a protocol which requires a Date."

  lValue := FRawHeaders.Values['Date']; {do not localize}
  if lValue <> '' then
  begin
    FDate := GMTToLocalDateTime(lValue);
  end else
  begin
    FDate := Now;
  end;

  FLastModified := GMTToLocalDateTime(FRawHeaders.Values['Last-Modified']); {do not localize}

  // RLebeau 01/23/2006 - IIS fix
  lValue := FRawHeaders.Values['Expires']; {do not localize}
  if IsNumeric(lValue) then
  begin
    // This is happening when expires is an integer number in seconds
    LSecs := IndyStrToInt64(lValue);
    // RLebeau 01/23/2005 - IIS sometimes sends an 'Expires: -1' header
    // should we be handling it as actually meaning "Now minus 1 second" instead?
    if LSecs >= 0 then begin
      FExpires := Now + (LSecs / SecsPerDay);
    end else begin
      FExpires := 0.0;
    end;
  end else
  begin
    // RLebeau 03/04/2009: RFC 2616 Section 14.21 says:
    //
    // "The format is an absolute date and time as defined by HTTP-date in
    //  section 3.3.1; it MUST be in RFC 1123 date format:
    //
    //   Expires = "Expires" ":" HTTP-date
    //
    // HTTP/1.1 clients and caches MUST treat other invalid date formats,
    // especially including the value "0", as in the past (i.e., "already
    // expired")."

    try
      FExpires := GMTToLocalDateTime(lValue);
    except
      FExpires := Now - (1 / SecsPerDay);
    end;
  end;

  FETag := FRawHeaders.Values['ETag'];  {do not localize}
  FPragma := FRawHeaders.Values['Pragma'];  {do not localize}
  FTransferEncoding := FRawHeaders.Values['Transfer-Encoding']; {do not localize}
end;

procedure TIdEntityHeaderInfo.SetHeaders;
begin
  FRawHeaders.Clear;
  if Length(FConnection) > 0 then
  begin
    FRawHeaders.Values['Connection'] := FConnection; {do not localize}
  end;
  if Length(FContentVersion) > 0 then
  begin
    FRawHeaders.Values['Content-Version'] := FContentVersion; {do not localize}
  end;
  if Length(FContentDisposition) > 0 then
  begin
    FRawHeaders.Values['Content-Disposition'] := FContentDisposition; {do not localize}
  end;
  if Length(FContentEncoding) > 0 then
  begin
    FRawHeaders.Values['Content-Encoding'] := FContentEncoding; {do not localize}
  end;
  if Length(FContentLanguage) > 0 then
  begin
    FRawHeaders.Values['Content-Language'] := FContentLanguage; {do not localize}
  end;
  if Length(FContentType) > 0 then
  begin
    FRawHeaders.Values['Content-Type'] := FContentType; {do not localize}
    FRawHeaders.Params['Content-Type', 'charset'] := FCharSet; {do not localize}
  end;
  if FContentLength >= 0 then
  begin
    FRawHeaders.Values['Content-Length'] := IntToStr(FContentLength); {do not localize}
  end;

  { removed setting Content-Range header for entities... deferred to response }

  if Length(FCacheControl) > 0 then
  begin
    FRawHeaders.Values['Cache-control'] := FCacheControl; {do not localize}
  end;
  if FDate > 0 then
  begin
    FRawHeaders.Values['Date'] := LocalDateTimeToHttpStr(FDate); {do not localize}
  end;
  if Length(FETag) > 0 then
  begin
    FRawHeaders.Values['ETag'] := FETag; {do not localize}
  end;
  if FExpires > 0 then
  begin
    FRawHeaders.Values['Expires'] := LocalDateTimeToHttpStr(FExpires); {do not localize}
  end;
  if Length(FPragma) > 0 then
  begin
    FRawHeaders.Values['Pragma'] := FPragma; {do not localize}
  end;
  if Length(FTransferEncoding) > 0 then
  begin
    FRawHeaders.Values['Transfer-Encoding'] := FTransferEncoding; {do not localize}
  end;
  if FCustomHeaders.Count > 0 then
  begin
    // append custom headers
    // TODO: use AddStrings() instead?
    FRawHeaders.Text := FRawHeaders.Text + FCustomHeaders.Text;
  end;
end;

procedure TIdEntityHeaderInfo.SetCustomHeaders(const AValue: TIdHeaderList);
begin
  FCustomHeaders.Assign(AValue);
end;

procedure TIdEntityHeaderInfo.SetContentLength(const AValue: Int64);
begin
  FContentLength := AValue;
  FHasContentLength := FContentLength >= 0;
end;

procedure TIdEntityHeaderInfo.SetContentType(const AValue: String);
var
  S, LCharSet: string;
  LComp: TComponent;
begin
  if AValue <> '' then begin
    FContentType := RemoveHeaderEntry(AValue, 'charset', LCharSet, QuoteHTTP); {do not localize}

    {RLebeau: the ContentType property is streamed after the CharSet property,
    so do not overwrite it during streaming}
    LComp := OwnerComponent;
    if Assigned(LComp) and (csReading in LComp.ComponentState) then begin
      Exit;
    end;

    // RLebeau: per RFC 2616 Section 3.7.1:
    //
    // The "charset" parameter is used with some media types to define the
    // character set (section 3.4) of the data. When no explicit charset
    // parameter is provided by the sender, media subtypes of the "text"
    // type are defined to have a default charset value of "ISO-8859-1" when
    // received via HTTP. Data in character sets other than "ISO-8859-1" or
    // its subsets MUST be labeled with an appropriate charset value. See
    // section 3.4.1 for compatibility problems.

    // RLebeau: per RFC 3023 Sections 3.1, 3.3, 3.6, and 8.5:
    //
    // Conformant with [RFC2046], if a text/xml entity is received with
    // the charset parameter omitted, MIME processors and XML processors
    // MUST use the default charset value of "us-ascii"[ASCII].  In cases
    // where the XML MIME entity is transmitted via HTTP, the default
    // charset value is still "us-ascii".  (Note: There is an
    // inconsistency between this specification and HTTP/1.1, which uses
    // ISO-8859-1[ISO8859] as the default for a historical reason.  Since
    // XML is a new format, a new default should be chosen for better
    // I18N.  US-ASCII was chosen, since it is the intersection of UTF-8
    // and ISO-8859-1 and since it is already used by MIME.)
    //
    // ...
    //
    // The charset parameter of text/xml-external-parsed-entity is
    // handled the same as that of text/xml as described in Section 3.1
    //
    // ...
    //
    // The following list applies to text/xml, text/xml-external-parsed-
    // entity, and XML-based media types under the top-level type "text"
    // that define the charset parameter according to this specification:
    //
    // - If the charset parameter is not specified, the default is "us-
    //   ascii".  The default of "iso-8859-1" in HTTP is explicitly
    //   overridden.
    //
    // ...
    //
    // Omitting the charset parameter is NOT RECOMMENDED for text/xml.  For
    // example, even if the contents of the XML MIME entity are UTF-16 or
    // UTF-8, or the XML MIME entity has an explicit encoding declaration,
    // XML and MIME processors MUST assume the charset is "us-ascii".

    if (LCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
      S := ExtractHeaderMediaSubType(FContentType);
      if (PosInStrArray(S, ['xml', 'xml-external-parsed-entity'], False) >= 0) or TextEndsWith(S, '+xml') then begin {do not localize}
        LCharSet := 'us-ascii'; {do not localize}
      end else begin
        LCharSet := 'ISO-8859-1'; {do not localize}
      end;
    end;

    {RLebeau: override the current CharSet only if the header specifies a new value}
    if LCharSet <> '' then begin
      FCharSet := LCharSet;
    end;
  end else begin
    FContentType := '';
    FCharSet := '';
  end;
end;

function TIdEntityHeaderInfo.GetHasContentRange: Boolean;
begin
  Result := (FContentRangeEnd >= 0);
end;

function TIdEntityHeaderInfo.GetHasContentRangeInstance: Boolean;
begin
  Result := (FContentRangeInstanceLength >= 0);
end;

function TIdEntityHeaderInfo.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

type
  TPersistentAccess = class(TPersistent)
  end;

function TIdEntityHeaderInfo.GetOwnerComponent: TComponent;
var
  // under ARC, convert a weak reference to a strong reference before working with it
  LOwner: TPersistent;
begin
  Result := nil;
  LOwner := GetOwner;
  while LOwner <> nil do begin
    if LOwner is TComponent then begin
      Result := TComponent(LOwner);
      Exit;
    end;
    LOwner := TPersistentAccess(LOwner).GetOwner;
  end;
end;

{ TIdProxyConnectionInfo }

constructor TIdProxyConnectionInfo.Create;
begin
  inherited Create;
end;

procedure TIdProxyConnectionInfo.AfterConstruction;
begin
  inherited AfterConstruction;
  Clear;
end;

destructor TIdProxyConnectionInfo.Destroy;
begin
  FreeAndNil(FAuthentication);
  inherited Destroy;
end;

procedure TIdProxyConnectionInfo.AssignTo(Destination: TPersistent);
var
  LDest: TIdProxyConnectionInfo;
begin
  if Destination is TIdProxyConnectionInfo then
  begin
    LDest := TIdProxyConnectionInfo(Destination);
    LDest.FPassword := FPassword;
    LDest.FPort := FPort;
    LDest.FServer := FServer;
    LDest.FUsername := FUsername;
    LDest.FBasicByDefault := FBasicByDefault;
  end else
  begin
    inherited AssignTo(Destination);
  end;
end;

procedure TIdProxyConnectionInfo.Clear;
begin
  FServer := '';
  FUsername := '';
  FPassword := '';
  FPort := 0;
end;

procedure TIdProxyConnectionInfo.SetHeaders(Headers: TIdHeaderList);
var
  S: String;
begin
  if Assigned(Authentication) then begin
    S := Authentication.Authentication;
  end
  // Use Basic authentication by default
  else if FBasicByDefault then begin
    FAuthentication := TIdBasicAuthentication.Create;
    // TODO: use FAuthentication Username/Password properties instead
    FAuthentication.Params.Values['Username'] := FUsername;  {do not localize}
    FAuthentication.Params.Values['Password'] := FPassword;  {do not localize}
    S := FAuthentication.Authentication;
  end else begin
    S := '';
  end;
  if Length(S) > 0 then begin
    Headers.Values['Proxy-Authorization'] := S;             {do not localize}
  end;
end;

procedure TIdProxyConnectionInfo.SetProxyPort(const Value: Integer);
begin
  if Value <> FPort then
  begin
    FreeAndNil(FAuthentication);
  end;
  FPort := Value;
end;

procedure TIdProxyConnectionInfo.SetProxyServer(const Value: string);
begin
  if not TextIsSame(Value, FServer) then
  begin
    FreeAndNil(FAuthentication);
  end;
  FServer := Value;
end;

{ TIdEntityRange }

constructor TIdEntityRange.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FStartPos := -1;
  FEndPos := -1;
  FSuffixLength := -1;
end;

function TIdEntityRange.GetText: String;
begin
  if (FStartPos >= 0) or (FEndPos >= 0) then
  begin
    if FEndPos >= 0 then
    begin
      Result := IntToStr(FStartPos) + '-' + IntToStr(FEndPos);  {do not localize}
    end else begin
      Result := IntToStr(FStartPos) + '-'; {do not localize}
    end;
  end
  else if FSuffixLength >= 0 then begin
    Result := '-' + IntToStr(FSuffixLength);
  end
  else begin
    Result := '';
  end;
end;

procedure TIdEntityRange.SetText(const AValue: String);
var
  LValue, S: String;
begin
  LValue := Trim(AValue);
  if LValue <> '' then
  begin
    S := Fetch(LValue, '-'); {do not localize}
    if S <> '' then begin
      FStartPos := StrToInt64Def(S, -1);
      FEndPos := StrToInt64Def(Fetch(LValue), -1);
      FSuffixLength := -1;
    end else begin
      FStartPos := -1;
      FEndPos := -1;
      FSuffixLength := StrToInt64Def(Fetch(LValue), -1);
    end;
  end else begin
    FStartPos := -1;
    FEndPos := -1;
    FSuffixLength := -1;
  end;
end;

{ TIdEntityRanges }

constructor TIdEntityRanges.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TIdEntityRange);
  FUnits := 'bytes'; {do not localize}
end;

function TIdEntityRanges.Add: TIdEntityRange;
begin
  Result := TIdEntityRange(inherited Add);
end;

function TIdEntityRanges.GetRange(Index: Integer): TIdEntityRange;
begin
  Result := TIdEntityRange(inherited GetItem(Index));
end;

procedure TIdEntityRanges.SetRange(Index: Integer; AValue: TIdEntityRange);
begin
  inherited SetItem(Index, AValue);
end;

function TIdEntityRanges.GetText: String;
var
  I: Integer;
  S: String;
begin
  Result := '';
  for I := 0 to Count-1 do begin
    S := Ranges[I].Text;
    if S <> '' then begin
      if Result <> '' then begin
        Result := Result + ','; {do not localize}
      end;
      Result := Result + S;
    end;
  end;
  if Result <> '' then begin
    Result := FUnits + '=' + Result; {do not localize}
  end;
end;

procedure TIdEntityRanges.SetText(const AValue: String);
var
  LUnits, LTmp: String;
  LRanges: TStringList;
  I: Integer;
  LRange: TIdEntityRange;
begin
  LTmp := Trim(AValue);
  BeginUpdate;
  try
    Clear;
    if Pos('=', LTmp) > 0 then begin {do not localize}
      LUnits := Fetch(LTmp, '='); {do not localize}
    end;
    SetUnits(LUnits);
    LRanges := TStringList.Create;
    try
      SplitDelimitedString(LTmp, LRanges, True, ','); {do not localize}
      for I := 0 to LRanges.Count-1 do begin
        LTmp := Trim(LRanges[I]);
        if LTmp <> '' then begin
          LRange := Add;
          try
            LRange.Text := LTmp;
          except
            LRange.Free;
            raise;
          end;
        end;
      end;
    finally
      LRanges.Free;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TIdEntityRanges.SetUnits(const AValue: String);
var
  LUnits: String;
begin
  LUnits := Trim(AValue);
  if LUnits <> '' then begin
    FUnits := LUnits;
  end else begin
    FUnits := 'bytes'; {do not localize}
  end;
end;

{ TIdRequestHeaderInfo }

constructor TIdRequestHeaderInfo.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FRanges := TIdEntityRanges.Create(Self);
end;

destructor TIdRequestHeaderInfo.Destroy;
begin
  FreeAndNil(FAuthentication);
  FreeAndNil(FRanges);
  inherited Destroy;
end;

procedure TIdRequestHeaderInfo.ProcessHeaders;
begin
  inherited ProcessHeaders;

  FAccept := FRawHeaders.Values['Accept'];                    {do not localize}
  FAcceptCharSet := FRawHeaders.Values['Accept-Charset'];     {do not localize}
  FAcceptEncoding := FRawHeaders.Values['Accept-Encoding'];   {do not localize}
  FAcceptLanguage := FRawHeaders.Values['Accept-Language'];   {do not localize}
  FHost := FRawHeaders.Values['Host'];                        {do not localize}
  FFrom := FRawHeaders.Values['From'];                        {do not localize}
  FReferer := FRawHeaders.Values['Referer'];                  {do not localize}
  FUserAgent := FRawHeaders.Values['User-Agent'];             {do not localize}
  FRanges.Text := FRawHeaders.Values['Range'];                {do not localize}
  FMethodOverride := FRawHeaders.Values['X-HTTP-Method-Override']; {do not localize}
end;

procedure TIdRequestHeaderInfo.AssignTo(Destination: TPersistent);
var
  LDest: TIdRequestHeaderInfo;
begin
  if Destination is TIdRequestHeaderInfo then
  begin
    LDest := TIdRequestHeaderInfo(Destination);
    LDest.FAccept := FAccept;
    LDest.FAcceptCharSet := FAcceptCharset;
    LDest.FAcceptEncoding := FAcceptEncoding;
    LDest.FAcceptLanguage := FAcceptLanguage;

    LDest.FFrom := FFrom;
    LDest.FUsername := FUsername;
    LDest.FPassword := FPassword;
    LDest.FReferer := FReferer;
    LDest.FUserAgent := FUserAgent;
    LDest.FBasicByDefault := FBasicByDefault;

    LDest.FRanges.Assign(FRanges);
    LDest.FMethodOverride := FMethodOverride;

    // TODO: omitted intentionally?
    // LDest.FHost := FHost;
    // LDest.FProxyConnection := FProxyConnection;
  end;

  inherited AssignTo(Destination);
end;

procedure TIdRequestHeaderInfo.Clear;
begin
  FAccept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'; // 'text/html, */*'; {do not localize}
  FAcceptCharSet := '';
  FUserAgent := GIdDefaultUserAgent;
  FBasicByDefault := false;
  FRanges.Text := '';
  FMethodOverride := '';

  // TODO: omitted intentionally?
  // FAcceptEncoding := '';
  // FAcceptLanguage := '';
  // FHost := '';
  // FFrom := '';
  // FPassword := '';
  // FUsername := '';
  // FReferer := '';
  // FProxyConnection := '';

  inherited Clear;
end;

function TIdRequestHeaderInfo.GetRange: String;
begin
  Result := FRanges.Text;
end;

procedure TIdRequestHeaderInfo.SetRange(const AValue: String);
begin
  FRanges.Text := AValue;
end;

procedure TIdRequestHeaderInfo.SetRanges(AValue: TIdEntityRanges);
begin
  FRanges.Assign(AValue);
end;

procedure TIdRequestHeaderInfo.SetHeaders;
var
  S: String;
begin
  inherited SetHeaders;

  if Length(FProxyConnection) > 0 then
  begin
    FRawHeaders.Values['Proxy-Connection'] := FProxyConnection; {do not localize}
  end;
  if Length(FHost) > 0 then
  begin
    FRawHeaders.Values['Host'] := FHost; {do not localize}
  end;
  if Length(FAccept) > 0 then
  begin
    FRawHeaders.Values['Accept'] := FAccept; {do not localize}
  end;
  if Length(FAcceptCharset) > 0 then
  begin
    FRawHeaders.Values['Accept-Charset'] := FAcceptCharSet;   {do not localize}
  end;
  if Length(FAcceptEncoding) > 0 then
  begin
    FRawHeaders.Values['Accept-Encoding'] := FAcceptEncoding; {do not localize}
  end;
  if Length(FAcceptLanguage) > 0 then
  begin
    FRawHeaders.Values['Accept-Language'] := FAcceptLanguage; {do not localize}
  end;
  if Length(FFrom) > 0 then
  begin
    FRawHeaders.Values['From'] := FFrom;                      {do not localize}
  end;
  if Length(FReferer) > 0 then
  begin
    FRawHeaders.Values['Referer'] := FReferer;                {do not localize}
  end;
  if Length(FUserAgent) > 0 then
  begin
    FRawHeaders.Values['User-Agent'] := FUserAgent;           {do not localize}
  end;
  S := FRanges.Text;
  if Length(S) > 0 then
  begin
    FRawHeaders.Values['Range'] := S; {do not localize}
  end;

  // use 'Last-Modified' entity header in the conditional request
  if FLastModified > 0 then
  begin
    FRawHeaders.Values['If-Modified-Since'] := LocalDateTimeToHttpStr(FLastModified); {do not localize}
  end;

  if Assigned(Authentication) then
  begin
    S := Authentication.Authentication;
  end
  else if FBasicByDefault then begin
    FAuthentication := TIdBasicAuthentication.Create;
    // TODO: use FAuthentication Username/Password properties instead
    FAuthentication.Params.Values['Username'] := FUserName;  {do not localize}
    FAuthentication.Params.Values['Password'] := FPassword;  {do not localize}
    S := FAuthentication.Authentication;
  end else begin
    S := '';
  end;
  if Length(S) > 0 then
  begin
    FRawHeaders.Values['Authorization'] := S;                 {do not localize}
  end;

  if Length(FMethodOverride) > 0 then
  begin
    FRawHeaders.Values['X-HTTP-Method-Override'] := FMethodOverride; {Do not Localize}
  end;
end;

{ TIdResponseHeaderInfo }

constructor TIdResponseHeaderInfo.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  // RLebeau 5/15/2012: don't set any default ContentType, make the user set it...
  FContentType := '';
  FCharSet := '';
  FWWWAuthenticate := TIdHeaderList.Create(QuoteHTTP);
  FProxyAuthenticate := TIdHeaderList.Create(QuoteHTTP);
  FAcceptPatch := '';
  FAcceptRanges := '';
end;

destructor TIdResponseHeaderInfo.Destroy;
begin
  FreeAndNil(FWWWAuthenticate);
  FreeAndNil(FProxyAuthenticate);
  inherited Destroy;
end;

procedure TIdResponseHeaderInfo.SetProxyAuthenticate(const Value: TIdHeaderList);
begin
  FProxyAuthenticate.Assign(Value);
end;

procedure TIdResponseHeaderInfo.SetWWWAuthenticate(const Value: TIdHeaderList);
begin
  FWWWAuthenticate.Assign(Value);
end;

procedure TIdResponseHeaderInfo.ProcessHeaders;
begin
  inherited ProcessHeaders;
  FLocation := FRawHeaders.Values['Location'];                  {do not localize}
  FServer := FRawHeaders.Values['Server'];                      {do not localize}
  FProxyConnection := FRawHeaders.Values['Proxy-Connection'];   {do not localize}

  FWWWAuthenticate.Clear;
  FRawHeaders.Extract('WWW-Authenticate', FWWWAuthenticate);    {do not localize}

  FProxyAuthenticate.Clear;
  FRawHeaders.Extract('Proxy-Authenticate', FProxyAuthenticate);{do not localize}

  FAcceptPatch := FRawHeaders.Values['Accept-Patch'];           {do not localize}
  FAcceptRanges := FRawHeaders.Values['Accept-Ranges'];         {do not localize}
end;

procedure TIdResponseHeaderInfo.SetHeaders;
var
  sUnits: String;
  sCR: String;
  sCI: String;
begin
  inherited SetHeaders;

  {
    setting the content-range header is allowed in server responses...
    moved here TIdEntityHeaderInfo
  }
  if HasContentRange or HasContentRangeInstance then
  begin
    sUnits := iif(FContentRangeUnits <> '',
      FContentRangeUnits, 'bytes'); {do not localize}
    sCR := iif(HasContentRange,
      IndyFormat('%d-%d', [FContentRangeStart, FContentRangeEnd]), '*'); {do not localize}
    sCI := iif(HasContentRangeInstance,
      IndyFormat('%d', [FContentRangeInstanceLength]), '*'); {do not localize}

    RawHeaders.Values['Content-Range'] := sUnits + ' ' + sCR + '/' + sCI; {do not localize}
  end;
  if Length(FAcceptPatch) > 0 then
  begin
    RawHeaders.Values['Accept-Patch'] := FAcceptPatch; {do not localize}
  end;
  if Length(FAcceptRanges) > 0 then
  begin
    RawHeaders.Values['Accept-Ranges'] := FAcceptRanges; {do not localize}
  end;
  if FLastModified > 0 then
  begin
    RawHeaders.Values['Last-Modified'] := DateTimeGMTToHttpStr(FLastModified); {do not localize}
  end;
end;

procedure TIdResponseHeaderInfo.Clear;
begin
  inherited Clear;

  // RLebeau 5/15/2012: don't set any default ContentType, make the user set it...
  FContentType := '';
  FCharSet := '';

  FLocation := '';
  FServer := '';
  FAcceptPatch := '';
  FAcceptRanges := '';

  if Assigned(FProxyAuthenticate) then
  begin
    FProxyAuthenticate.Clear;
  end;

  if Assigned(FWWWAuthenticate) then
  begin
    FWWWAuthenticate.Clear;
  end;
end;

procedure TIdResponseHeaderInfo.SetAcceptPatch(const Value: string);
begin
  FAcceptPatch := Value;
end;

procedure TIdResponseHeaderInfo.SetAcceptRanges(const Value: string);
begin
  FAcceptRanges := Value;
end;

{ TIdMetaHTTPEquiv }

procedure TIdMetaHTTPEquiv.ProcessMetaHTTPEquiv(AStream: TStream);
var
  LCharSet: string;
begin
  ParseMetaHTTPEquiv(AStream, RawHeaders, LCharSet);
  if FRawHeaders.Count > 0 then begin
    ProcessHeaders;
  end;
  if LCharSet <> '' then begin
    FCharSet := LCharset;
  end;
end;

end.