{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Implementation of the HTTP protocol.         | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2012 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed 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:
  ======
  
  Mit Proxy Server verbinden statt mit dem in der URL angegebenen Server
  
  305 Use Proxy behandeln
  
  407 Proxy Authentication Required behandeln
  
  Proxy-Authenticate und Proxy-Authorization verwenden


  ToDo:
  =====
  - Chunked Stream trailers: Dont add headers that are not allowed as trailers (content-Length, Transfer-Encoding, Trailers)
}


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

  cStrHttp = 'HTTP';
  cStrHttps = 'HTTPS';
  cDfltHttpPort = '80';
  cDfltHttpsPort = '443';
  cHttpDirSeparator = '/';
  cGMHttpAgent = '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';
  cHttpAuthorization = 'Authorization';
  cHttpWwwAuthenticate = 'WWW-Authenticate';
  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';

  cHttpMethoddHEAD = 'HEAD';
  cHttpMethoddGET = 'GET';
  cHttpMethoddPUT = 'PUT';
  cHttpMethoddPOST = 'POST';
  cHttpMethoddOPTIONS = 'OPTIONS';


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;


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


  TGMHttpRequestBase = class(TGMINetProtocolBase)
   protected
    FIsUsingTlsLayer: 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;


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

    function BuildErrorMsgPostfixFromResponseContent(const AResponseContent: ISequentialStream): TGMString; override;
    function BuildDecodeStreamChain(const ATransportLayer: ISequentialStream): ISequentialStream;
    procedure AddStandardHeaders;
    procedure CheckResponseStatus(const ATransportLayer: ISequentialStream; const AResponseStatus: TGMString; var AStatusCode: LongInt);
    function InternalExecute(const ATransportLayer: ISequentialStream; const AMethod, AUri: AnsiString;
                             const ARequestContent: ISequentialStream; const ARequestContentType: TGMString;
                             const AOnUploadProgressProc: TGMOnProgressProc; const AUploadBuffersize: LongInt;
                             const AIsUsingTlsLayer: Boolean): RGMRequestResult;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor Create(const AAgentName: TGMString = cGMHttpAgent; 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;
    //function ClassType: TClass;
  end;

  TGMHttpClientAuthenticationHandlerBase = class(TGMRefCountedObj, IGMHttpClientAuthenticationHandler)
   protected
    FUserName, FPassword, FLastUserName, FLastPassword: TGMString;
   public
    constructor Create(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;
  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; APath, AHttpMethod: TGMString; const ARequestContent: ISequentialStream = nil;
                            const ARequestContentType: TGMString = ''; const AOnUploadProgressProc: TGMOnProgressProc = nil;
                            const AUploadBuffersize: LongInt = -cDfltUiResponseMS): RGMRequestResult;
  end;

  TGMHttpClientSession = class(TGMRefCountedObj, IGMHttpClientSession)
   protected
    FIsUsingTlsLayer: Boolean;
    FProtocol, FHost, FPort, FUserName, FPassword: TGMString;
    FTransportLayerConnection: IGMSocketIO;
    FAskCanceled, FAskLoginData, FCertificateStatusNotifySink: IUnknown;
    FAuthenticationHandler: IGMHttpClientAuthenticationHandler;
    FCertificateData: AnsiString;

    procedure DisconnectTransportLayer;
    procedure CreateAuthentificationHandler(const AHeaders: IGMIntfCollection; const AUserName, APassword: TGMString);

   public
    constructor Create(const AAskCanceled, AAskLoginData, ACertificateStatusNotifySink: IUnknown; const AUserName: TGMString = '';
                       const APassword: TGMString = ''; const ACertificateData: Ansistring = ''; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
    function IsTransportLayerConnected: Boolean;
    function ConnectTransportLayer(AProtocol, AHost: TGMString; APort: TGMString = cDfltHttpPort): IGMSocketIO;
    function ExecuteRequest(AHttpRequest: IGMHttpClientRequest; APath, AHttpMethod: TGMString; const ARequestContent: ISequentialStream = nil;
                            const ARequestContentType: TGMString = ''; 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 ARequestContentType: TGMString = ''): RGMRequestResult;

procedure GMParseHttpStartLine(const AStatusString: TGMString; var AHttpVersion, AStatusCode, AReason: TGMString);

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

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

function IsIP6Address(const AAddress: TGMString): Boolean;
function BuildHostHeaderValue(const AHost, APort: 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 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';


var

  vDfltHttpProtocolVersion: TGMString = '1.1';
  vDfltHttpPort: TGMString = cDfltHttpPort;
//vDfltUserAgent: TGMString = 'GM-Http/1.0';
  vMaxHttpRedirectCount: LongInt = 5;


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


resourcestring

  RStrServerResponseNotHttp = 'The Server did not respond with the HTTP protocol';
  RStrUnknownHTTPStatusCodeFmt = 'Unknown HTTP status code (%d)';
  RStrHTTPStatusErrorFmt = 'HTTP error %d';
//RStrHttpHeaderNotFoundFmt = 'Http header "%s" not found';
  RStrHttpAuthSchmeNotImplFmt = 'Http authentication scheme(s) [%s] not implemented';
//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';

  RStrInvalidHttpChunkTerm = 'Invalid http chunk terminator';
  RStrTheProtocolObj = 'The protocol object';

  RStrTranspoerLayerNotConnected = 'Network transport layer not connected';
  RStrTooManyRedirects = 'Too many http redirections: %d';
  RStrNoRedirectionUri = 'Http redirection URI missing';
  RStrNoUri = 'No URI specified';
  RStrUnsupportedDecoding = 'HTTP Transfer-Encoding not supported: "%s"';

  {$IFDEF TLS_SUPPORT}
  RStrNTLMServerChallengeMsgMissing = 'NTLM server challenge header missing';
  RStrInvalidNTLMProtocolName = 'Inconsistent NTLM protocol name: "%s"';
  RStrInvalidNTLMMsgKind = 'Invalid NTLM protocol message kind: %d';
  RStrInvalidNTLMAuthState = '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(RStrUnknownHTTPStatusCodeFmt, [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 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(RStrHTTPStatusErrorFmt, [AHttpStatusCode]), ', ', AReason), ', ', msg)
  else
   Result := GMStringJoin(GMFormat(RStrUnknownHTTPStatusCodeFmt, [AHttpStatusCode]), ': ', AReason);
end;

procedure GMParseHttpStartLine(const AStatusString: TGMString; var AHttpVersion, AStatusCode, AReason: TGMString);
var chPos: PtrInt;
begin
  chPos := 1;
  AHttpVersion := GMNextWord(chPos, AStatusString, cWhiteSpace);
  AStatusCode := GMNextWord(chPos, AStatusString, cWhiteSpace);
  AReason := Copy(AStatusString, chPos, Length(AStatusString) - chPos + 1);
end;

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

function IsIP6Address(const AAddress: TGMString): Boolean;
begin
  Result := GMStrLScan(PGMChar(AAddress), ':', Length(AAddress)) <> nil;
end;

function BuildHostHeaderValue(const AHost, APort: TGMString): TGMString;
begin
  Result := AHost;
  if Length(Result) <= 0 then Exit;
  if IsIP6Address(Result) then Result := GMQuote(Result, '[', ']');
  if not GMSameText(APort, vDfltHttpPort) then Result := Result + ':' + APort;
end;

//function GMIsHttpSuccessStatus(const AStatusCode: TGMString): Boolean;
//begin
//Result := GMIsHttpSuccessStatus();
//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 ARequestContentType: TGMString): RGMRequestResult;
var uriParts: RGMUriComponents; session: IGMHttpClientSession;
begin
  if Length(AUri) <= 0 then raise EGMHttpException.ObjError(RStrNoUri, nil, 'GMExecuteHttpRequest');
  uriParts := GMParseUri(AUri);
  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!
  //
  Result := session.ExecuteRequest(nil, GMBuildUri('', '', '', '', '', uriParts.Path, uriParts.Query, uriParts.Fragment),
                                   AHttpMethod, AReuestContent, ARequestContentType)
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 uriParts: RGMUriComponents; session: IGMHttpClientSession; requestContent: ISequentialStream; multiPartBoundary: AnsiString;
begin
  if Length(AUri) <= 0 then raise EGMHttpException.ObjError(RStrNoUri, nil, 'GMExecHttpPostValues');
  uriParts := GMParseUri(AUri);
  session := TGMHttpClientSession.Create(AAskCanceled, AAskLoginData, nil, AUserName, APassword, ACertificateData);

  multiPartBoundary := 'C3006447922B4499997877A2E5CB41E5';

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

  session.ConnectTransportLayer(uriParts.Scheme, uriParts.Host, uriParts.Port);
  Result := session.ExecuteRequest(nil, GMBuildUri('', '', '', '', '', uriParts.Path, uriParts.Query, uriParts.Fragment),
                                   cHttpMethoddPOST, requestContent, 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;


{ -------------------------- }
{ ---- 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 AUserName, APassword: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FUserName := AUserName;
  FPassword := APassword;
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
    FillChar(loginData, SizeOf(loginData), 0);
    GMHrCheckObj(getLoginData.GetHttpLoginData(@loginData), Self, 'GetHttpLoginData');
    FUserName := loginData.UserName;
    FPassword := loginData.Password;
   end;

  Result := not GMSameText(FLastUserName, FUserName) or not 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;

procedure TGMHttpClientBasicAuthenticationHandler.AddAuthorizationHeader(const AHeaders: IGMIntfCollection);
begin
  if Length(FUserName) > 0 then GMAddINetHeader(AHeaders, cHttpAuthorization, 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);
end;

procedure TGMHttpClientNTLMAuthenticationHandler.AddAuthorizationHeader(const AHeaders: IGMIntfCollection);
begin
  case FNTLMAuthSate of
   0: ; // <- Nothing!
   1: GMAddINetHeader(AHeaders, cHttpAuthorization, cHttpAuthNTLM + ' ' + BuildNTLMClientStartMsg);
   2: begin
       GMAddINetHeader(AHeaders, cHttpAuthorization, 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(RStrInvalidNTLMAuthState, [FNTLMAuthSate]), Self, 'AddAuthorizationHeader');
  end;
end;

function TGMHttpClientNTLMAuthenticationHandler.ProcessAuthDenied(const AResponseHeaders: IGMIntfCollection; const ARequestRetryCount: Integer; const AAskLoginData: IUnknown): Boolean;
const cStrMethodName = 'ProcessAuthDenied';
var challengeData: TGMString;
  function FindServerNtlmChallengeData(const AResponseHeaders: IGMIntfCollection): TGMString;
  var headerIt: IGMIterator; unkHeader: IUnknown; hdrVal: IGMGetStringValue; hdrStrVal, token: TGMString; chPos: PtrInt;
  begin
    Result := '';
    if AResponseHeaders = nil then Exit;
    headerIt := TGMInetHeaderIterator.Create(AResponseHeaders.CreateIterator, cHttpWwwAuthenticate);
    while headerIt.NextEntry(unkHeader) do
     if GMQueryInterface(unkHeader, IGMGetStringValue, hdrVal) then
      begin
       hdrStrVal := hdrVal.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(RStrNTLMServerChallengeMsgMissing, Self, cStrMethodName);

         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(RStrInvalidNTLMProtocolName, [FServerResponse.Protocol]), Self, cStrMethodName);

         if FServerResponse.MSgKind <> 2 then
            raise EGMHttpException.ObjError(GMFormat(RStrInvalidNTLMMsgKind, [Integer(FServerResponse.MSgKind)]), Self, cStrMethodName);
        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 FIsUsingTlsLayer then Result := GMUpperCase(cStrHttps) else Result := GMUpperCase(cStrHttp);
end;

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

//procedure TGMHttpRequestBase.AssignStreamContentSize(const AStream: ISequentialStream; const AHeaders: IGMIntfCollection);
//begin
//  if not IsChunkedTransfer(AHeaders) then GMSetReadContentSize(AStream, GMGetINetHeaderIntValue(AHeaders, cHttpContentLength, 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;
const cStrMethodName = 'BuildDecodeStreamChain';
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(RStrUnsupportedDecoding, [token]), Self, cStrMethodName)
    else
     begin
      GMCheckQueryInterface(foundElement, IGMHttpTransferDecoder, decoder, cStrMethodName);
      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);
    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 AMethod, AUri: AnsiString;
  const ARequestContent: ISequentialStream; const ARequestContentType: TGMString; const AOnUploadProgressProc: TGMOnProgressProc;
  const AUploadBuffersize: LongInt; const AIsUsingTlsLayer: Boolean): RGMRequestResult;
var methodHdrA: AnsiString; contentStr, statusLine: TGMString; contentInfo: IGMHttpContentInfo;
begin
  Result := Default(RGMRequestResult);
  FIsUsingTlsLayer := AIsUsingTlsLayer;
  methodHdrA := GMUpperCaseA(GMDeleteCharsA(AMethod, cWhiteSpace)) + ' ' + AUri + ' ' + GMUpperCaseA(cStrHttp) + '/' + vDfltHttpProtocolVersion;

  AddStandardHeaders;

  GMAddINetHeader(HeadersToSend, cHttpContentLength, GMIntToStr(GMIStreamSize(ARequestContent)), hamAddIfNew); // <- a PUT request may already have added a content length!
  if Length(ARequestContentType) > 0 then GMAddINetHeader(HeadersToSend, cHttpContentType, ARequestContentType);

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

  vfGMTrace(methodHdrA, ProtocolDisplayName);

  contentStr := GMGetIntfText(ARequestContent);
  if Length(contentStr) > 0 then vfGMTrace(contentStr, cStrContent);

  GMSafeIStreamWrite(ATransportLayer, PAnsiChar(methodHdrA), Length(methodHdrA), 'Sending HTTP request headers');
  GMCopyIStream(ARequestContent, ATransportLayer, AUploadBufferSize, AOnUploadProgressProc, 'Sending HTTP request content');

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

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

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

procedure TGMHttpClientRequest.CheckResponseStatus(const ATransportLayer: ISequentialStream; const AResponseStatus: TGMString; var AStatusCode: LongInt);
const cStrMethodName = 'CheckResponseStatus';
var httpVersion, statusCode, reason, postFix: TGMString; // statusInt: LongInt;
begin
  GMParseHttpStartLine(AResponseStatus, httpVersion, statusCode, reason);

  if not GMSameText(Copy(httpVersion, 1, Length(cStrHttp)), cStrHttp) then
     raise EGMHttpException.ObjError(RStrServerResponseNotHttp, Self, cStrMethodName);

  AStatusCode := GMStrToInt(GMMakeDezInt(statusCode, cDfltHttpErrorCode));

  if not GMIsHttpSuccessStatus(AStatusCode) then
   begin
    postFix := ConsumeContent(ATransportLayer);
    raise EGMHttpException.HttpError(AStatusCode, reason, postFix, Self, cStrMethodName);
   end;
end;


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

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

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

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

procedure TGMHttpClientSession.DisconnectTransportLayer;
begin
  if (FAuthenticationHandler <> nil) and (FTransportLayerConnection <> nil) then FAuthenticationHandler.OnTransportLayerDisconnected;
  FTransportLayerConnection := nil;
  FIsUsingTlsLayer := False;
end;

function TGMHttpClientSession.ConnectTransportLayer(AProtocol, AHost, APort: TGMString): IGMSocketIO;
const cStrMethodName = 'ConnectTransportLayer';
var  socket: IGMSocket;
begin
  if Length(AProtocol) <= 0 then AProtocol := cStrHttp;

  if Length(APort) <= 0 then
   {$IFDEF TLS_SUPPORT}
    if GMSameText(AProtocol, cStrHttps) then APort := cDfltHttpsPort else APort := vDfltHttpPort;
   {$ELSE}
    APort := vDfltHttpPort;
   {$ENDIF}

  if not (GMSameText(FProtocol, AProtocol) and GMSameText(FHost, AHost) and GMSameText(FPort, APort)) then
   begin
    DisconnectTransportLayer;

    if not GMSameText(AProtocol, cStrHttp) {$IFDEF TLS_SUPPORT}and not GMSameText(AProtocol, cStrHttps){$ENDIF} then
      raise EGMHttpException.ObjError(GMFormat(RStrUnsupportedINetProtocol, [AProtocol]), Self, cStrMethodName)
    else
     begin
      socket := TGMTcpSocket.Create(vDfltInetAddrFamily, FAskCanceled);
      socket.Connect(AHost, APort);
      {$IFDEF TLS_SUPPORT}
      if not GMSameText(AProtocol, cStrHttps) then FTransportLayerConnection := socket else
        begin
         FTransportLayerConnection := GMAddTlsLayer(socket, FCertificateStatusNotifySink, FCertificateData);
         FIsUsingTlsLayer := True;
        end;
      {$ELSE}
      FTransportLayerConnection := socket;
      {$ENDIF}
     end;

    FProtocol := AProtocol; FHost := AHost; FPort := APort;
   end;
  Result := FTransportLayerConnection;
end;

procedure TGMHttpClientSession.CreateAuthentificationHandler(const AHeaders: IGMIntfCollection; const AUserName, APassword: TGMString);
const cStrMethodName = 'CreateAuthentificationHandler';
var searchName, unkEntry: IUnknown; getName: IGMGetName; getValue: IGMGetStringValue; allHandlerClasses, supportedHandlerClasses: IGMIntfCollection;
    authSchemeHandlerClass: IGMGetHttpClientAuthSchemeHandlerClass; it: IGMIterator; authScheme, unsupportedAuthSchemes: TGMString;
  procedure CreateAuthHandler(const AAuthenticationHandlerClass: TGMHttpClientAuthenticationHandlerClass; const AAuthSchemeName: TGMString);
  begin
    //
    // Better allow changing the authentication handler
    //
//  if FAuthenticationHandler <> nil then
//   begin
//    if not GMSameText(AAuthSchemeName, FAuthenticationHandler.AuthSchemeName) then
//       raise EGMHttpException.ObjError(GMFormat(RStrHttpAuthSchemeChangeFmt, [FAuthenticationHandler.AuthSchemeName, AAuthSchemeName]), Self, cStrMethodName);
//   end
//  else
    if (AAuthenticationHandlerClass <> nil) and
       ((FAuthenticationHandler = nil) or (FAuthenticationHandler.GetClassType <> AAuthenticationHandlerClass)) then
      FAuthenticationHandler := AAuthenticationHandlerClass.Create(AUserName, APassword, True);
  end;
begin
  if AHeaders = nil then Exit;

  unsupportedAuthSchemes := '';
  allHandlerClasses := RegisterHttpClientAuthHanlderClasses;

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

  it := AHeaders.CreateIterator;
  while it.NextEntry(unkEntry) do
   begin
    if not GMQueryInterface(unkEntry, IGMGetName, getName) or
       not GMQueryInterface(unkEntry, IGMGetStringValue, getValue) or
       not GMSameText(getName.Name, cHttpWwwAuthenticate) then Continue;

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

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

  if (supportedHandlerClasses.IsEmpty) and (Length(unsupportedAuthSchemes) > 0) then
     raise EGMHttpException.ObjError(GMFormat(RStrHttpAuthSchmeNotImplFmt, [unsupportedAuthSchemes]), Self, cStrMethodName);

//if supportedHandlerClasses.IsEmpty then FAuthenticationHandler := nil else
  if not supportedHandlerClasses.IsEmpty then
   begin
    GMCheckQueryInterface(supportedHandlerClasses.First, IGMGetHttpClientAuthSchemeHandlerClass, authSchemeHandlerClass, cStrMethodName);
    CreateAuthHandler(authSchemeHandlerClass.GetAuthSchemeHandlerClass, GMGetIntfName(authSchemeHandlerClass));
   end; 
end;

function TGMHttpClientSession.ExecuteRequest(AHttpRequest: IGMHttpClientRequest; APath, AHttpMethod: TGMString; const ARequestContent: ISequentialStream;
    const ARequestContentType: TGMString; const AOnUploadProgressProc: TGMOnProgressProc; const AUploadBuffersize: LongInt): RGMRequestResult;
const cStrMethodName = 'ExecuteRequest';
var deniedCount, redirectCount: Integer; requestContentStartPos: Int64; 
  procedure Connect(const AProtocol, AHost, APort: TGMString);
  var oldConnection: IGMSocketIO;
  begin
    oldConnection := FTransportLayerConnection;
    ConnectTransportLayer(AProtocol, AHost, APort);
    if oldConnection <> FTransportLayerConnection then Result.ResponseContent := nil;
  end;
  procedure ResetRequest;
  begin
    GMSetIStreamAbsPos(ARequestContent, requestContentStartPos, cStrMethodName);
    GMSetReadContentSize(Result.ResponseContent, cStrmSizeUnlimited); // <- No Limit when reading headers of next response!
    AHttpRequest.Obj.ReceivedHeaders.Clear;
  end;
  procedure Redirect(const AUri: TGMString);
  var uriParts: RGMUriComponents;
  begin
    if Length(AUri) <= 0 then raise EGMHttpException.ObjError(RStrNoRedirectionUri, Self, cStrMethodName);
    uriParts := GMParseUri(AUri);
    if Length(uriParts.Host) > 0 then Connect(uriParts.Scheme, uriParts.Host, uriParts.Port);
    APath := GMBuildUri('', '', '', '', '', uriParts.Path, uriParts.Query, uriParts.Fragment);
  end;
  procedure ReConnectTransportLayer;
  var protocol, host, port: TGMString;
  begin
    protocol := FProtocol; host := FHost; port := FPort;
    FProtocol := ''; FHost := ''; FPort := '';
    Connect(protocol, host, port);
  end;
begin
  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 := cHttpMethoddGET;

  if AHttpRequest = nil then AHttpRequest := TGMHttpClientRequest.Create(cGMHttpAgent);
  requestContentStartPos := GMIStreamPos(ARequestContent);

  APath := GMUriEncode(APath);
  redirectCount := 0; deniedCount := 0;
  repeat
   try
    if not IsTransportLayerConnected and (Length(FHost) > 0) then ReConnectTransportLayer; // and (Length(FProtocol) > 0)

    if not IsTransportLayerConnected then raise EGMHttpException.ObjError(RStrTranspoerLayerNotConnected, Self, cStrMethodName);

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

    GMAddINetHeader(AHttpRequest.Obj.HeadersToSend, 'Host', BuildHostHeaderValue(FHost, FPort));
    if FAuthenticationHandler <> nil then FAuthenticationHandler.AddAuthorizationHeader(AHttpRequest.Obj.HeadersToSend);

    try
     Result := AHttpRequest.Obj.InternalExecute(Result.ResponseContent, AHttpMethod, APath, ARequestContent, ARequestContentType, AOnUploadProgressProc, AUploadBuffersize, FIsUsingTlsLayer);
    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
    case GMExtractHttpCodeFromHResult(GMGetObjHrCode(GMExceptObject)) of
     HTTP_STATUS_DENIED:
      begin
       Inc(deniedCount);
       CreateAuthentificationHandler(AHttpRequest.Obj.ReceivedHeaders, FUserName, FPassword);
       if FAuthenticationHandler = nil then raise;
       if not FAuthenticationHandler.ProcessAuthDenied(AHttpRequest.Obj.ReceivedHeaders, deniedCount, FAskLoginData) then raise;
       ResetRequest;
      end;

     HTTP_STATUS_MOVED, HTTP_STATUS_REDIRECT, HTTP_STATUS_REDIRECT_KEEP_VERB:
      begin
       Inc(redirectCount);
       if redirectCount > vMaxHttpRedirectCount then raise EGMHttpException.ObjError(GMFormat(RStrTooManyRedirects, [redirectCount]), Self, cStrMethodName);
       Redirect(GMGetINetHeaderStrValue(AHttpRequest.Obj.ReceivedHeaders, cStrHttpLocation, '', True));
       ResetRequest;
      end;

     else
      if not GMIsSocketReConnectErrorCode(GMGetObjHRCode(exceptObject)) then raise else
       begin
        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), RStrTheProtocolObj, Self);
end;

procedure TGMHttpChunkedStream.ReadChunk; // : Boolean;
const cStrMethodName = 'TGMHttpChunkedStream.ReadChunk';
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, cStrMethodName);
    SetLength(term, 2);
    GMSafeIStreamRead(FChainedStream, PAnsiChar(term), Length(term), cStrMethodName);
    if term <> CRLF then raise EGMHttpException.ObjError(RStrInvalidHttpChunkTerm+': '+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);
   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;


initialization

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

end.