{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Implementation of the HTTP protocol.         | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2012 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

{.$DEFINE TLS_SUPPORT} // <- Define this to have SSL/TLS support and NTLM authentication.

{.$DEFINE HTTP_ZIP_SUPPORT} // <- Define this to have deflate/gzip support for HTTP transfer-encoding.


{
  Proxy:
  ======
  
  305 Use Proxy => should be for only a single request!
  
  Handle 407 proxy authentication required (Proxy-Authenticate, Proxy-Authorization)

  In case of 204 (No Conent), HEAD and successful CONNECT requests => limit to content length 0!
  
  ToDo:
  =====
  - Chunked Stream trailers: Dont add headers that are not allowed as trailers (content-Length, Transfer-Encoding, Trailers)
}


{$DEFINE DELAY_LOAD_WIN_DLLs}

unit GMHttp;

interface

uses {$IFDEF JEDIAPI}jwaWinType,{$ELSE}Windows,{$ENDIF}
     GMActiveX, GMStrDef, GMCollections, GMIntf, GMCommon, GMINetBase, GMSockets
     {$IFDEF HTTP_ZIP_SUPPORT}, GMZStrm{$ENDIF}
     {$IFDEF TLS_SUPPORT},GMNtlm{$ENDIF}
     ;

const

  scStrHttp = 'HTTP';
  scStrHttps = 'HTTPS';
  scDfltHttpPort = '80';
  scDfltHttpsPort = '443';
  scHttpDirSeparator = '/';
  scGMHttpAgent = 'GM-Http'; // 'GM-Http/1.0'

  FACILITY_GM_HTTP = 2012;

  cDfltHttpErrorCode = 0;

  HTTP_STATUS_CONTINUE            = 100; // OK to continue with request
  HTTP_STATUS_SWITCH_PROTOCOLS    = 101; // server has switched protocols in upgrade header
  HTTP_STATUS_PROCESSING          = 102;

  HTTP_STATUS_OK                  = 200; // request completed
  HTTP_STATUS_CREATED             = 201; // object created, reason = new URI
  HTTP_STATUS_ACCEPTED            = 202; // async completion (TBS)
  HTTP_STATUS_PARTIAL             = 203; // partial completion
  HTTP_STATUS_NO_CONTENT          = 204; // no info to return
  HTTP_STATUS_RESET_CONTENT       = 205; // request completed, but clear form
  HTTP_STATUS_PARTIAL_CONTENT     = 206; // partial GET furfilled
  HTTP_MULTI_STATUS               = 207;

  HTTP_STATUS_AMBIGUOUS           = 300; // server couldn't decide what to return
  HTTP_STATUS_MOVED               = 301; // object permanently moved
  HTTP_STATUS_REDIRECT            = 302; // object temporarily moved
  HTTP_STATUS_REDIRECT_METHOD     = 303; // redirection w/ new access method
  HTTP_STATUS_NOT_MODIFIED        = 304; // if-modified-since was not modified
  HTTP_STATUS_USE_PROXY           = 305; // redirection to proxy, location header specifies proxy to use
  HTTP_STATUS_REDIRECT_KEEP_VERB  = 307; // HTTP/1.1: keep same verb

  HTTP_STATUS_BAD_REQUEST         = 400; // invalid syntax
  HTTP_STATUS_DENIED              = 401; // access denied
  HTTP_STATUS_PAYMENT_REQ         = 402; // payment required
  HTTP_STATUS_FORBIDDEN           = 403; // request forbidden
  HTTP_STATUS_NOT_FOUND           = 404; // object not found
  HTTP_STATUS_BAD_METHOD          = 405; // method is not allowed
  HTTP_STATUS_NONE_ACCEPTABLE     = 406; // no response acceptable to client found
  HTTP_STATUS_PROXY_AUTH_REQ      = 407; // proxy authentication required
  HTTP_STATUS_REQUEST_TIMEOUT     = 408; // server timed out waiting for request
  HTTP_STATUS_CONFLICT            = 409; // user should resubmit with more info
  HTTP_STATUS_GONE                = 410; // the resource is no longer available
  HTTP_STATUS_LENGTH_REQUIRED     = 411; // the server refused to accept request w/o a length
  HTTP_STATUS_PRECOND_FAILED      = 412; // precondition given in request failed
  HTTP_STATUS_REQUEST_TOO_LARGE   = 413; // request entity was too large
  HTTP_STATUS_URI_TOO_LONG        = 414; // request URI too long
  HTTP_STATUS_UNSUPPORTED_MEDIA   = 415; // unsupported media type
  HTTP_STATUS_UNPROCESSABLE_ENTITY = 422;
  HTTP_STATUS_LOCKED              = 423;
  HTTP_STATUS_FAILED_DEPENDENCY   = 424;
  HTTP_STATUS_RETRY_WITH          = 449; // retry after doing the appropriate action.

  HTTP_STATUS_SERVER_ERROR        = 500; // internal server error
  HTTP_STATUS_NOT_SUPPORTED       = 501; // required not supported
  HTTP_STATUS_BAD_GATEWAY         = 502; // error response received from gateway
  HTTP_STATUS_SERVICE_UNAVAIL     = 503; // temporarily overloaded
  HTTP_STATUS_GATEWAY_TIMEOUT     = 504; // timed out waiting for gateway
  HTTP_STATUS_VERSION_NOT_SUP     = 505; // HTTP version not supported
  HTTP_STATUS_INSUFFICIENT_STORAGE = 507;

  
  cHttpStatusCodes: array [0..44] of LongInt = (
    HTTP_STATUS_CONTINUE,
    HTTP_STATUS_SWITCH_PROTOCOLS,
    HTTP_STATUS_PROCESSING,

    HTTP_STATUS_OK,
    HTTP_STATUS_CREATED,
    HTTP_STATUS_ACCEPTED,
    HTTP_STATUS_PARTIAL,
    HTTP_STATUS_NO_CONTENT,
    HTTP_STATUS_RESET_CONTENT,
    HTTP_STATUS_PARTIAL_CONTENT,
    HTTP_MULTI_STATUS,

    HTTP_STATUS_AMBIGUOUS,
    HTTP_STATUS_MOVED,
    HTTP_STATUS_REDIRECT,
    HTTP_STATUS_REDIRECT_METHOD,
    HTTP_STATUS_NOT_MODIFIED,
    HTTP_STATUS_USE_PROXY,
    HTTP_STATUS_REDIRECT_KEEP_VERB,

    HTTP_STATUS_BAD_REQUEST,
    HTTP_STATUS_DENIED,
    HTTP_STATUS_PAYMENT_REQ,
    HTTP_STATUS_FORBIDDEN,
    HTTP_STATUS_NOT_FOUND,
    HTTP_STATUS_BAD_METHOD,
    HTTP_STATUS_NONE_ACCEPTABLE,
    HTTP_STATUS_PROXY_AUTH_REQ,
    HTTP_STATUS_REQUEST_TIMEOUT,
    HTTP_STATUS_CONFLICT,
    HTTP_STATUS_GONE,
    HTTP_STATUS_LENGTH_REQUIRED,
    HTTP_STATUS_PRECOND_FAILED,
    HTTP_STATUS_REQUEST_TOO_LARGE,
    HTTP_STATUS_URI_TOO_LONG,
    HTTP_STATUS_UNSUPPORTED_MEDIA,
    HTTP_STATUS_UNPROCESSABLE_ENTITY,
    HTTP_STATUS_LOCKED,
    HTTP_STATUS_FAILED_DEPENDENCY,
    HTTP_STATUS_RETRY_WITH,

    HTTP_STATUS_SERVER_ERROR,
    HTTP_STATUS_NOT_SUPPORTED,
    HTTP_STATUS_BAD_GATEWAY,
    HTTP_STATUS_SERVICE_UNAVAIL,
    HTTP_STATUS_GATEWAY_TIMEOUT,
    HTTP_STATUS_VERSION_NOT_SUP,
    HTTP_STATUS_INSUFFICIENT_STORAGE
  );


  cHttpContentLength = 'Content-Length';
  cHttpContentType = 'Content-Type';
  cHttpContentEncoding = 'Content-Encoding';
  cHttpWwwAuthenticate = 'WWW-Authenticate';
  cHttpProxyAuthenticate = 'Proxy-Authenticate';
  cHttpAuthorization = 'Authorization';
  cHttpProxyAuthorization = 'Proxy-Authorization';
  cHttpConnection = 'Connection';
  cHttpKeepAlive = 'keep-alive';
  cHttpClose = 'close';
  cStrHttpLocation = 'Location';
  cHttpAuthBasic = 'Basic';
  cHttpAuthNTLM = 'NTLM';
  cHttpTransferEncoding = 'Transfer-Encoding';
  cHttpChunked = 'chunked';
  cHttpTrailers = 'trailers';
  cHttpTE = 'TE';
  cHttpDeflate = 'deflate';
  cHttpGZip = 'gzip';
  cHttpUserAgent = 'User-Agent';

  cHttpContentText = 'text';

  cMimeMultiPart = 'multipart';
  cMimeFormData = 'form-data';

  cHttpMethodHEAD = 'HEAD';
  cHttpMethodGET = 'GET';
  cHttpMethodPUT = 'PUT';
  cHttpMethodPOST = 'POST';
  cHttpMethodOPTIONS = 'OPTIONS';
  cHttpMethodCONNECT = 'CONNECT';

  cAuthenticateHeaderName: array [Boolean] of TGMString = (cHttpWwwAuthenticate, cHttpProxyAuthenticate);


type

  PGMHttpLoginData = ^RGMHttpLoginData;
  RGMHttpLoginData = record
    UserName: PGMChar;
    Password: PGMChar;
  end;

  IGMGetHttpLoginData = interface(IUnknown)
    ['{31F3BFD4-7506-4CEB-9649-EAC7CCB63C3E}']
    function GetHttpLoginData(LoginData: PGMHttpLoginData): HResult; stdcall;
  end;


  TGMHttpRequestBase = class(TGMINetProtocolBase)
   protected
    FUsingTlsLayer: Boolean;

   public
    //function IschunkedTransfer(const AHeaders: IGMIntfCollection): Boolean;
    function ProtocolDisplayName: TGMString; override;
  end;


  TGMHttpClientRequest = class;

  IGMHttpClientRequest = interface(IUnknown)
    ['{DE9A0788-0F95-4320-A46A-DE630760EB96}']
    function Obj: TGMHttpClientRequest;
  end;


  RGMRequestResult = record
    Request: IGMHttpClientRequest;
    ResponseContent: ISequentialStream;
    HttpStatusCode: LongInt;
  end;


  RGMResponseHttpStaus = record
   HttpVersion: TGMString;
   StatusCode: Integer;
   ReasonText: TGMSTring;
  end;

  TGMHttpClientRequest = class(TGMHttpRequestBase, IGMHttpClientRequest)
   protected
    FAgentName: TGMString;
    FKeepConnection: Boolean;
    FKeepConnectionTimeout: LongInt;

    function BuildErrorMsgPostfixFromResponseContent(const AResponseContent: ISequentialStream): TGMString; override;
    function BuildDecodeStreamChain(const ATransportLayer: ISequentialStream): ISequentialStream;
    procedure AddStandardHeaders;
    //procedure CheckResponseStatus(const AResponseStatus: RGMResponseHttpStaus; const AResponseContent: ISequentialStream);
    function InternalExecute(const ATransportLayer: ISequentialStream; const AUseProxy: Boolean; const AMethod: TGMString;
                             const AUri: RGMUriComponents; const ARequestContent: ISequentialStream; const AAdditionalHeaders: TGMNameAndStrValArray;
                             const AOnUploadProgressProc: TGMOnProgressProc; const AUploadBuffersize: LongInt;
                             const AUsingTlsLayer: Boolean): RGMRequestResult;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor Create(const AAgentName: TGMString = scGMHttpAgent; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function Obj: TGMHttpClientRequest;
    function ReceiveHeaders(const ATransportLayer: ISequentialStream; const AHeaders: IGMIntfCollection): TGMString; override;
  end;


  IGMHttpClientAuthenticationHandler = interface(IUnknown)
    ['{EACDD940-D911-45AC-B3A3-FCCE0287C13E}']
    procedure AddAuthorizationHeader(const AHeaders: IGMIntfCollection);
    function AuthSchemeName: TGMString;
    procedure OnTransportLayerDisconnected;
    function ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARetryCount: Integer; const AAskLoginData: IUnknown): Boolean;
    function GetClassType: TClass;
  end;

  TGMHttpClientAuthenticationHandlerBase = class(TGMRefCountedObj, IGMHttpClientAuthenticationHandler)
   protected
    FUseProxy: Boolean;
    FUserName, FPassword, FLastUserName, FLastPassword: TGMString;

    function AuthorizationHeaderName: TGMString;

   public
    constructor Create(const AUseProxy: Boolean; const AUserName, APassword: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    procedure AddAuthorizationHeader(const AHeaders: IGMIntfCollection); virtual;
    function AuthSchemeName: TGMString; virtual; abstract;
    function ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARetryCount: Integer; const AAskLoginData: IUnknown): Boolean; virtual;
    procedure OnTransportLayerDisconnected; virtual;
  end;

  TGMHttpClientAuthenticationHandlerClass = class of TGMHttpClientAuthenticationHandlerBase;


  TGMHttpClientBasicAuthenticationHandler = class(TGMHttpClientAuthenticationHandlerBase)
   public
    procedure AddAuthorizationHeader(const AHeaders: IGMIntfCollection); override;
    function AuthSchemeName: TGMString; override;
    function ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARequestRetryCount: Integer; const AAskLoginData: IUnknown): Boolean; override;
  end;


  {$IFDEF TLS_SUPPORT}
  TGMHttpClientNTLMAuthenticationHandler = class(TGMHttpClientAuthenticationHandlerBase)
   protected
    FNTLMAuthSate: Integer;
    FServerResponse: TNTLMServerResponse;

   public
    procedure AddAuthorizationHeader(const AHeaders: IGMIntfCollection); override;
    function AuthSchemeName: TGMString; override;
    function ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARequestRetryCount: Integer; const AAskLoginData: IUnknown): Boolean; override;
    procedure OnTransportLayerDisconnected; override;
  end;
  {$ENDIF}


  IGMHttpClientSession = interface(IUnknown)
    ['{14AC83F8-7042-4BB0-91D3-706698234881}']
    function IsTransportLayerConnected: Boolean;
    //function ConnectTransportLayer(AProtocol, AHost, APort: TGMString): IGMSocketIO;
    function ExecuteRequest(AHttpRequest: IGMHttpClientRequest; AUri, AHttpMethod: TGMString; const ARequestContent: ISequentialStream = nil;
                            const AAdditionalHeaders: TGMNameAndStrValArray = []; const AOnUploadProgressProc: TGMOnProgressProc = nil;
                            const AUploadBuffersize: LongInt = -cDfltUiResponseMS): RGMRequestResult;
  end;



  IGMHttpProxyConfig = interface(IGMUsernameAndPassword)
    ['{BE39DECC-39D1-4815-9017-F2163FA30DAA}']
    procedure LoadSystemProxySettingsOfCurrentUser;

    function GetProxyHostUri: TGMString;
    procedure SetProxyHostUri(const AUri: TGMString);

    function GetProxyBypass: TGMString;
    procedure SetProxyBypass(const ABypass: TGMString);


    function UseProxy(const AUri: TGMString): Boolean;

    property ProxyHostUri: TGMString read GetProxyHostUri write SetProxyHostUri;
    property ProxyBypass: TGMString read GetProxyBypass write SetProxyBypass;
  end;


  TGMHttpProxyConfig = class(TGMRefCountedObj, IGMHttpProxyConfig)
   protected
    FProxyHostUri: TGMString;
    FProxyBypass: TGMString;
    FUsername: TGMString;
    FPassword: TGMString;

   public
    constructor Create(const AProxyHostUri: TGMString; const AProxyBypass: TGMString = '';
                       const AUsername: TGMString = ''; const APassword: TGMString = '';
                       const ARefLifeTime: Boolean = True); reintroduce; overload;

    procedure LoadSystemProxySettingsOfCurrentUser;

    function GetProxyHostUri: TGMString;
    procedure SetProxyHostUri(const AUri: TGMString);

    function GetProxyBypass: TGMString;
    procedure SetProxyBypass(const ABypass: TGMString);

    function GetUsername: TGMString;
    procedure SetUsername(const AUsername: TGMString);

    function GetPassword: TGMString;
    procedure SetPassword(const APassword: TGMString);

    function UseProxy(const AUri: TGMString): Boolean;

    property ProxyHostUri: TGMString read GetProxyHostUri write SetProxyHostUri;
    property ProxyBypass: TGMString read GetProxyBypass write SetProxyBypass;
    property Username: TGMString read GetUsername write SetUsername;
    property Password: TGMString read GetPassword write SetPassword;
  end;


  RConnectTransportLayerResult = record
    TransportLayerConnection: IGMSocketIO;
    UseProxy: Boolean;
  end;


  TGMHttpClientSession = class(TGMRefCountedObj, IGMHttpClientSession)
   protected
    //FProxyServer: RGMUriComponents;
    FProxyConfig: IGMHttpProxyConfig;
    FTargetHost: RGMUriComponents;
    FProxyTunnelHost: RGMUriComponents;

    //FTargetHost: RGMUriComponents;
    FUsingTlsLayer: Boolean;
    //FProtocol, FHost, FPort,
    FUserName, FPassword: TGMString;
    FTransportLayerConnection: IGMSocketIO;
    FCreatingProxyTlsTunnel: Boolean;
    FAskCanceled, FAskLoginData, FCertificateStatusNotifySink: IUnknown;
    FAuthenticationHandler: IGMHttpClientAuthenticationHandler;
    FProxyAuthenticationHandler: IGMHttpClientAuthenticationHandler;
    FCertificateData: AnsiString;

    function UseProxy(const AUri: TGMSTring): Boolean;
    procedure DisconnectTransportLayer;
    procedure CreateAuthentificationHandler(const AHeaders: IGMIntfCollection; var ACurrentHandler: IGMHttpClientAuthenticationHandler; const AUseProxy: Boolean; const AUserName, APassword: TGMString);
    function InternalConnectTransportLayer(const ATargetUri, AProxyUri: RGMUriComponents): IGMSocketIO;

   public
    constructor Create(const AAskCanceled, AAskLoginData, ACertificateStatusNotifySink: IUnknown; const AUserName: TGMString = '';
                       const APassword: TGMString = ''; const AProxyConfig: IGMHttpProxyConfig = nil; const ACertificateData: Ansistring = ''; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
    function IsTransportLayerConnected: Boolean;
    function ConnectTransportLayer(const AUri: TGMString): RConnectTransportLayerResult;
    function ExecuteRequest(AHttpRequest: IGMHttpClientRequest; AUri, AHttpMethod: TGMString; const ARequestContent: ISequentialStream = nil;
                            const AAdditionalHeaders: TGMNameAndStrValArray = []; const AOnUploadProgressProc: TGMOnProgressProc = nil;
                            const AUploadBuffersize: LongInt = -cDfltUiResponseMS): RGMRequestResult;
  end;



  TGMHttpServerRequest = class;

  IGMHttpServerRequest = interface(IUnknown)
    ['{083ABEC1-305C-4CEC-B4CD-3321A0E43FBC}']
    function Obj: TGMHttpServerRequest;
  end;

  IGMProcessServerRequest = interface(IUnknown)
    ['{77245904-4C76-49E2-A7E7-A4A620E9347B}']
    function ProcessRequest(const ARequest: IGMHttpServerRequest; const AMethod, AURL: TGMString): LongInt; stdcall; // const AContentStream: ISequentialStream
    procedure SendResponseContents(const ATransportLayer: ISequentialStream); stdcall;
  end;

  TGMHttpServerRequest = class(TGMHttpRequestBase, IGMHttpServerRequest)
   protected
    procedure AddMinimalResponseHeaders(const AHeaders: IGMIntfCollection);

   public
    procedure ProcessRequest(const ATransportLayer: ISequentialStream; const ARequestProcessor: IUnknown);
    function Obj: TGMHttpServerRequest;
  end;


  IGMHttpContentInfo = interface(IUnknown)
    ['{75BD24C1-B265-488C-9CD6-38FBD23EB587}']
    function ContentType: TGMString;
    function ContentEncoding: TGMString;
    procedure SetContentType(const AContentType: TGMString);
    procedure SetContentEncoding(const AContentEncoding: TGMString);
  end;


  TGMHttpContentInfoImpl = class(TGMRefCountedObj, IGMHttpContentInfo)
   protected
    FContentType, FContentEncoding: TGMString;

   public
    function ContentType: TGMString;
    function ContentEncoding: TGMString;
    procedure SetContentType(const AContentType: TGMString);
    procedure SetContentEncoding(const AContentEncoding: TGMString);
  end;


  TGMHttpSocketStream = class(TGMSocketStream, IGMHttpContentInfo)
   protected
    FHttpContentInfo: IGMHttpContentInfo;
   public
    constructor Create(const ARefLifeTime: Boolean = True); override;
    property HttpContentInfo: IGMHttpContentInfo read FHttpContentInfo implements IGMHttpContentInfo;
  end;


  {$IFDEF HTTP_ZIP_SUPPORT}
  TGMHttpZipDecompressorIStream = class(TGMZipDecompressorIStream, IGMHttpContentInfo)
   protected
    FHttpContentInfo: IGMHttpContentInfo;
   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    property HttpContentInfo: IGMHttpContentInfo read FHttpContentInfo implements IGMHttpContentInfo;
  end;
  {$ENDIF}


  TGMHttpChunkedStream = class(TGMSequentialIStream, IGMHttpContentInfo)
   protected
    FProtocolObj: IGMINetProtocolBase;
    FChainedStream: ISequentialStream;
    FChunkData: AnsiString;
    FChunkReadPos: LongInt;
    FEOS: Boolean;
    FHttpContentInfo: IGMHttpContentInfo;

    procedure ReadChunk; // : Boolean;

    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor CreateRead(const AProtocolObj: IGMINetProtocolBase; const AChainedStream: ISequentialStream; const AMode: DWORD = STGM_READ or STGM_WRITE;
                           const AName: UnicodeString = ''; const ARefLifeTime: Boolean = True); reintroduce; overload;
    property HttpContentInfo: IGMHttpContentInfo read FHttpContentInfo implements IGMHttpContentInfo;
  end;


  EGMHttpException = class(EGMINetException, IGMGetHRCode)
   protected
    FErrorCode: LongInt;
   public
    constructor HttpError(const AHttpStatusCode: LongInt; const AReason: TGMString; const APostFix: TGMString = ''; const ACaller: TObject = nil; const ACallingName: TGMString = '');
    function GetHRCode: HResult; stdcall;
  end;


function GMMakeHttpHResult(const AHttpErrorCode: LongInt): HResult;
function GMExtractHttpCodeFromHResult(const AHResult: HResult; const ADefaultCode: LongInt = 599): LongInt;
//function GMExtractHttpCodeFromHResult(const AHrCode: HResult): LongWord;

function GMExecuteHttpRequest(const AUri: TGMString; const AAskCanceled: IUnknown = nil; const AAskLoginData: IUnknown = nil;
    const AHttpMethod: TGMString = ''; const AUserName: TGMString = ''; const APassword: TGMString = '';
    const AReuestContent: ISequentialStream = nil; const AAdditionalHeaders: TGMNameAndStrValArray = []): RGMRequestResult;

procedure GMParseHttpStartLine(const AStartLine: TGMString; var AToken1, AToken2, AToken3: TGMString);

function GMHttpStatusCodeFromString(const AHttpStatusCode: TGMString): LongInt;
function GMIsHttpSuccessStatus(const AStatusCode: LongInt): Boolean; overload;

function GMBuildHttpErrorMsg(const AHttpStatusCode: LongInt; const AReason: TGMString): TGMString;

function GMHttpStatusMsg(const AHttpStatusCode: LongInt): TGMString;
function GMHttpShortHint(const AHttpStatusCode: LongInt): TGMString;

procedure GMBuildMultiPartFormContent(const AValues: IGMIntfCollection; const ADest: ISequentialStream; const AMultiPartBoundary: AnsiString);

function GMExecHttpPostValues(const AValues: IGMIntfCollection; const AUri: TGMString; const AAskCanceled: IUnknown = nil;
                              const AAskLoginData: IUnknown = nil; const ACertificateData: AnsiString = '';
                              const AUserName: TGMString = ''; const APassword: TGMString = ''): RGMRequestResult;

function GMCharCodingOfContent(const AContent: IUnknown; const ADefaultCharKind: TGMCharKind = ckUnknown): TGMCharKind;

//function GMParseHttpUri(const AUri: TGMString): RGMUriComponents;


function GMParseHttpStatusLine(const AResponseStatusLine: TGMString): RGMResponseHttpStaus;

//procedure AssignHttpDfltPort(var AUriComponents: RGMUriComponents);

//function InternetTimeToSystemTimeA(lpszTime: PAnsiChar; out pst: TSystemTime; dwReserved: DWORD): BOOL; stdcall; external cStrWinINetDLL name 'InternetTimeToSystemTimeA';
//function InternetTimeToSystemTimeW(lpszTime: PWideChar; out pst: TSystemTime; dwReserved: DWORD): BOOL; stdcall; external cStrWinINetDLL name 'InternetTimeToSystemTimeW';



//
// routines from WinHttp.DLL
//

  type
    WINHTTP_CURRENT_USER_IE_PROXY_CONFIG = record
      fAutoDetect: BOOL;
      lpszAutoConfigUrl: LPWSTR;
      lpszProxy: LPWSTR;
      lpszProxyBypass: LPWSTR;
    end;

    PWINHTTP_CURRENT_USER_IE_PROXY_CONFIG = ^WINHTTP_CURRENT_USER_IE_PROXY_CONFIG;
    TWinHttpCurrentUserIEProxyConfig = WINHTTP_CURRENT_USER_IE_PROXY_CONFIG;
    PWinHttpCurrentUserIEProxyConfig = ^TWinHttpCurrentUserIEProxyConfig;

function WinHttpGetIEProxyConfigForCurrentUser(pProxyConfig: PWinHttpCurrentUserIEProxyConfig): BOOL; stdcall;

//function WinHttpGetDefaultProxyConfiguration(var pProxyInfo: TWinHttpProxyInfo): BOOL; stdcall;
//function WinHttpSetDefaultProxyConfiguration(var pProxyInfo: TWinHttpProxyInfo): BOOL; stdcall;


var

  vDfltHttpProtocolVersion: TGMString = '1.1';
  vDfltHttpPort: TGMString = scDfltHttpPort;
//vDfltUserAgent: TGMString = 'GM-Http/1.0';
  vMaxHttpRedirectCount: LongInt = 5;
  vMaxHttpReConnectCount: LongInt = 2;
  vMaxHttpAuthDeniedCount: LongInt = 3;


implementation
                  
uses SysUtils, GMCharCoding
     {$IFDEF TLS_SUPPORT},GMOpenSSL{$ENDIF}
     {$IFDEF JEDIAPI},jwaWinBase{$ENDIF}
     ;


resourcestring

  srServerResponseNotHttp = 'The Server did not respond with the HTTP protocol';
  srUnknownHTTPStatusCodeFmt = 'Unknown HTTP status code (%d)';
  srHTTPStatusErrorFmt = 'HTTP error %d';
//RStrHttpHeaderNotFoundFmt = 'Http header "%s" not found';
  srHttpAuthSchmeNotImplFmt = 'Http authentication scheme(s) [%s] not implemented';
  srNoAuthSchemeProvidedByServer = 'The Server has not provided any "%s" header to tell which authentication scheme it is willing to accept';

//RStrHttpAuthSchemeChangeFmt = 'Http authentication scheme changed from "%s" to "%s"';

  RStr_HTTP_STATUS_CONTINUE = 'The request can be continued';
  RStr_HTTP_STATUS_SWITCH_PROTOCOLS = 'The server has switched protocols in an upgrade header';
  RStr_HTTP_STATUS_OK = 'The request completed successfully';
  RStr_HTTP_STATUS_CREATED = 'The request has been fulfilled and resulted in the creation of a new resource';
  RStr_HTTP_STATUS_ACCEPTED = 'The request has been accepted for processing, but the processing has not been completed';
  RStr_HTTP_STATUS_PARTIAL = 'The returned meta information in the entity-header is not the definitive set available from the origin server';
  RStr_HTTP_STATUS_NO_CONTENT = 'The server has fulfilled the request, but there is no new information to send back';
  RStr_HTTP_STATUS_RESET_CONTENT = 'The request has been completed, and the client program should reset the document view that caused the request to be sent to allow the user to easily initiate another input action';
  RStr_HTTP_STATUS_PARTIAL_CONTENT = 'The server has fulfilled the partial GET request for the resource';
  RStr_HTTP_STATUS_AMBIGUOUS = 'The server couldn''t decide what to return';
  RStr_HTTP_STATUS_MOVED = 'The requested resource has been assigned to a new permanent URI (Uniform Resource Identifier), and any future references to this resource should be done using one of the returned URIs';
  RStr_HTTP_STATUS_REDIRECT = 'The requested resource resides temporarily under a different URI (Uniform Resource Identifier)';
  RStr_HTTP_STATUS_REDIRECT_METHOD = 'The response to the request can be found under a different URI (Uniform Resource Identifier) and should be retrieved using a GET method on that resource';
  RStr_HTTP_STATUS_NOT_MODIFIED = 'The requested resource has not been modified';
  RStr_HTTP_STATUS_USE_PROXY = 'The requested resource must be accessed through the proxy given by the location field';
  RStr_HTTP_STATUS_REDIRECT_KEEP_VERB = 'The redirected request keeps the same verb. HTTP/1.1 behavior';
  RStr_HTTP_STATUS_BAD_REQUEST = 'The request could not be processed by the server due to invalid syntax';
  RStr_HTTP_STATUS_DENIED = 'The requested resource requires user authentication';
  RStr_HTTP_STATUS_PAYMENT_REQ = 'Not currently implemented in the HTTP protocol';
  RStr_HTTP_STATUS_FORBIDDEN = 'The server understood the request, but is refusing to fulfill it';
  RStr_HTTP_STATUS_NOT_FOUND = 'The server has not found anything matching the requested URI (Uniform Resource Identifier)';
  RStr_HTTP_STATUS_BAD_METHOD = 'The method used is not allowed';
  RStr_HTTP_STATUS_NONE_ACCEPTABLE = 'No responses acceptable to the client were found';
  RStr_HTTP_STATUS_PROXY_AUTH_REQ = 'Proxy authentication required';
  RStr_HTTP_STATUS_REQUEST_TIMEOUT = 'The server timed out waiting for the request';
  RStr_HTTP_STATUS_CONFLICT = 'The request could not be completed due to a conflict with the current state of the resource. The user should resubmit with more information';
  RStr_HTTP_STATUS_GONE = 'The requested resource is no longer available at the server, and no forwarding address is known';
  //RStr_HTTP_STATUS_AUTH_REFUSED = 'The server refuses to accept the request without a defined content length';
  RStr_HTTP_STATUS_LENGTH_REQUIRED = 'the server refused to accept request without a length';
  RStr_HTTP_STATUS_PRECOND_FAILED = 'The precondition given in one or more of the request header fields evaluated to false when it was tested on the server';
  RStr_HTTP_STATUS_REQUEST_TOO_LARGE = 'The server is refusing to process a request because the request entity is larger than the server is willing or able to process';
  RStr_HTTP_STATUS_URI_TOO_LONG = 'The server is refusing to service the request because the request URI (Uniform Resource Identifier) is longer than the server is willing to interpret';
  RStr_HTTP_STATUS_UNSUPPORTED_MEDIA = 'The server is refusing to service the request because the entity of the request is in a format not supported by the requested resource for the requested method';
  RStr_HTTP_STATUS_RETRY_WITH = 'The request should be retried after doing the appropriate action';
  RStr_HTTP_STATUS_SERVER_ERROR = 'The server encountered an unexpected condition that prevented it from fulfilling the request';
  RStr_HTTP_STATUS_NOT_SUPPORTED = 'The server does not support the functionality required to fulfill the request';
  RStr_HTTP_STATUS_BAD_GATEWAY = 'The server, while acting as a gateway or proxy, received an invalid response from the upstream server it accessed in attempting to fulfill the request';
  RStr_HTTP_STATUS_SERVICE_UNAVAIL = 'The service is temporarily overloaded';
  RStr_HTTP_STATUS_GATEWAY_TIMEOUT = 'The request was timed out waiting for a gateway';
  RStr_HTTP_STATUS_VERSION_NOT_SUP = 'The server does not support, or refuses to support, the HTTP protocol version that was used in the request message';
  RStr_HTTP_STATUS_PROCESSING = 'Request is still processing';
  RStr_HTTP_MULTI_STATUS = 'Multiple http stati returned';
  RStr_HTTP_STATUS_UNPROCESSABLE_ENTITY = 'The request contains semantically erroneous instructions';
  RStr_HTTP_STATUS_LOCKED = 'The requested resource is locked';
  RStr_HTTP_STATUS_FAILED_DEPENDENCY = 'An operation that this request depends on failed';
  RStr_HTTP_STATUS_INSUFFICIENT_STORAGE = 'Not enough storage';

  srInvalidHttpChunkTerm = 'Invalid http chunk terminator';
  srTheProtocolObj = 'The protocol object';

  srTranspoerLayerNotConnected = 'Network transport layer not connected';
  srTooManyRedirects = 'Too many http redirections: %d';
  srTooManyReconnects = 'Too many http re-connects: %d';
  srNoRedirectionUri = 'Http redirection URI is empty';
  srNoUri = 'No URI specified';
  srUnsupportedDecoding = 'HTTP Transfer-Encoding not supported: "%s"';

  {$IFDEF TLS_SUPPORT}
  srNTLMServerChallengeMsgMissing = 'NTLM server challenge header missing';
  srInvalidNTLMProtocolName = 'Inconsistent NTLM protocol name: "%s"';
  srInvalidNTLMMsgKind = 'Invalid NTLM protocol message kind: %d';
  srInvalidNTLMAuthState = 'Inavlid NTLM authentication state: %d';
  {$ENDIF}


var

  vCSRegisterHttpClientAuthHanlderClasses: IGMCriticalSection = nil;
  vCSRegisterHttpTransferDecoders: IGMCriticalSection = nil;


type

  IGMGetHttpClientAuthSchemeHandlerClass = interface(IUnknown)
    ['{AC34FE4B-187F-4B1B-A800-B0655D3742CB}']
    function GetAuthSchemeHandlerClass: TGMHttpClientAuthenticationHandlerClass;
  end;

  TGMHttpClientAuthSchemeHandlerClassEntry = class(TGMRefCountedObj, IGMGetName, IGMGetPosition, IGMGetHttpClientAuthSchemeHandlerClass)
   protected
    FPosition: PtrInt;
    FAuthSchemeName: TGMString;
    FAuthSchemeHandlerClass: TGMHttpClientAuthenticationHandlerClass;

   public
    constructor Create(const AAuthSchmeName: TGMString; const APosition: PtrInt; const AAuthSchmeHandlerClass: TGMHttpClientAuthenticationHandlerClass; const ARefLifeTime: Boolean = True); reintroduce;
    function GetName: TGMString; stdcall;
    function GetPosition: PtrInt; stdcall;
    function GetAuthSchemeHandlerClass: TGMHttpClientAuthenticationHandlerClass;
  end;


  IGMHttpTransferDecoder = Interface(IUnknown)
    ['{8221BEA2-1CDE-450B-9002-B096E42C4ABA}']
    function CreateDecodeStream(const ARequest: TGMHttpRequestBase; const ASourceStream: ISequentialStream): ISequentialStream;
  end;


  TGMHttpTransferDecoderBase = class(TGMRefCountedObj, IGMGetName, IGMHttpTransferDecoder)
   protected
    FHttpTokenName: TGMString;

   public
    constructor Create(const AHttpTokenName: TGMString; const ARefLifeTime: Boolean = True); reintroduce;
    function GetName: TGMString; stdcall;
    function CreateDecodeStream(const ARequest: TGMHttpRequestBase; const ASourceStream: ISequentialStream): ISequentialStream; virtual; abstract;
  end;


  TGMHttpChunckedTransferDecoder = class(TGMHttpTransferDecoderBase)
   public
    function CreateDecodeStream(const ARequest: TGMHttpRequestBase; const ASourceStream: ISequentialStream): ISequentialStream; override;
  end;


  {$IFDEF HTTP_ZIP_SUPPORT}
  TGMHttpZIPTransferDecoder = class(TGMHttpTransferDecoderBase)
   public
    function CreateDecodeStream(const ARequest: TGMHttpRequestBase; const ASourceStream: ISequentialStream): ISequentialStream; override;
  end;
  {$ENDIF}

var

  vHttpClientAuthHandlerClasses: IGMIntfCollection = nil;
  vHttpTransferDecoders: IGMIntfCollection = nil;


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function RegisterHttpClientAuthHanlderClasses: IGMIntfCollection;
begin
  if vCSRegisterHttpClientAuthHanlderClasses <> nil then vCSRegisterHttpClientAuthHanlderClasses.EnterCriticalSection;
  try
   if vHttpClientAuthHandlerClasses = nil then
    begin
     vHttpClientAuthHandlerClasses := TGMIntfArrayCollection.Create(False, True, GMCompareByName);

     vHttpClientAuthHandlerClasses.Add(TGMHttpClientAuthSchemeHandlerClassEntry.Create(cHttpAuthBasic, 1, TGMHttpClientBasicAuthenticationHandler));
     {$IFDEF TLS_SUPPORT}
     vHttpClientAuthHandlerClasses.Add(TGMHttpClientAuthSchemeHandlerClassEntry.Create(cHttpAuthNTLM, 2, TGMHttpClientNTLMAuthenticationHandler));
     {$ENDIF}
    end;
   Result := vHttpClientAuthHandlerClasses;
  finally
   if vCSRegisterHttpClientAuthHanlderClasses <> nil then vCSRegisterHttpClientAuthHanlderClasses.LeaveCriticalSection;
  end;
end;

function RegisterHttpTransferDecoders: IGMIntfCollection;
begin
  if vCSRegisterHttpTransferDecoders <> nil then vCSRegisterHttpTransferDecoders.EnterCriticalSection;
  try
   if vHttpTransferDecoders = nil then
    begin
     vHttpTransferDecoders := TGMIntfArrayCollection.Create(False, True, GMCompareByName);

     vHttpTransferDecoders.Add(TGMHttpChunckedTransferDecoder.Create(cHttpChunked, True));
     {$IFDEF HTTP_ZIP_SUPPORT}
     vHttpTransferDecoders.Add(TGMHttpZIPTransferDecoder.Create(cHttpDeflate, True));
     vHttpTransferDecoders.Add(TGMHttpZIPTransferDecoder.Create(cHttpGZip, True));
     {$ENDIF}
    end;
   Result := vHttpTransferDecoders;
  finally
   if vCSRegisterHttpTransferDecoders <> nil then vCSRegisterHttpTransferDecoders.LeaveCriticalSection;
  end;
end;

function GMHttpStatusMsg(const AHttpStatusCode: LongInt): TGMString;
begin
  case AHttpStatusCode of
   HTTP_STATUS_CONTINUE: Result := RStr_HTTP_STATUS_CONTINUE;
   HTTP_STATUS_SWITCH_PROTOCOLS: Result := RStr_HTTP_STATUS_SWITCH_PROTOCOLS;
   HTTP_STATUS_OK: Result := RStr_HTTP_STATUS_OK;
   HTTP_STATUS_CREATED: Result := RStr_HTTP_STATUS_CREATED;
   HTTP_STATUS_ACCEPTED: Result := RStr_HTTP_STATUS_ACCEPTED;
   HTTP_STATUS_PARTIAL: Result := RStr_HTTP_STATUS_PARTIAL;
   HTTP_STATUS_NO_CONTENT: Result := RStr_HTTP_STATUS_NO_CONTENT;
   HTTP_STATUS_RESET_CONTENT: Result := RStr_HTTP_STATUS_RESET_CONTENT;
   HTTP_STATUS_PARTIAL_CONTENT: Result := RStr_HTTP_STATUS_PARTIAL_CONTENT;
   HTTP_STATUS_AMBIGUOUS: Result := RStr_HTTP_STATUS_AMBIGUOUS;
   HTTP_STATUS_MOVED: Result := RStr_HTTP_STATUS_MOVED;
   HTTP_STATUS_REDIRECT: Result := RStr_HTTP_STATUS_REDIRECT;
   HTTP_STATUS_REDIRECT_METHOD: Result := RStr_HTTP_STATUS_REDIRECT_METHOD;
   HTTP_STATUS_NOT_MODIFIED: Result := RStr_HTTP_STATUS_NOT_MODIFIED;
   HTTP_STATUS_USE_PROXY: Result := RStr_HTTP_STATUS_USE_PROXY;
   HTTP_STATUS_REDIRECT_KEEP_VERB: Result := RStr_HTTP_STATUS_REDIRECT_KEEP_VERB;
   HTTP_STATUS_BAD_REQUEST: Result := RStr_HTTP_STATUS_BAD_REQUEST;
   HTTP_STATUS_DENIED: Result := RStr_HTTP_STATUS_DENIED;
   HTTP_STATUS_PAYMENT_REQ: Result := RStr_HTTP_STATUS_PAYMENT_REQ;
   HTTP_STATUS_FORBIDDEN: Result := RStr_HTTP_STATUS_FORBIDDEN;
   HTTP_STATUS_NOT_FOUND: Result := RStr_HTTP_STATUS_NOT_FOUND;
   HTTP_STATUS_BAD_METHOD: Result := RStr_HTTP_STATUS_BAD_METHOD;
   HTTP_STATUS_NONE_ACCEPTABLE: Result := RStr_HTTP_STATUS_NONE_ACCEPTABLE;
   HTTP_STATUS_PROXY_AUTH_REQ: Result := RStr_HTTP_STATUS_PROXY_AUTH_REQ;
   HTTP_STATUS_REQUEST_TIMEOUT: Result := RStr_HTTP_STATUS_REQUEST_TIMEOUT;
   HTTP_STATUS_CONFLICT: Result := RStr_HTTP_STATUS_CONFLICT;
   HTTP_STATUS_GONE: Result := RStr_HTTP_STATUS_GONE;
   HTTP_STATUS_LENGTH_REQUIRED: Result := RStr_HTTP_STATUS_LENGTH_REQUIRED;
   HTTP_STATUS_PRECOND_FAILED: Result := RStr_HTTP_STATUS_PRECOND_FAILED;
   HTTP_STATUS_REQUEST_TOO_LARGE: Result := RStr_HTTP_STATUS_REQUEST_TOO_LARGE;
   HTTP_STATUS_URI_TOO_LONG: Result := RStr_HTTP_STATUS_URI_TOO_LONG;
   HTTP_STATUS_UNSUPPORTED_MEDIA: Result := RStr_HTTP_STATUS_UNSUPPORTED_MEDIA;
   HTTP_STATUS_RETRY_WITH: Result := RStr_HTTP_STATUS_RETRY_WITH;
   HTTP_STATUS_SERVER_ERROR: Result := RStr_HTTP_STATUS_SERVER_ERROR;
   HTTP_STATUS_NOT_SUPPORTED: Result := RStr_HTTP_STATUS_NOT_SUPPORTED;
   HTTP_STATUS_BAD_GATEWAY: Result := RStr_HTTP_STATUS_BAD_GATEWAY;
   HTTP_STATUS_SERVICE_UNAVAIL: Result := RStr_HTTP_STATUS_SERVICE_UNAVAIL;
   HTTP_STATUS_GATEWAY_TIMEOUT: Result := RStr_HTTP_STATUS_GATEWAY_TIMEOUT;
   HTTP_STATUS_VERSION_NOT_SUP: Result := RStr_HTTP_STATUS_VERSION_NOT_SUP;
   HTTP_STATUS_PROCESSING: Result := RStr_HTTP_STATUS_PROCESSING;
   HTTP_MULTI_STATUS: Result := RStr_HTTP_MULTI_STATUS;
   HTTP_STATUS_UNPROCESSABLE_ENTITY: Result := RStr_HTTP_STATUS_UNPROCESSABLE_ENTITY;
   HTTP_STATUS_LOCKED: Result := RStr_HTTP_STATUS_LOCKED;
   HTTP_STATUS_FAILED_DEPENDENCY: Result := RStr_HTTP_STATUS_FAILED_DEPENDENCY;
   HTTP_STATUS_INSUFFICIENT_STORAGE: Result := RStr_HTTP_STATUS_INSUFFICIENT_STORAGE;
   else Result := GMFormat(srUnknownHTTPStatusCodeFmt, [AHttpStatusCode]);
  end;
end;

function GMHttpShortHint(const AHttpStatusCode: LongInt): TGMString;
begin
  case AHttpStatusCode of
   HTTP_STATUS_CONTINUE: Result := 'CONTINUE';
   HTTP_STATUS_SWITCH_PROTOCOLS: Result := 'SWITCH PROTOCOLS';
   HTTP_STATUS_OK: Result := 'OK';
   HTTP_STATUS_CREATED: Result := 'CREATED';
   HTTP_STATUS_ACCEPTED: Result := 'ACCEPTED';
   HTTP_STATUS_PARTIAL: Result := 'PARTIAL';
   HTTP_STATUS_NO_CONTENT: Result := 'NO CONTENT';
   HTTP_STATUS_RESET_CONTENT: Result := 'RESET CONTENT';
   HTTP_STATUS_PARTIAL_CONTENT: Result := 'PARTIAL CONTENT';
   HTTP_STATUS_AMBIGUOUS: Result := 'AMBIGUOUS';
   HTTP_STATUS_MOVED: Result := 'MOVED';
   HTTP_STATUS_REDIRECT: Result := 'REDIRECT';
   HTTP_STATUS_REDIRECT_METHOD: Result := 'REDIRECT METHOD';
   HTTP_STATUS_NOT_MODIFIED: Result := 'NOT MODIFIED';
   HTTP_STATUS_USE_PROXY: Result := 'USE PROXY';
   HTTP_STATUS_REDIRECT_KEEP_VERB: Result := 'REDIRECT KEEP VERB';
   HTTP_STATUS_BAD_REQUEST: Result := 'BAD REQUEST';
   HTTP_STATUS_DENIED: Result := 'DENIED';
   HTTP_STATUS_PAYMENT_REQ: Result := 'PAYMENT REQUEST';
   HTTP_STATUS_FORBIDDEN: Result := 'FORBIDDEN';
   HTTP_STATUS_NOT_FOUND: Result := 'NOT FOUND';
   HTTP_STATUS_BAD_METHOD: Result := 'BAD METHOD';
   HTTP_STATUS_NONE_ACCEPTABLE: Result := 'NONE ACCEPTABLE';
   HTTP_STATUS_PROXY_AUTH_REQ: Result := 'PROXY AUTHENTICATION REQUIRED';
   HTTP_STATUS_REQUEST_TIMEOUT: Result := 'REQUEST TIMEOUT';
   HTTP_STATUS_CONFLICT: Result := 'CONFLICT';
   HTTP_STATUS_GONE: Result := 'GONE';
   HTTP_STATUS_LENGTH_REQUIRED: Result := 'LENGTH REQUIRED';
   HTTP_STATUS_PRECOND_FAILED: Result := 'PRECOND FAILED';
   HTTP_STATUS_REQUEST_TOO_LARGE: Result := 'REQUEST TOO LARGE';
   HTTP_STATUS_URI_TOO_LONG: Result := 'URI TOO LONG';
   HTTP_STATUS_UNSUPPORTED_MEDIA: Result := 'UNSUPPORTED MEDIA';
   HTTP_STATUS_RETRY_WITH: Result := 'RETRY WITH';
   HTTP_STATUS_SERVER_ERROR: Result := 'SERVER ERROR';
   HTTP_STATUS_NOT_SUPPORTED: Result := 'NOT SUPPORTED';
   HTTP_STATUS_BAD_GATEWAY: Result := 'BAD GATEWAY';
   HTTP_STATUS_SERVICE_UNAVAIL: Result := 'SERVICE UNAVAILABLE';
   HTTP_STATUS_GATEWAY_TIMEOUT: Result := 'GATEWAY TIMEOUT';
   HTTP_STATUS_VERSION_NOT_SUP: Result := 'VERSION NOT SUPPORTED';
   HTTP_STATUS_PROCESSING: Result := 'PROCESSING';
   HTTP_MULTI_STATUS: Result := 'MULTI STATUS';
   HTTP_STATUS_UNPROCESSABLE_ENTITY: Result := 'UNPROCESSABLE ENTITY';
   HTTP_STATUS_LOCKED: Result := 'LOCKED';
   HTTP_STATUS_FAILED_DEPENDENCY: Result := 'FAILED DEPENDENCY';
   HTTP_STATUS_INSUFFICIENT_STORAGE: Result := 'INSUFFICIENT STORAGE';
   else Result := 'UNKNOWN';
  end;
end;

//function GMParseHttpUri(const AUri: TGMString): RGMUriComponents;
//begin
//  Result := GMParseUri(AUri);
//  //if Length(Result.Port) <= 0 then
//  //  if GMSameText(Result.Scheme, scStrHttps) then Result.Port := scDfltHttpsPort;
//end;

//procedure AssignHttpDfltPort(var AUriComponents: RGMUriComponents);
//begin
//  if Length(AUriComponents.Port) <= 0 then
//    if GMSameText(AUriComponents.Scheme, scStrHttps) then AUriComponents.Port := scDfltHttpsPort;
//end;

function GMMakeHttpHResult(const AHttpErrorCode: LongInt): HResult;
begin
  Result := cCustomHrError or (FACILITY_GM_HTTP shl 16) or AHttpErrorCode;
end;

function GMExtractHttpCodeFromHResult(const AHResult: HResult; const ADefaultCode: LongInt): LongInt;
begin
  if AHResult and LongInt($FFFF0000) = (cCustomHrError or (FACILITY_GM_HTTP shl 16)) then Result := AHResult and $0000FFFF else Result := ADefaultCode;
end;

//function GMExtractHttpCodeFromHResult(const AHrCode: HResult): LongWord;
//begin
//if ((AHrCode and cCustomHrError) <> 0) and (((AHrCode and $07FF0000) shr 16) = FACILITY_GM_HTTP) then
//  Result := AHrCode and $0000FFFF else Result := 0;
//end;

function GMBuildHttpErrorMsg(const AHttpStatusCode: LongInt; const AReason: TGMString): TGMString;
var msg: TGMString;
begin
  msg := GMHttpStatusMsg(AHttpStatusCode);
  if Length(msg) > 0 then
   Result := GMStringJoin(GMStringJoin(GMFormat(srHTTPStatusErrorFmt, [AHttpStatusCode]), ', ', AReason), ', ', msg)
  else
   Result := GMStringJoin(GMFormat(srUnknownHTTPStatusCodeFmt, [AHttpStatusCode]), ': ', AReason);
end;

procedure GMParseHttpStartLine(const AStartLine: TGMString; var AToken1, AToken2, AToken3: TGMString);
var chPos: PtrInt;
begin
  chPos := 1;
  AToken1 := GMNextWord(chPos, AStartLine, cWhiteSpace);
  AToken2 := GMNextWord(chPos, AStartLine, cWhiteSpace);
  AToken3 := Copy(AStartLine, chPos, Length(AStartLine) - chPos + 1);
end;

function GMHttpStatusCodeFromString(const AHttpStatusCode: TGMString): LongInt;
begin
  Result := GMStrToInt(GMMakeDezInt(AHttpStatusCode, cDfltHttpErrorCode));
end;

function GMParseHttpStatusLine(const AResponseStatusLine: TGMString): RGMResponseHttpStaus;
var statusCodeStr: TGMString;
begin
  GMParseHttpStartLine(AResponseStatusLine, Result.HttpVersion, statusCodeStr, Result.ReasonText);
  Result.StatusCode := GMHttpStatusCodeFromString(statusCodeStr);
end;

function GMIsHttpSuccessStatus(const AStatusCode: LongInt): Boolean;
begin
  Result := (AStatusCode >= 200) and (AStatusCode < 300);
end;

function GMExecuteHttpRequest(const AUri: TGMString; const AAskCanceled, AAskLoginData: IUnknown; const AHttpMethod, AUserName, APassword: TGMString; const
    AReuestContent: ISequentialStream; const AAdditionalHeaders: TGMNameAndStrValArray): RGMRequestResult;
var session: IGMHttpClientSession;
begin
  if Length(AUri) <= 0 then raise EGMHttpException.ObjError(srNoUri, nil, 'GMExecuteHttpRequest');
  session := TGMHttpClientSession.Create(AAskCanceled, AAskLoginData, nil, AUserName, APassword);
  //session.ConnectTransportLayer(uriParts.Scheme, uriParts.Host, uriParts.Port);
  //
  // The Session will be destructed by the scope of this routine, but underlying soketIO
  // (FTransportLayerConnection member of the session) is still hold by references inside the streams returned!
  //

                                // GMBuildUri('', '', '', '', '', uriParts.Path, uriParts.Query, uriParts.Fragment)
  Result := session.ExecuteRequest(nil, AUri, AHttpMethod, AReuestContent, AAdditionalHeaders);
end;

procedure GMBuildMultiPartFormContent(const AValues: IGMIntfCollection; const ADest: ISequentialStream; const AMultiPartBoundary: AnsiString);
var it: IGMIterator; unkElement, posKeeper: IUnknown; name: IGMGetName; value: IGMGetStringValue; token: AnsiString;
begin
  if (AValues = nil) or (ADest = nil) then Exit;
  posKeeper := TGMIStreamPosKeeper.Create(ADest);

  it := AValues.CreateIterator;
  while it.NextEntry(unkElement) do
   if GMQueryInterface(unkElement, IGMGetName, name) and GMQueryInterface(unkElement, IGMGetStringValue, value) then
    begin
     token := '--' + AMultiPartBoundary + CRLF;
     GMSafeIStreamWrite(ADest, PAnsiChar(token), Length(token));

     token := 'content-disposition: '+cMimeFormData+'; name="'+name.Name+'"' + CRLF;
     GMSafeIStreamWrite(ADest, PAnsiChar(token), Length(token)); 

     token := 'content-type: text/plain; charset=utf-8' + CRLF;
     GMSafeIStreamWrite(ADest, PAnsiChar(token), Length(token));

     token := 'content-transfer-encoding: binary' + CRLF + CRLF;
     GMSafeIStreamWrite(ADest, PAnsiChar(token), Length(token));

     token := GMStringToUtf8(value.StringValue) + CRLF;
     GMSafeIStreamWrite(ADest, PAnsiChar(token), Length(token));
    end;

   token := '--' + AMultiPartBoundary + '--';
   GMSafeIStreamWrite(ADest, PAnsiChar(token), Length(token));
end;

function GMExecHttpPostValues(const AValues: IGMIntfCollection; const AUri: TGMString; const AAskCanceled: IUnknown;
                              const AAskLoginData: IUnknown; const ACertificateData: AnsiString; const AUserName: TGMString; const APassword: TGMString): RGMRequestResult;
var session: IGMHttpClientSession; requestContent: ISequentialStream; multiPartBoundary: AnsiString;
begin
  if Length(AUri) <= 0 then raise EGMHttpException.ObjError(srNoUri, nil, 'GMExecHttpPostValues');

  session := TGMHttpClientSession.Create(AAskCanceled, AAskLoginData, nil, AUserName, APassword, nil, ACertificateData);

  multiPartBoundary := 'C3006447922B4499997877A2E5CB41E5';

  requestContent := TGMAnsiStringIStream.Create;
  GMBuildMultiPartFormContent(AValues, requestContent, multiPartBoundary);

  //session.ConnectTransportLayer(uriParts.Scheme, uriParts.Host, uriParts.Port);
  Result := session.ExecuteRequest(nil, AUri, // GMBuildUri('', '', '', '', '', uriParts.Path, uriParts.Query, uriParts.Fragment),
                                   cHttpMethodPOST, requestContent,

                                   [InitRGMNameAndStrValue('Content-Type', cMimeMultiPart+'/'+cMimeFormData+'; boundary='+multiPartBoundary)]);

                                   //'Content-Type: '+cMimeMultiPart+'/'+cMimeFormData+'; boundary='+multiPartBoundary]);
end;

function GMCharCodingOfContent(const AContent: IUnknown; const ADefaultCharKind: TGMCharKind = ckUnknown): TGMCharKind;
var contentInfo: IGMHttpContentInfo;
begin
  if not GMQueryInterface(AContent, IGMHttpContentInfo, contentInfo) then Result := ADefaultCharKind else
     Result := GMCharCodingOfContentType(contentInfo.ContentType, ADefaultCharKind);
end;

function GMHttpHostHeader(const AUri: RGMUriComponents): TGMString;
var prt: TGMString;
begin
  Result := AUri.Host;
  if Length(Result) <= 0 then Exit;
  if IsIP6Address(Result) then Result := '[' + Result+  ']';

  prt := '';
  if (Length(AUri.Port) > 0) and not GMSameText(AUri.Port, scDfltHttpPort) then prt := AUri.Port;
  if (Length(AUri.Port) <= 0) and GMSameText(AUri.Scheme, scStrHttps) then prt := scDfltHttpsPort;

  if Length(prt) > 0 then Result := Result + ':' + prt;
end;


{ -------------------------- }
{ ---- EGMHttpException ---- }
{ -------------------------- }

constructor EGMHttpException.HttpError(const AHttpStatusCode: LongInt; const AReason, APostFix: TGMString; const ACaller: TObject; const ACallingName: TGMString);
begin
  FErrorCode := AHttpStatusCode;
  ObjError(GMStringJoin(GMBuildHttpErrorMsg(AHttpStatusCode, AReason), c2NewLine, GMStrip(APostFix)), ACaller, ACallingName);
end;

function EGMHttpException.GetHRCode: HResult;
begin
  Result := GMMakeHttpHResult(FErrorCode);
end;


{ -------------------------------------------------- }
{ ---- TGMHttpClientAuthSchemeHandlerClassEntry ---- }
{ -------------------------------------------------- }

constructor TGMHttpClientAuthSchemeHandlerClassEntry.Create(const AAuthSchmeName: TGMString; const APosition: PtrInt;
  const AAuthSchmeHandlerClass: TGMHttpClientAuthenticationHandlerClass; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FPosition := APosition;
  FAuthSchemeName := AAuthSchmeName;
  FAuthSchemeHandlerClass := AAuthSchmeHandlerClass;
end;

function TGMHttpClientAuthSchemeHandlerClassEntry.GetName: TGMString;
begin
  Result := FAuthSchemeName;
end;

function TGMHttpClientAuthSchemeHandlerClassEntry.GetPosition: PtrInt;
begin
  Result := FPosition;
end;

function TGMHttpClientAuthSchemeHandlerClassEntry.GetAuthSchemeHandlerClass: TGMHttpClientAuthenticationHandlerClass;
begin
  Result := FAuthSchemeHandlerClass;
end;


{ ------------------------------------------------ }
{ ---- TGMHttpClientAuthenticationHandlerBase ---- }
{ ------------------------------------------------ }

constructor TGMHttpClientAuthenticationHandlerBase.Create(const AUseProxy: Boolean; const AUserName, APassword: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FUserName := AUserName;
  FPassword := APassword;
  FUseProxy := AUseProxy;
end;

function TGMHttpClientAuthenticationHandlerBase.AuthorizationHeaderName: TGMString;
begin
  if FUseProxy then Result := cHttpProxyAuthorization else Result := cHttpAuthorization;
end;

procedure TGMHttpClientAuthenticationHandlerBase.AddAuthorizationHeader(const AHeaders: IGMIntfCollection);
begin
  FLastUserName := FUserName;
  FLastPassword := FPassword;
end;

function TGMHttpClientAuthenticationHandlerBase.ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARetryCount: Integer; const AAskLoginData: IUnknown): Boolean;
var getLoginData: IGMGetHttpLoginData; loginData: RGMHttpLoginData;
begin
  if GMQueryInterface(AAskLoginData, IGMGetHttpLoginData, getLoginData) then
   begin
    FillByte(loginData, SizeOf(loginData), 0);
    GMHrCheckObj(getLoginData.GetHttpLoginData(@loginData), Self, 'GetHttpLoginData');
    FUserName := loginData.UserName;
    FPassword := loginData.Password;
   end;

  Result := not (GMSameText(FLastUserName, FUserName) and GMSameText(FLastPassword, FPassword));
end;

procedure TGMHttpClientAuthenticationHandlerBase.OnTransportLayerDisconnected;
begin
  // Nothing, assuming authtication header stays valid for new connections
end;


{ ------------------------------------------------- }
{ ---- TGMHttpClientBasicAuthenticationHandler ---- }
{ ------------------------------------------------- }

function TGMHttpClientBasicAuthenticationHandler.AuthSchemeName: TGMString;
begin
  Result := cHttpAuthBasic;
end;

function TGMHttpClientBasicAuthenticationHandler.ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARequestRetryCount: Integer;
  const AAskLoginData: IUnknown): Boolean;
begin
  Result := inherited ProcessAuthDenied(AResponseHeaders, ARequestRetryCount, AAskLoginData);
  Result := Result and (ARequestRetryCount <= vMaxHttpAuthDeniedCount);
end;

procedure TGMHttpClientBasicAuthenticationHandler.AddAuthorizationHeader(const AHeaders: IGMIntfCollection);
begin
  if Length(FUserName) > 0 then GMAddINetHeader(AHeaders, AuthorizationHeaderName, cHttpAuthBasic + ' ' + GMEncodeBase64Str(FUserName + ':' + FPassword));
  inherited;
end;


{ ------------------------------------------------ }
{ ---- TGMHttpClientNTLMAuthenticationHandler ---- }
{ ------------------------------------------------ }

{$IFDEF TLS_SUPPORT}
function TGMHttpClientNTLMAuthenticationHandler.AuthSchemeName: TGMString;
begin
  Result := cHttpAuthNTLM;
end;

procedure TGMHttpClientNTLMAuthenticationHandler.OnTransportLayerDisconnected;
begin
  FNTLMAuthSate := 0;
  NTLMClearServerResponse(FServerResponse);
  //FServerResponse := Default(TNTLMServerResponse);
end;

procedure TGMHttpClientNTLMAuthenticationHandler.AddAuthorizationHeader(const AHeaders: IGMIntfCollection);
begin
  case FNTLMAuthSate of
   0: ; // <- Nothing!
   1: GMAddINetHeader(AHeaders, AuthorizationHeaderName, cHttpAuthNTLM + ' ' + BuildNTLMClientStartMsg);
   2: begin
       GMAddINetHeader(AHeaders, AuthorizationHeaderName, cHttpAuthNTLM + ' ' + BuildNTLMClientCredentialsMsg(FUSerName, FPassword, @FServerResponse));
       Inc(FNTLMAuthSate);
      end;

   3: ; // <- Nothing! With NTLM no authentication header needs to be added anymore once the connection is authenticated!

   else raise EGMHttpException.ObjError(GMFormat(srInvalidNTLMAuthState, [FNTLMAuthSate]), Self, 'AddAuthorizationHeader');
  end;
end;

function TGMHttpClientNTLMAuthenticationHandler.ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARequestRetryCount: Integer; const AAskLoginData: IUnknown): Boolean;
var challengeData: TGMString;
  function FindServerNtlmChallengeData(const AResponseHeaders: IGMIntfCollection): TGMString;
  var headerIt: IGMIterator; unkHeader: IUnknown; getStrVal: IGMGetStringValue; hdrStrVal, token: TGMString; chPos: PtrInt;
  begin
    Result := '';
    if AResponseHeaders = nil then Exit;
    headerIt := TGMInetHeaderIterator.Create(AResponseHeaders.CreateIterator, cAuthenticateHeaderName[FUseProxy]);
    while headerIt.NextEntry(unkHeader) do
     if GMQueryInterface(unkHeader, IGMGetStringValue, getStrVal) then
      begin
       hdrStrVal := getStrVal.StringValue;
       chPos := 1;
       token := GMNextWord(chPos, hdrStrVal, ' ');
       if GMSameText(token, 'NTLM') then
        begin
         Result := GMStrip(Copy(hdrStrVal, chPos, Length(hdrStrVal) - chPos + 1));
         if Length(Result) > 0 then Break;
        end;
      end;
  end;

begin
  Result := True;

  case FNTLMAuthSate of
   0: begin Inc(FNTLMAuthSate); NTLMClearServerResponse(FServerResponse); end;

   1: begin
       Inc(FNTLMAuthSate);
       Result := inherited ProcessAuthDenied(AResponseHeaders, ARequestRetryCount, AAskLoginData);
       if Result and (AResponseHeaders <> nil) then
        begin
         challengeData := FindServerNtlmChallengeData(AResponseHeaders);
         if Length(challengeData) <= 0 then raise EGMHttpException.ObjError(srNTLMServerChallengeMsgMissing, Self, {$I %CurrentRoutine%});

         FServerResponse := DecodeNTLMServerChallengeMsg(challengeData);

//       if not CompareMem(PAnsiChar(cStrNTLMProtocolSignature), @FServerResponse.Protocol, Min(Length(cStrNTLMProtocolSignature), SizeOf(FServerResponse.Protocol))) then
         if not CompareMem(PAnsiChar(cStrNTLMProtocolSignature), PAnsiChar(FServerResponse.Protocol), Min(Length(cStrNTLMProtocolSignature), Length(FServerResponse.Protocol)+1)) then
//       if FServerResponse.Protocol <> cStrNTLMProtocolSignature then
            raise EGMHttpException.ObjError(GMFormat(srInvalidNTLMProtocolName, [FServerResponse.Protocol]), Self, {$I %CurrentRoutine%});

         if FServerResponse.MSgKind <> 2 then
            raise EGMHttpException.ObjError(GMFormat(srInvalidNTLMMsgKind, [Integer(FServerResponse.MSgKind)]), Self, {$I %CurrentRoutine%});
        end;
      end;
   3: begin FNTLMAuthSate := 0; NTLMClearServerResponse(FServerResponse); Result := False; end;
// 3: FNTLMAuthSate := 0;
   else Result := False;
  end;
end;
{$ENDIF}


{ ------------------------------------ }
{ ---- TGMHttpTransferDecoderBase ---- }
{ ------------------------------------ }

constructor TGMHttpTransferDecoderBase.Create(const AHttpTokenName: TGMString; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FHttpTokenName := AHttpTokenName;
end;

function TGMHttpTransferDecoderBase.GetName: TGMString; stdcall;
begin
  Result := FHttpTokenName;
end;

//function TGMHttpTransferDecoderBase.CreateDecodeStream(const ASourceStream: ISequentialStream): ISequentialStream;
//begin
//  Result := nil;
//end;


{ ---------------------------------------- }
{ ---- TGMHttpChunckedTransferDecoder ---- }
{ ---------------------------------------- }

function TGMHttpChunckedTransferDecoder.CreateDecodeStream(const ARequest: TGMHttpRequestBase; const ASourceStream: ISequentialStream): ISequentialStream;
begin
  Result := TGMHttpChunkedStream.CreateRead(ARequest, ASourceStream);
end;


{ --------------------------------------- }
{ ---- TGMHttpDeflateTransferDecoder ---- }
{ --------------------------------------- }

{$IFDEF HTTP_ZIP_SUPPORT}
function TGMHttpZIPTransferDecoder.CreateDecodeStream(const ARequest: TGMHttpRequestBase; const ASourceStream: ISequentialStream): ISequentialStream;
begin
  Result := TGMHttpZipDecompressorIStream.Create(ASourceStream, True);
end;
{$ENDIF}


{ ---------------------------- }
{ ---- TGMHttpRequestBase ---- }
{ ---------------------------- }

function TGMHttpRequestBase.ProtocolDisplayName: TGMString;
begin
  if FUsingTlsLayer then Result := GMUpperCase(scStrHttps) else Result := GMUpperCase(scStrHttp);
end;

//function TGMHttpRequestBase.IsChunkedTransfer(const AHeaders: IGMIntfCollection): Boolean;
//var hdrValue: TGMString;
//begin
//  hdrValue := GMGetINetHeaderStrValue(AHeaders, cHttpTransferEncoding);
//  Result := GMHasToken(hdrValue, cHttpChunked, cStrINetHeaderWordSeparators);
//end;


{ ---------------------------- }
{ ---- TGMHttpProxyConfig ---- }
{ ---------------------------- }

constructor TGMHttpProxyConfig.Create(const AProxyHostUri, AProxyBypass, AUsername, APassword: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FProxyHostUri := AProxyHostUri;
  FProxyBypass := AProxyBypass;
  FUsername := AUsername;
  FPassword := APassword;
end;

procedure TGMHttpProxyConfig.LoadSystemProxySettingsOfCurrentUser;
var winProxyConfig: TWinHttpCurrentUserIEProxyConfig;
begin
  winProxyConfig := Default(TWinHttpCurrentUserIEProxyConfig);
  GMAPICheckObj('WinHttpGetIEProxyConfigForCurrentUser', '', GetLastError, WinHttpGetIEProxyConfigForCurrentUser(@winProxyConfig), Self);
  FProxyHostUri := winProxyConfig.lpszProxy;
  FProxyBypass := winProxyConfig.lpszProxyBypass;
end;

function TGMHttpProxyConfig.GetProxyHostUri: TGMString;
begin
  Result := FProxyHostUri;
end;

procedure TGMHttpProxyConfig.SetProxyHostUri(const AUri: TGMString);
begin
  FProxyHostUri := AUri;
end;

function TGMHttpProxyConfig.GetProxyBypass: TGMString;
begin
  Result := FProxyBypass;
end;

procedure TGMHttpProxyConfig.SetProxyBypass(const ABypass: TGMString);
begin
  FProxyBypass := ABypass;
end;

function TGMHttpProxyConfig.GetUsername: TGMString;
begin
  Result := FUsername;
end;

procedure TGMHttpProxyConfig.SetUsername(const AUsername: TGMString);
begin
  FUsername := AUsername;
end;

function TGMHttpProxyConfig.GetPassword: TGMString;
begin
  Result := FPassword;
end;

procedure TGMHttpProxyConfig.SetPassword(const APassword: TGMString);
begin
  FPassword := APassword;
end;

function TGMHttpProxyConfig.UseProxy(const AUri: TGMString): Boolean;
var uri: TGMString; chPos: PtrInt;
begin
  if Length(FProxyHostUri) <= 0 then Exit(False);

  chPos := 1; Result := True;
  repeat
   uri := GMNextWord(chPos, FProxyBypass, ';');
   {ToDo: implement wildcard URI matching here!}
   if Length(uri) > 0 then Result := Result and not GMSameText(AUri, uri);
  until not Result or (Length(uri) <= 0);
end;


{ ------------------------------ }
{ ---- TGMHttpClientRequest ---- }
{ ------------------------------ }

constructor TGMHttpClientRequest.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FKeepConnection := True;
end;

constructor TGMHttpClientRequest.Create(const AAgentName: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FAgentName := AAgentName;
end;

function TGMHttpClientRequest.Obj: TGMHttpClientRequest;
begin
  Result := Self;
end;

function TGMHttpClientRequest.ReceiveHeaders(const ATransportLayer: ISequentialStream; const AHeaders: IGMIntfCollection): TGMString;
var codingHdrValue: TGMString; len: Int64;
begin
  Result := inherited ReceiveHeaders(ATransportLayer, AHeaders);

  codingHdrValue := GMGetINetHeaderStrValue(AHeaders, cHttpTransferEncoding);
  // if additional encodings have been applied, "chunked" MUST be applied too!
  if GMHasToken(codingHdrValue, cHttpChunked, cStrINetHeaderWordSeparators) then
   len := cStrmSizeUnlimited
  else
   len := GMGetINetHeaderIntValue(AHeaders, cHttpContentLength, cStrmSizeUnlimited);

  GMSetReadContentSize(ATransportLayer, len);
end;

function TGMHttpClientRequest.BuildErrorMsgPostfixFromResponseContent(const AResponseContent: ISequentialStream): TGMString;
const cMaxLen = 8192;
var contentType: String; getAnsiText: IGMGetAnsiText; ansiText: AnsiString;
  function IsPrintableText(const AText: AnsiString): Boolean;
  var chIdx: PtrInt;
  begin
    Result := Length(AText) > 0;
    for chIdx:=1 to Length(AText) do
      if (AText[chIdx] < ' ') and not (AText[chIdx] in [#9, #10, #13]) then Exit(False);
  end;
begin
  Result := '';
  if GMQueryInterface(AResponseContent, IGMGetAnsiText, getAnsiText) then
   begin
    contentType := GMGetINetHeaderStrValue(ReceivedHeaders, cHttpContentType);
    ansiText := Copy(getAnsiText.GetAnsiText, 1, cMaxLen);
    if IsPrintableText(ansiText) then
     case GMCharCodingOfContentType(contentType) of
      ckUtf8: Result := GMUtf8ToString(ansiText);
      else Result := ansiText;
     end;
   end;

  //Result := inherited BuildErrorMsgPostfixFromResponseContent(AResponseContent);
end;

function TGMHttpClientRequest.BuildDecodeStreamChain(const ATransportLayer: ISequentialStream): ISequentialStream;
var codingHdrVal, token: TGMString; chPos: PtrInt; searchName, foundElement: IUnknown; decoders: IGMIntfCollection; decoder: IGMHttpTransferDecoder;
    srcStrm: ISequentialStream;
begin
  Result := ATransportLayer;

  codingHdrVal := GMGetINetHeaderStrValue(ReceivedHeaders, cHttpTransferEncoding);
  if Length(codingHdrVal) <= 0 then Exit;

  decoders := RegisterHttpTransferDecoders;
  if decoders = nil then Exit;

  chPos := Length(codingHdrVal);
  repeat
   token := GMStrip(GMPreviousWord(chPos, codingHdrVal, ','));
   if Length(token) <= 0 then Break;
   searchName := TGMNameObj.Create(GMStrip(GMFirstWord(token, ';')));
   if not decoders.Find(searchName, foundElement) then
     raise EGMHttpException.ObjError(GMFormat(srUnsupportedDecoding, [token]), Self, {$I %CurrentRoutine%})
    else
     begin
      GMCheckQueryInterface(foundElement, IGMHttpTransferDecoder, decoder, {$I %CurrentRoutine%});
      srcStrm := Result;
      Result := decoder.CreateDecodeStream(Self, srcStrm);
     end;
  until False;

  //if IschunkedTransfer(ReceivedHeaders) then Result := TGMHttpChunkedStream.CreateRead(Self, Result);
end;

procedure TGMHttpClientRequest.AddStandardHeaders;
var nameObj: IUnknown;
  procedure AddTEHeader;
  const abnfListSep = ', ';
  var hdrVal: TGMString;
  begin
    hdrval := GMSeparatedNames(RegisterHttpTransferDecoders, abnfListSep);
    hdrval := GMStringJoin(cHttpTrailers, abnfListSep, hdrval);
    GMAddINetHeader(HeadersToSend, cHttpTE, hdrval);
  end;
begin
//if FUseProxy then cnPrefix := 'Proxy-' else cnPrefix := '';
  if FKeepConnection then
   begin
    //GMAddINetHeader(HeadersToSend, cHttpConnection, cHttpKeepAlive); // <- In http 1.1 connections are persistent by default!
    if FKeepConnectionTimeout > 0 then GMAddINetHeader(HeadersToSend, cHttpKeepAlive, FKeepConnectionTimeout);
   end
  else
   begin
    GMAddINetHeader(HeadersToSend, cHttpConnection, cHttpClose);
    nameObj := TGMNameObj.Create(cHttpKeepAlive);
    while HeadersToSend.RemoveByKey(nameObj) do ;
   end;

  if Length(FAgentName) > 0 then GMAddINetHeader(HeadersToSend, cHttpUserAgent, FAgentName);
  AddTEHeader;
end;

function TGMHttpClientRequest.InternalExecute(const ATransportLayer: ISequentialStream; const AUseProxy: Boolean; const AMethod: TGMString;
  const AUri: RGMUriComponents; const ARequestContent: ISequentialStream; const AAdditionalHeaders: TGMNameAndStrValArray;
  const AOnUploadProgressProc: TGMOnProgressProc; const AUploadBuffersize: LongInt; const AUsingTlsLayer: Boolean): RGMRequestResult;
var startLine, path, requestContentStr, errMsgPostFix: TGMString; startLineA: AnsiString; contentInfo: IGMHttpContentInfo;
    responseStatus: RGMResponseHttpStaus; headerEntry: RGMNameAndStrValue;
begin
  Result := Default(RGMRequestResult);
  Result.Request := Self;
  FUsingTlsLayer := AUsingTlsLayer;

  if GMSameText(AMethod, cHttpMethodCONNECT) then path := GMHttpHostHeader(AUri)
  else
  if AUseProxy and not AUsingTlsLayer then path := AUri.Uri
  else
  path := GMBuildUri('', '', '', '', '', AUri.Path, AUri.Query, AUri.Fragment);

  startLine := GMUpperCase(GMDeleteChars(AMethod, cWhiteSpace)) + ' ' + path + ' ' + GMUpperCase(scStrHttp) + '/' + vDfltHttpProtocolVersion;

  AddStandardHeaders;

  GMAddINetHeader(HeadersToSend, cHttpContentLength, GMIntToStr(GMIStreamSize(ARequestContent)), hamAddIfNew); // <- a PUT request may already have added a content length!
  for headerEntry in AAdditionalHeaders do GMAddINetHeader(HeadersToSend, headerEntry.Name, headerEntry.StrValue);

  //if Length(ARequestContentType) > 0 then GMAddINetHeader(HeadersToSend, cHttpContentType, ARequestContentType);

  startLine := GMStringJoin(startLine, CRLF, GMHeadersAsString(HeadersToSend)) + CRLF + CRLF;

  vfGMTrace(startLine, ProtocolDisplayName);

  if vfGMDoTracing then
   begin
    requestContentStr := GMGetIntfText(ARequestContent);
    if Length(requestContentStr) > 0 then vfGMTrace(requestContentStr, cStrContent);
   end;

  startLineA := startLine;
  GMSafeIStreamWrite(ATransportLayer, PAnsiChar(startLineA), Length(startLineA), 'Sending HTTP request headers');
  GMCopyIStream(ARequestContent, ATransportLayer, AUploadBufferSize, AOnUploadProgressProc, 'Sending HTTP request content');

  responseStatus := GMParseHttpStatusLine(ReceiveHeaders(ATransportLayer, ReceivedHeaders));  // <- dont apply any transfer encoding (chunked etc.) when receiving headers!

  // ReceiveHeaders will already have set response stream size limit according to the content-length header
  // Responses to HEAD requests never contain a payload
  if GMSameText(AMethod, cHttpMethodHEAD) or GMIsOneOfIntegers(responseStatus.StatusCode, [HTTP_STATUS_NO_CONTENT, HTTP_STATUS_NOT_MODIFIED]) then
     GMSetReadContentSize(ATransportLayer, 0);

  Result.ResponseContent := BuildDecodeStreamChain(ATransportLayer);
  
  if GMQueryInterface(Result.ResponseContent, IGMHttpContentInfo, contentInfo) then
   begin
    contentInfo.SetContentType(GMGetINetHeaderStrValue(ReceivedHeaders, cHttpContentType));
    contentInfo.SetContentEncoding(GMGetINetHeaderStrValue(ReceivedHeaders, cHttpContentencoding));
   end;

  //CheckResponseStatus(responseStatus, Result.ResponseContent); // <- may consume content, must use chunked stream when headers indicate chunked transfer!

  if not GMSameText(Copy(responseStatus.HttpVersion, 1, Length(scStrHttp)), scStrHttp) then
     raise EGMHttpException.ObjError(srServerResponseNotHttp, Self, {$I %CurrentRoutine%});

  if not GMIsHttpSuccessStatus(responseStatus.StatusCode) then
   begin
    errMsgPostFix := ConsumeContent(Result.ResponseContent);
    raise EGMHttpException.HttpError(responseStatus.StatusCode, responseStatus.ReasonText, errMsgPostFix, Self, {$I %CurrentRoutine%});
   end;
end;

//procedure TGMHttpClientRequest.CheckResponseStatus(const AResponseStatus: RGMResponseHttpStaus; const AResponseContent: ISequentialStream);
//var postFix: TGMString; // statusInt: LongInt;
//begin
//  //GMParseHttpStartLine(AResponseStatus, httpVersion, statusCode, reason);
//
//  if not GMSameText(Copy(AResponseStatus.HttpVersion, 1, Length(scStrHttp)), scStrHttp) then
//     raise EGMHttpException.ObjError(RStrServerResponseNotHttp, Self, {$I %CurrentRoutine%});
//
//  //AStatusCode := GMStrToInt(GMMakeDezInt(statusCode, cDfltHttpErrorCode));
//
//  if not GMIsHttpSuccessStatus(AResponseStatus.StatusCode) then
//   begin
//    postFix := ConsumeContent(AResponseContent);
//    raise EGMHttpException.HttpError(AResponseStatus.StatusCode, reason, postFix, Self, {$I %CurrentRoutine%});
//   end;
//end;


{ ------------------------------ }
{ ---- TGMHttpClientSession ---- }
{ ------------------------------ }

constructor TGMHttpClientSession.Create(const AAskCanceled, AAskLoginData,
 ACertificateStatusNotifySink: IUnknown; const AUserName: TGMString;
 const APassword: TGMString; const AProxyConfig: IGMHttpProxyConfig; const ACertificateData: Ansistring;
 const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FAskCanceled := AAskCanceled;
  FAskLoginData := AAskLoginData;
  FCertificateStatusNotifySink := ACertificateStatusNotifySink;
  FUserName := AUserName;
  FPassword := APassword;
  FCertificateData := ACertificateData;
  FProxyConfig := AProxyConfig;
end;

destructor TGMHttpClientSession.Destroy;
begin
  if IsTransportLayerConnected then DisconnectTransportLayer;
  inherited;
end;

function TGMHttpClientSession.IsTransportLayerConnected: Boolean;
begin
  Result := FTransportLayerConnection <> nil;
end;

function TGMHttpClientSession.UseProxy(const AUri: TGMSTring): Boolean;
begin
  Result := (FProxyConfig <> nil) and FProxyConfig.UseProxy(AUri);
end;

procedure TGMHttpClientSession.DisconnectTransportLayer;
begin
  if FTransportLayerConnection <> nil then
   begin
    if FAuthenticationHandler <> nil then FAuthenticationHandler.OnTransportLayerDisconnected;
    if FProxyAuthenticationHandler <> nil then FProxyAuthenticationHandler.OnTransportLayerDisconnected;
    FTransportLayerConnection := nil;
    FUsingTlsLayer := False;
    //FCreatingProxyTlsTunnel := False; // <- don't set this to false here, keep value of FCreatingProxyTlsTunnel over closed connections!
    FTargetHost.Clear;
    FProxyTunnelHost.Clear;
   end;
end;

function TGMHttpClientSession.InternalConnectTransportLayer(const ATargetUri, AProxyUri: RGMUriComponents): IGMSocketIO;
var  socket: IGMSocket; connectUri: RGMUriComponents; useProxy: Boolean;
  procedure ExecuteTlsConnectRequest;
  var socket: IGMSocket;
  begin
    if (FTransportLayerConnection = nil) or FCreatingProxyTlsTunnel then Exit;
    FCreatingProxyTlsTunnel := True; // <- prevent recursion of CONNECT request!
    try
     GMCheckQueryInterface(FTransportLayerConnection, IGMSocket, socket, {$I %CurrentRoutine%});
     ExecuteRequest(nil, ATargetUri.Uri, cHttpMethodCONNECT);
     FProxyTunnelHost := ATargetUri;
     FTransportLayerConnection := GMAddTlsLayer(socket, ATargetUri.Host, FCertificateStatusNotifySink, FCertificateData);
     FUsingTlsLayer := True;
    finally
     FCreatingProxyTlsTunnel := False;
    end;
  end;
begin
  useProxy := Length(AProxyUri.Host) > 0;
  if useProxy then connectUri := AProxyUri else connectUri := ATargetUri;

  //if AndereProxyrHttpTunnel then DisconnectTransportLayer;

  if Length(connectUri.Scheme) <= 0 then connectUri.Scheme := scStrHttp;

  if Length(connectUri.Port) <= 0 then
   {$IFDEF TLS_SUPPORT}
    if GMSameText(connectUri.Scheme, scStrHttps) then connectUri.Port := scDfltHttpsPort else connectUri.Port := vDfltHttpPort;
   {$ELSE}
    connectUri.Port := vDfltHttpPort;
   {$ENDIF}

  if (FTransportLayerConnection = nil) or not (GMSameText(FTargetHost.Scheme, connectUri.Scheme) and GMSameText(FTargetHost.Host, connectUri.Host) and GMSameText(FTargetHost.Port, connectUri.Port)) then
   begin
    DisconnectTransportLayer;

    if not GMSameText(connectUri.Scheme, scStrHttp) {$IFDEF TLS_SUPPORT}and not GMSameText(connectUri.Scheme, scStrHttps){$ENDIF} then
      raise EGMHttpException.ObjError(GMFormat(RStrUnsupportedINetProtocol, [connectUri.Scheme]), Self, {$I %CurrentRoutine%})
    else
     begin
      socket := TGMTcpSocket.Create(vDfltInetAddrFamily, FAskCanceled);
      socket.Connect(connectUri.Host, connectUri.Port);
      //FTransportLayerConnection := socket;
      {$IFDEF TLS_SUPPORT}
      if not GMSameText(connectUri.Scheme, scStrHttps) then FTransportLayerConnection := socket else
        begin
         //if ACreateTlsProxyTunnel then ExecuteTlsConnectRequest;
         FTransportLayerConnection := GMAddTlsLayer(socket, ATargetUri.Host, FCertificateStatusNotifySink, FCertificateData);
         FUsingTlsLayer := True;
        end;
      {$ELSE}
      FTransportLayerConnection := socket;
      {$ENDIF}
     end;

    FTargetHost := connectUri;
   end;
  Result := FTransportLayerConnection;

  {$IFDEF TLS_SUPPORT}
  if useProxy and GMSameText(ATargetUri.Scheme, scStrHttps)
     and not (GMSameText(FProxyTunnelHost.Host, ATargetUri.Host) and GMSameText(FProxyTunnelHost.Port, ATargetUri.Port)) then ExecuteTlsConnectRequest;
  {$ENDIF}
end;

function TGMHttpClientSession.ConnectTransportLayer(const AUri: TGMString): RConnectTransportLayerResult;
var targetUri, proxyUri: RGMUriComponents;
begin
  targetUri := GMParseUri(AUri);

  Result.UseProxy := UseProxy(AUri);

  if Result.UseProxy then proxyUri := GMParseUri(FProxyConfig.ProxyHostUri) else proxyUri := Default(RGMUriComponents);

  Result.TransportLayerConnection := InternalConnectTransportLayer(targetUri, proxyUri);
end;

procedure TGMHttpClientSession.CreateAuthentificationHandler(const AHeaders: IGMIntfCollection; var ACurrentHandler: IGMHttpClientAuthenticationHandler; const AUseProxy: Boolean; const AUserName, APassword: TGMString);
var searchName, unkHeader, unkHandler: IUnknown; getValue: IGMGetStringValue; allHandlerClasses, supportedHandlerClasses: IGMIntfCollection;
    authSchemeHandlerClass: IGMGetHttpClientAuthSchemeHandlerClass; it: IGMIterator; authScheme, unsupportedAuthSchemes, errMsg: TGMString;
    // getName: IGMGetName;
  procedure CreateAuthHandler(const AAuthenticationHandlerClass: TGMHttpClientAuthenticationHandlerClass; const AAuthSchemeName: TGMString);
  begin
    //
    // Better allow changing the authentication handler
    //
//  if ACurrentHandler <> nil then
//   begin
//    if not GMSameText(AAuthSchemeName, ACurrentHandler.AuthSchemeName) then
//       raise EGMHttpException.ObjError(GMFormat(RStrHttpAuthSchemeChangeFmt, [ACurrentHandler.AuthSchemeName, AAuthSchemeName]), Self, {$I %CurrentRoutine%});
//   end
//  else
    if (AAuthenticationHandlerClass <> nil) and
       ((ACurrentHandler = nil) or (ACurrentHandler.GetClassType <> AAuthenticationHandlerClass)) then
      ACurrentHandler := AAuthenticationHandlerClass.Create(AUseProxy, AUserName, APassword, True);
  end;
begin
  if AHeaders = nil then Exit;

  unsupportedAuthSchemes := '';
  allHandlerClasses := RegisterHttpClientAuthHanlderClasses;

  supportedHandlerClasses := TGMIntfArrayCollection.Create(False, True, GMCompareByPosition);

  //it := AHeaders.CreateIterator;
  it := TGMInetHeaderIterator.Create(AHeaders.CreateIterator, cAuthenticateHeaderName[AUseProxy]);
  while it.NextEntry(unkHeader) do
   if GMQueryInterface(unkHeader, IGMGetStringValue, getValue) then
    begin
     //if not GMQueryInterface(unkHeader, IGMGetName, getName) or
     //   not GMQueryInterface(unkHeader, IGMGetStringValue, getValue) or
     //   not GMSameText(getName.Name, cAuthenticateHeaderName[AUseProxy]) then Continue;

     authScheme := GMFirstWord(getValue.StringValue, ' ');

     searchName := TGMNameObj.Create(authScheme);
     if allHandlerClasses.Find(searchName, unkHandler) then supportedHandlerClasses.Add(unkHandler) else
        unsupportedAuthSchemes := GMStringJoin(unsupportedAuthSchemes, ', ', '"'+authScheme+'"');
    end;

  if supportedHandlerClasses.IsEmpty then
   begin
    if Length(unsupportedAuthSchemes) > 0 then
      errMsg := GMFormat(srHttpAuthSchmeNotImplFmt, [unsupportedAuthSchemes])
    else
      errMsg := GMFormat(srNoAuthSchemeProvidedByServer, [cAuthenticateHeaderName[AUseProxy]]);

    raise EGMHttpException.ObjError(errMsg, Self, {$I %CurrentRoutine%})
   end
  else
    begin
     GMCheckQueryInterface(supportedHandlerClasses.First, IGMGetHttpClientAuthSchemeHandlerClass, authSchemeHandlerClass, {$I %CurrentRoutine%});
     CreateAuthHandler(authSchemeHandlerClass.GetAuthSchemeHandlerClass, GMGetIntfName(authSchemeHandlerClass));
    end;
end;

function TGMHttpClientSession.ExecuteRequest(AHttpRequest: IGMHttpClientRequest; AUri, AHttpMethod: TGMString; const ARequestContent: ISequentialStream;
    const AAdditionalHeaders: TGMNameAndStrValArray; const AOnUploadProgressProc: TGMOnProgressProc; const AUploadBuffersize: LongInt): RGMRequestResult;
var deniedCount, proxyDeniedCount, redirectCount, reconnectCount: Integer; requestContentStartPos: Int64; useProxy: Boolean; uriComponents: RGMUriComponents;
    tmpUri, username, password, nestedErrMsg: TGMString;
  procedure Connect(const AUriToConnect: TGMString);
  var oldConnection: IGMSocketIO;
  begin
    oldConnection := FTransportLayerConnection;
    useProxy := ConnectTransportLayer(AUriToConnect).UseProxy;
    if oldConnection <> FTransportLayerConnection then Result.ResponseContent := nil;
  end;
  procedure ResetRequest;
  begin
    GMSetIStreamAbsPos(ARequestContent, requestContentStartPos, {$I %CurrentRoutine%});
    GMSetReadContentSize(Result.ResponseContent, cStrmSizeUnlimited); // <- No Limit when reading headers of next response!
    AHttpRequest.Obj.ReceivedHeaders.Clear;
  end;
  procedure Redirect(const ANewUri: TGMString);
  begin
    if Length(ANewUri) <= 0 then raise EGMHttpException.ObjError(srNoRedirectionUri, Self, {$I %CurrentRoutine%});
    Connect(ANewUri);
    AUri := ANewUri;
  end;
  procedure ReConnectTransportLayer;
  var connectedUri: TGMString;
  begin
    connectedUri := FTargetHost.Uri;
    DisconnectTransportLayer;
    //FTargetHost.Clear; //  := GMInitUriComponents('', '', '', '', '', '', '', '');
    Connect(connectedUri);
  end;
  procedure IncrementAndCheckRedirectCount;
  begin
    Inc(redirectCount);
    if redirectCount > vMaxHttpRedirectCount then raise EGMHttpException.ObjError(GMFormat(srTooManyRedirects, [redirectCount]), Self, {$I %CurrentRoutine%});
  end;

begin
  useProxy := False;
  Result.ResponseContent := nil; // <- if not cleared a previous instance may be erroneously re-used due to memory manager misbehave
  if Length(AHttpMethod) <= 0 then AHttpMethod := cHttpMethodGET;

  if AHttpRequest = nil then AHttpRequest := TGMHttpClientRequest.Create(scGMHttpAgent);
  Result.Request := AHttpRequest;
  requestContentStartPos := GMIStreamPos(ARequestContent);

  redirectCount := 0; reconnectCount := 0; deniedCount := 0; proxyDeniedCount := 0;
  repeat
   try
    AUri := GMUriEncode(AUri); // <- AURI may be re-assigned by Redirect!
    uriComponents := GMParseUri(AUri);

    if not IsTransportLayerConnected then Connect(AUri);

    if not IsTransportLayerConnected then raise EGMHttpException.ObjError(srTranspoerLayerNotConnected, Self, {$I %CurrentRoutine%});

    if Result.ResponseContent = nil then Result.ResponseContent := TGMHttpSocketStream.Create(FTransportLayerConnection);

    ResetRequest;

    GMAddINetHeader(AHttpRequest.Obj.HeadersToSend, 'Host', GMHttpHostHeader(uriComponents));

    if FAuthenticationHandler <> nil then FAuthenticationHandler.AddAuthorizationHeader(AHttpRequest.Obj.HeadersToSend);
    // Don't add a proxy authentication header after we created a proxy tunnel
    if (FProxyAuthenticationHandler <> nil) and (Length(FProxyTunnelHost.Host) <= 0) then FProxyAuthenticationHandler.AddAuthorizationHeader(AHttpRequest.Obj.HeadersToSend);

    //if useProxy then
    //  begin if FProxyAuthenticationHandler <> nil then FProxyAuthenticationHandler.AddAuthorizationHeader(AHttpRequest.Obj.HeadersToSend); end
    //else
    //  if FAuthenticationHandler <> nil then FAuthenticationHandler.AddAuthorizationHeader(AHttpRequest.Obj.HeadersToSend);

    //if FProxyConfig <> nil then username := FProxyConfig.Username else username := '';
    //if FProxyConfig <> nil then password := FProxyConfig.Password else password := '';

    try
     Result := AHttpRequest.Obj.InternalExecute(Result.ResponseContent, useProxy, AHttpMethod, uriComponents, ARequestContent, AAdditionalHeaders, AOnUploadProgressProc, AUploadBuffersize, FUsingTlsLayer);
    finally
     if GMSameText(GMGetINetHeaderStrValue(AHttpRequest.Obj.ReceivedHeaders, cHttpConnection), cHttpClose) then
        DisconnectTransportLayer; // <- the Result stream may still hold a reference to the socket connection and may use it until it is released
    end;

    Break; // <- Always leave repeat loop if no exception occured
   except
    on ex: TObject do
     case GMExtractHttpCodeFromHResult(GMGetObjHrCode(ex)) of
      HTTP_STATUS_DENIED:
       begin
        Inc(deniedCount); nestedErrMsg := '';
        try
         CreateAuthentificationHandler(AHttpRequest.Obj.ReceivedHeaders, FAuthenticationHandler, False, FUserName, FPassword);
        except
         on innerEx: TObject do nestedErrMsg := GMMsgFromExceptObj(innerEx);
        end;
        if Length(nestedErrMsg) > 0 then begin GMExtendExceptionMsg(ex, nestedErrMsg, c2NewLine); raise; end;
        if FAuthenticationHandler = nil then raise;
        if not FAuthenticationHandler.ProcessAuthDenied(AHttpRequest.Obj.ReceivedHeaders, deniedCount, FAskLoginData) then raise;
        //ResetRequest;
       end;

      HTTP_STATUS_PROXY_AUTH_REQ:
       begin
        Inc(proxyDeniedCount); nestedErrMsg := '';
        if FProxyConfig <> nil then username := FProxyConfig.Username else username := '';
        if FProxyConfig <> nil then password := FProxyConfig.Password else password := '';
        try
         CreateAuthentificationHandler(AHttpRequest.Obj.ReceivedHeaders, FProxyAuthenticationHandler, True, username, password);
        except
         on innerEx: TObject do nestedErrMsg := GMMsgFromExceptObj(innerEx);
        end;
        if Length(nestedErrMsg) > 0 then begin GMExtendExceptionMsg(ex, nestedErrMsg, c2NewLine); raise; end;
        if FProxyAuthenticationHandler = nil then raise;
        if not FProxyAuthenticationHandler.ProcessAuthDenied(AHttpRequest.Obj.ReceivedHeaders, proxyDeniedCount, FAskLoginData) then raise;
        //ResetRequest;
       end;

      HTTP_STATUS_MOVED, HTTP_STATUS_REDIRECT, HTTP_STATUS_REDIRECT_KEEP_VERB:
       begin
        IncrementAndCheckRedirectCount;
        Redirect(GMGetINetHeaderStrValue(AHttpRequest.Obj.ReceivedHeaders, cStrHttpLocation, '', True));
        //ResetRequest;
       end;

      HTTP_STATUS_USE_PROXY:
       begin
        IncrementAndCheckRedirectCount;
        tmpUri := GMGetINetHeaderStrValue(AHttpRequest.Obj.ReceivedHeaders, cStrHttpLocation, '', True);
        if FProxyConfig = nil then FProxyConfig := TGMHttpProxyConfig.Create(tmpUri) else
          begin
           FProxyConfig.ProxyHostUri := tmpUri;
           FProxyConfig.ProxyBypass := '';
          end;
        //ResetRequest;
        ReConnectTransportLayer;
       end;

      else
       if not GMIsSocketReConnectErrorCode(GMGetObjHRCode(exceptObject)) then raise else
        begin
         Inc(reconnectCount);
         if reconnectCount > vMaxHttpReConnectCount then raise EGMHttpException.ObjError(GMFormat(srTooManyReconnects, [reconnectCount]), Self, {$I %CurrentRoutine%});
         ReConnectTransportLayer;
         //ResetRequest;
        end;
     end;
   end;
  until False;
end;


{ ------------------------------ }
{ ---- TGMHttpServerRequest ---- }
{ ------------------------------ }

function TGMHttpServerRequest.Obj: TGMHttpServerRequest;
begin
  Result := Self;
end;

procedure TGMHttpServerRequest.AddMinimalResponseHeaders(const AHeaders: IGMIntfCollection);
begin
  GMAddINetHeader(HeadersToSend, 'Server', 'GMServer/1.0', hamAddIfNew);
  GMAddINetHeader(HeadersToSend, cHttpContentLength, '0', hamAddIfNew);
  GMAddINetHeader(HeadersToSend, 'Date', GMEncodeUtcToINetTime(GMLocalTimeToUTC(Now, nil, Self), Self), hamAddIfNew);
end;

procedure TGMHttpServerRequest.ProcessRequest(const ATransportLayer: ISequentialStream; const ARequestProcessor: IUnknown);
var processor: IGMProcessServerRequest; httpRetCode: LongInt; resultHdrs: AnsiString; method, url, httpVersion: TGMString;
begin
  GMParseHttpStartLine(ReceiveHeaders(ATransportLayer, ReceivedHeaders), method, url, httpVersion);

  if not GMQueryInterface(ARequestProcessor, IGMProcessServerRequest, processor) then httpRetCode := HTTP_STATUS_SERVER_ERROR else
  try
   httpRetCode := processor.ProcessRequest(Self, method, GMUriDecode(url));
  except
   GMTraceException(ExceptObject);
   httpRetCode := HTTP_STATUS_SERVER_ERROR;
  end;

  AddMinimalResponseHeaders(HeadersToSend);

  resultHdrs := httpVersion + ' ' + IntToStr(httpRetCode) + ' ' + GMHttpShortHint(httpRetCode);
  resultHdrs := GMStringJoin(resultHdrs, CRLF, GMHeadersAsString(HeadersToSend)) + CRLF + CRLF;

  vfGMTrace(resultHdrs, ProtocolDisplayName);

  GMSafeIStreamWrite(ATransportLayer, PAnsiChar(resultHdrs), Length(resultHdrs), 'Sending HTTP response headers');
  processor.SendResponseContents(ATransportLayer);
end;


{ -------------------------------- }
{ ---- TGMHttpContentInfoImpl ---- }
{ -------------------------------- }

function TGMHttpContentInfoImpl.ContentEncoding: TGMString;
begin
  Result := FContentEncoding;
end;

function TGMHttpContentInfoImpl.ContentType: TGMString;
begin
  Result := FContentType;
end;

procedure TGMHttpContentInfoImpl.SetContentEncoding(const AContentEncoding: TGMString);
begin
  FContentEncoding := AContentEncoding;
end;

procedure TGMHttpContentInfoImpl.SetContentType(const AContentType: TGMString);
begin
  FContentType := AContentType;
end;


{ ----------------------------- }
{ ---- TGMHttpSocketStream ---- }
{ ----------------------------- }

constructor TGMHttpSocketStream.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FHttpContentInfo := TGMHttpContentInfoImpl.Create(True);
end;


{ --------------------------------------- }
{ ---- TGMHttpZipDecompressorIStream ---- }
{ --------------------------------------- }

{$IFDEF HTTP_ZIP_SUPPORT}
constructor TGMHttpZipDecompressorIStream.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FHttpContentInfo := TGMHttpContentInfoImpl.Create(True);
end;
{$ENDIF}

{ ------------------------------ }
{ ---- TGMHttpChunkedStream ---- }
{ ------------------------------ }

constructor TGMHttpChunkedStream.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FHttpContentInfo := TGMHttpContentInfoImpl.Create(True);
  FChunkReadPos := 1;
end;

constructor TGMHttpChunkedStream.CreateRead(const AProtocolObj: IGMINetProtocolBase; const AChainedStream: ISequentialStream; const AMode: DWORD;
  const AName: UnicodeString; const ARefLifeTime: Boolean);
begin
  inherited Create(AMode, AName, ARefLifeTime);
  FChainedStream := AChainedStream;
  FProtocolObj := AProtocolObj;
  GMCheckPointerAssigned(Pointer(FProtocolObj), srTheProtocolObj, Self);
end;

procedure TGMHttpChunkedStream.ReadChunk; // : Boolean;
var line, term: AnsiString; chPos: PtrInt; chunkSize: Int64;
begin
  if FEOS then Exit;

  line := FProtocolObj.Obj.ReadResponseLine(FChainedStream);

  chPos := 1;
  chunkSize := GMStrToInt64('$'+GMStrip(GMNextWord(chPos, line, ';')));
  //chunkSize := GMStrToInt(GMMakeDezInt(GMFirstWord(line, ';')));
  SetLength(FChunkData, chunkSize);

  if chunkSize > 0 then
   begin
    GMSafeIStreamRead(FChainedStream, PAnsiChar(FChunkData), chunkSize, {$I %CurrentRoutine%});
    SetLength(term, 2);
    GMSafeIStreamRead(FChainedStream, PAnsiChar(term), Length(term), {$I %CurrentRoutine%});
    if term <> CRLF then raise EGMHttpException.ObjError(srInvalidHttpChunkTerm+': '+term);
   end
  else
   begin
    FProtocolObj.Obj.ReceiveHeaders(FChainedStream, nil); // <- dont add headers that are not allowed as trailers (content-Length, Transfer-Encoding, Trailers)
    FEOS := True;
   end;

  FChunkReadPos := 1;

//Result := chunkSize > 0;
end;

procedure TGMHttpChunkedStream.InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord);
begin
  if (FChunkReadPos > Length(FChunkData)) and not FEOS then ReadChunk;

  if FChunkReadPos > Length(FChunkData) then pcbRead := 0 else
   begin
    pcbRead := Max(0, Min(cb, Length(FChunkData) - FChunkReadPos + 1));
    if pcbRead > 0 then Move(FChunkData[FChunkReadPos], pv^, pcbRead);
    Inc(FChunkReadPos, pcbRead);
    //FChunkReadPos += pcbRead;
   end;
end;

procedure TGMHttpChunkedStream.InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord);
begin
  if FChainedStream <> nil then GMHrCheckObj(FChainedStream.Write(pv, cb, PLongInt(@pcbWritten)), Self, 'InternalWrite') else pcbWritten := 0;
end;


{ ----------------------------------- }
{ ---- routines from winHttp.DLL ---- }
{ ----------------------------------- }

//function WinHttpGetIEProxyConfigForCurrentUser(pProxyConfig: PWinHttpCurrentUserIEProxyConfig): BOOL; stdcall;

const

  cWinHttpDll = 'WinHttp.DLL';

{$IFDEF DELAY_LOAD_WIN_DLLs}
var vf_WinHttpGetIEProxyConfigForCurrentUser: function (pProxyConfig: PWinHttpCurrentUserIEProxyConfig): BOOL; stdcall = nil;

function WinHttpGetIEProxyConfigForCurrentUser;
begin
  if not Assigned(vf_WinHttpGetIEProxyConfigForCurrentUser) then vf_WinHttpGetIEProxyConfigForCurrentUser := GMGetProcAddress(cwinHttpDll, 'WinHttpGetIEProxyConfigForCurrentUser');
  Result := vf_WinHttpGetIEProxyConfigForCurrentUser(pProxyConfig);
end;
{$ELSE}
function WinHttpGetIEProxyConfigForCurrentUser; external cwinHttpDll;
{$ENDIF DELAY_LOAD_WIN_DLLs}


initialization

  // Create Critical Section in main thread when loaded
  vCSRegisterHttpClientAuthHanlderClasses := TGMCriticalSection.Create;
  vCSRegisterHttpTransferDecoders := TGMCriticalSection.Create;

end.