{ +-------------------------------------------------------------+ } { | | } { | 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, GMHttpConst, GMSockets {$IFDEF HTTP_ZIP_SUPPORT}, GMZStrm{$ENDIF} {$IFDEF TLS_SUPPORT},GMNtlm{$ENDIF} ; const cDfltHttpErrorCode = 0; 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; const AResponseContentInErrMsg: 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 AResponseContentInErrMsg: Boolean = True; 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 AResponseContentInErrMsg: Boolean = True; 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; //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 = []; const AResponseContentInErrMsg: Boolean = True): RGMRequestResult; procedure GMParseHttpStartLine(const AStartLine: TGMString; var AToken1, AToken2, AToken3: TGMString); function GMHttpStatusCodeFromString(const AHttpStatusCode: TGMString): LongInt; 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'; //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"'; 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(scHttpAuthBasic, 1, TGMHttpClientBasicAuthenticationHandler)); {$IFDEF TLS_SUPPORT} vHttpClientAuthHandlerClasses.Add(TGMHttpClientAuthSchemeHandlerClassEntry.Create(scHttpAuthNTLM, 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(scHttpChunked, True)); {$IFDEF HTTP_ZIP_SUPPORT} vHttpTransferDecoders.Add(TGMHttpZIPTransferDecoder.Create(scHttpDeflate, True)); vHttpTransferDecoders.Add(TGMHttpZIPTransferDecoder.Create(scHttpGZip, True)); {$ENDIF} end; Result := vHttpTransferDecoders; finally if vCSRegisterHttpTransferDecoders <> nil then vCSRegisterHttpTransferDecoders.LeaveCriticalSection; 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 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; 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 GMExecuteHttpRequest(const AUri: TGMString; const AAskCanceled, AAskLoginData: IUnknown; const AHttpMethod, AUserName, APassword: TGMString; const AReuestContent: ISequentialStream; const AAdditionalHeaders: TGMNameAndStrValArray; const AResponseContentInErrMsg: Boolean): 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, AResponseContentInErrMsg); 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: '+scMimeFormData+'; 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 := Utf8Encode(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 := TGMByteStringIStream.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), scHttpMethodPOST, requestContent, [InitRGMNameAndStrValue('Content-Type', scMimeMultiPart+'/'+scMimeFormData+'; boundary='+multiPartBoundary)]); //'Content-Type: '+scMimeMultiPart+'/'+scMimeFormData+'; 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; { -------------------------------------------------- } { ---- 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 := scHttpProxyAuthorization else Result := scHttpAuthorization; 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 := scHttpAuthBasic; 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, scHttpAuthBasic + ' ' + GMEncodeBase64Str(FUserName + ':' + FPassword)); inherited; end; { ------------------------------------------------ } { ---- TGMHttpClientNTLMAuthenticationHandler ---- } { ------------------------------------------------ } {$IFDEF TLS_SUPPORT} function TGMHttpClientNTLMAuthenticationHandler.AuthSchemeName: TGMString; begin Result := scHttpAuthNTLM; 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, scHttpAuthNTLM + ' ' + BuildNTLMClientStartMsg); 2: begin GMAddINetHeader(AHeaders, AuthorizationHeaderName, scHttpAuthNTLM + ' ' + 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, scHttpTransferEncoding); // Result := GMHasToken(hdrValue, scHttpChunked, 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, scHttpTransferEncoding); // if additional encodings have been applied, "chunked" MUST be applied too! if GMHasToken(codingHdrValue, scHttpChunked, cStrINetHeaderWordSeparators) then len := cStrmSizeUnlimited else len := GMGetINetHeaderIntValue(AHeaders, scHttpContentLength, cStrmSizeUnlimited); GMSetReadContentSize(ATransportLayer, len); end; //function TGMHttpClientRequest.BuildErrorMsgPostfixFromResponseContent(const AResponseContent: ISequentialStream): TGMString; //const cMaxLen = 8192; //var contentType: TGMString; getByteText: IGMGetByteText; byteText: RawByteString; // function IsPrintableText(const AText: RawByteString): 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, IGMGetByteText, getByteText) then // begin // contentType := GMGetINetHeaderStrValue(ReceivedHeaders, scHttpContentType); // byteText := Copy(getByteText.GetByteText, 1, cMaxLen); // if IsPrintableText(byteText) then // case GMCharCodingOfContentType(contentType) of // ckUtf8: Result := Utf8Decode(byteText); // else Result := byteText; // end; // end; // // //Result := inherited BuildErrorMsgPostfixFromResponseContent(AResponseContent); //end; function TGMHttpClientRequest.BuildDecodeStreamChain(const ATransportLayer: ISequentialStream): ISequentialStream; var codingHdrVal, token: TGMString; chPos: PtrInt; searchName: RGMNameRec; foundElement: IUnknown; decoders: IGMIntfCollection; decoder: IGMHttpTransferDecoder; srcStrm: ISequentialStream; begin Result := ATransportLayer; codingHdrVal := GMGetINetHeaderStrValue(ReceivedHeaders, scHttpTransferEncoding); 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.Name := 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 searchName: RGMNameRec; procedure AddTEHeader; const abnfListSep = ', '; var hdrVal: TGMString; begin hdrval := GMSeparatedNames(RegisterHttpTransferDecoders, abnfListSep); hdrval := GMStringJoin(scHttpTrailers, abnfListSep, hdrval); GMAddINetHeader(HeadersToSend, scHttpTE, hdrval); end; begin //if FUseProxy then cnPrefix := 'Proxy-' else cnPrefix := ''; if FKeepConnection then begin //GMAddINetHeader(HeadersToSend, scHttpConnection, scHttpKeepAlive); // <- In http 1.1 connections are persistent by default! if FKeepConnectionTimeout > 0 then GMAddINetHeader(HeadersToSend, scHttpKeepAlive, FKeepConnectionTimeout); end else begin GMAddINetHeader(HeadersToSend, scHttpConnection, scHttpClose); searchName.Name := scHttpKeepAlive; while HeadersToSend.RemoveByKey(searchName) do ; end; if Length(FAgentName) > 0 then GMAddINetHeader(HeadersToSend, scHttpUserAgent, 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; const AResponseContentInErrMsg: Boolean): RGMRequestResult; var startLine, path, requestContentStr, errMsgPostFix, contentType: TGMString; startLineA: AnsiString; contentInfo: IGMHttpContentInfo; responseStatus: RGMResponseHttpStaus; headerEntry: RGMNameAndStrValue; begin Result := Default(RGMRequestResult); Result.Request := Self; FUsingTlsLayer := AUsingTlsLayer; if GMSameText(AMethod, scHttpMethodCONNECT) 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, scHttpContentLength, 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, scHttpContentType, 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, scHttpMethodHEAD) 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, scHttpContentType)); contentInfo.SetContentEncoding(GMGetINetHeaderStrValue(ReceivedHeaders, scHttpContentEncoding)); 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 contentType := GMGetINetHeaderStrValue(ReceivedHeaders, scHttpContentType); errMsgPostFix := GMConsumeContent(Result.ResponseContent, contentType, AResponseContentInErrMsg); 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, scHttpMethodCONNECT); 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: RGMNameRec; 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.Name := 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 AResponseContentInErrMsg: Boolean; 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 := scHttpMethodGET; 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, AResponseContentInErrMsg); finally if GMSameText(GMGetINetHeaderStrValue(AHttpRequest.Obj.ReceivedHeaders, scHttpConnection), scHttpClose) 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, scHttpLocation, '', True)); //ResetRequest; end; HTTP_STATUS_USE_PROXY: begin IncrementAndCheckRedirectCount; tmpUri := GMGetINetHeaderStrValue(AHttpRequest.Obj.ReceivedHeaders, scHttpLocation, '', 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, scHttpContentLength, '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.