3060 lines
105 KiB
Plaintext
3060 lines
105 KiB
Plaintext
|
{
|
|||
|
|
$Project$
|
|||
|
|
$Workfile$
|
|||
|
|
$Revision$
|
|||
|
|
$DateUTC$
|
|||
|
|
$Id$
|
|||
|
|
|
|||
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|||
|
|
under the dual-licensing agreement described on the Indy website.
|
|||
|
|
(http://www.indyproject.org/)
|
|||
|
|
|
|||
|
|
Copyright:
|
|||
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|||
|
|
}
|
|||
|
|
{
|
|||
|
|
$Log$
|
|||
|
|
}
|
|||
|
|
{
|
|||
|
|
Rev 1.65 3/5/2005 3:33:52 PM JPMugaas
|
|||
|
|
Fix for some compiler warnings having to do with TStream.Read being platform
|
|||
|
|
specific. This was fixed by changing the Compressor API to use TIdStreamVCL
|
|||
|
|
instead of TStream. I also made appropriate adjustments to other units for
|
|||
|
|
this.
|
|||
|
|
|
|||
|
|
Rev 1.64 2/13/2005 3:09:20 PM DSiders
|
|||
|
|
Modified TIdCustomHTTP.PrepareRequest to free the local URI instance if an
|
|||
|
|
exception occurs in the method. (try...finally)
|
|||
|
|
|
|||
|
|
Rev 1.63 2/11/05 11:29:34 AM RLebeau
|
|||
|
|
Removed compiler warning
|
|||
|
|
|
|||
|
|
Rev 1.62 2/9/05 2:12:08 AM RLebeau
|
|||
|
|
Fixes for Compiler errors
|
|||
|
|
|
|||
|
|
Rev 1.61 2/8/05 6:43:42 PM RLebeau
|
|||
|
|
Added OnHeaderAvailable event
|
|||
|
|
|
|||
|
|
Rev 1.60 1/11/05 1:25:08 AM RLebeau
|
|||
|
|
More changes to SetHostAndPort()
|
|||
|
|
|
|||
|
|
Rev 1.59 1/6/05 2:28:52 PM RLebeau
|
|||
|
|
Fix for SetHostAndPort() not using its local variables properly
|
|||
|
|
|
|||
|
|
Rev 1.58 06/01/2005 22:23:04 CCostelloe
|
|||
|
|
Bug fix (typo, gizp instead of gzip)
|
|||
|
|
|
|||
|
|
Rev 1.57 05/12/2004 23:10:58 CCostelloe
|
|||
|
|
Recoded fix to suit Delphi < 7
|
|||
|
|
|
|||
|
|
Rev 1.56 30/11/2004 23:46:12 CCostelloe
|
|||
|
|
Bug fix for SSL connections giving a "Connection closed gracefully" exception
|
|||
|
|
and requested page not getting returned (IOHandler.Response is empty)
|
|||
|
|
|
|||
|
|
Rev 1.55 25/11/2004 21:28:06 CCostelloe
|
|||
|
|
Bug fix for POSTing fields that have the same name
|
|||
|
|
|
|||
|
|
Rev 1.54 10/26/2004 10:13:24 PM JPMugaas
|
|||
|
|
Updated refs.
|
|||
|
|
|
|||
|
|
Rev 1.53 7/16/04 1:19:20 AM RLebeau
|
|||
|
|
Fix for compiler error
|
|||
|
|
|
|||
|
|
Rev 1.52 7/15/04 8:19:30 PM RLebeau
|
|||
|
|
Updated TIdHTTPProtocol.ProcessResponse() to treat 302 redirects like 303.
|
|||
|
|
|
|||
|
|
Updated TIdHTTPProtocol.BuildAndSendRequest() to use a try...except block
|
|||
|
|
|
|||
|
|
Rev 1.51 6/17/2004 8:30:04 AM DSiders
|
|||
|
|
TIdCustomHTTP modified:
|
|||
|
|
- Fixed error in AuthRetries property reading wrong member var.
|
|||
|
|
- Added AuthProxyRetries and MaxAuthRetries properties to public interface.
|
|||
|
|
|
|||
|
|
TIdHTTP modified to publish AuthRetries, AuthProxyRetries, and MaxAuthRetries.
|
|||
|
|
|
|||
|
|
TIdHTTPProtocol.ProcessResponse modified to use public properties
|
|||
|
|
AuthRetries, AuthProxyRetries, and MaxAutrhRetries.
|
|||
|
|
|
|||
|
|
Rev 1.50 2004.05.20 11:36:46 AM czhower
|
|||
|
|
IdStreamVCL
|
|||
|
|
|
|||
|
|
Rev 1.49 4/28/04 1:45:26 PM RLebeau
|
|||
|
|
Updated TIdCustomHTTP.SetRequestParams() to strip off the trailing CRLF
|
|||
|
|
before encoding rather than afterwards
|
|||
|
|
|
|||
|
|
Rev 1.48 2004.04.07 11:18:08 PM czhower
|
|||
|
|
Bug and naming fix.
|
|||
|
|
|
|||
|
|
Rev 1.47 7/4/2004 6:00:02 PM SGrobety
|
|||
|
|
Reformatted to match project guidelines
|
|||
|
|
|
|||
|
|
Rev 1.46 7/4/2004 4:58:24 PM SGrobety
|
|||
|
|
Reformatted to match project guidelines
|
|||
|
|
|
|||
|
|
Rev 1.45 6/4/2004 5:16:40 PM SGrobety
|
|||
|
|
Added AMaxHeaderCount: integer parameter to TIdHTTPProtocol.RetrieveHeaders
|
|||
|
|
and MaxHeaderLines property to TIdCustomHTTP (default to 255)
|
|||
|
|
|
|||
|
|
Rev 1.44 2004.03.06 10:39:52 PM czhower
|
|||
|
|
Removed duplicate code
|
|||
|
|
|
|||
|
|
Rev 1.43 2004.03.06 8:56:30 PM czhower
|
|||
|
|
-Change to disconnect
|
|||
|
|
-Addition of DisconnectNotifyPeer
|
|||
|
|
-WriteHeader now write bufers
|
|||
|
|
|
|||
|
|
Rev 1.42 3/3/2004 5:58:00 AM JPMugaas
|
|||
|
|
Some IFDEF excluses were removed because the functionality is now in DotNET.
|
|||
|
|
|
|||
|
|
Rev 1.41 2004.02.23 9:33:12 PM czhower
|
|||
|
|
Now can optionally ignore response codes for exceptions.
|
|||
|
|
|
|||
|
|
Rev 1.40 2/15/2004 6:34:02 AM JPMugaas
|
|||
|
|
Fix for where I broke the HTTP client with a parameter change in the GZip
|
|||
|
|
decompress method.
|
|||
|
|
|
|||
|
|
Rev 1.39 2004.02.03 5:43:44 PM czhower
|
|||
|
|
Name changes
|
|||
|
|
|
|||
|
|
Rev 1.38 2004.02.03 2:12:10 PM czhower
|
|||
|
|
$I path change
|
|||
|
|
|
|||
|
|
Rev 1.37 2004.01.27 11:41:18 PM czhower
|
|||
|
|
Removed const arguments
|
|||
|
|
|
|||
|
|
Rev 1.35 24/01/2004 19:22:34 CCostelloe
|
|||
|
|
Cleaned up warnings
|
|||
|
|
|
|||
|
|
Rev 1.34 2004.01.22 5:29:02 PM czhower
|
|||
|
|
TextIsSame
|
|||
|
|
|
|||
|
|
Rev 1.33 2004.01.21 1:04:50 PM czhower
|
|||
|
|
InitComponenet
|
|||
|
|
|
|||
|
|
Rev 1.32 1/2/2004 11:41:48 AM BGooijen
|
|||
|
|
Enabled IPv6 support
|
|||
|
|
|
|||
|
|
Rev 1.31 22/11/2003 12:04:28 AM GGrieve
|
|||
|
|
Add support for HTTP status code 303
|
|||
|
|
|
|||
|
|
Rev 1.30 10/25/2003 06:51:58 AM JPMugaas
|
|||
|
|
Updated for new API changes and tried to restore some functionality.
|
|||
|
|
|
|||
|
|
Rev 1.29 2003.10.24 10:43:08 AM czhower
|
|||
|
|
TIdSTream to dos
|
|||
|
|
|
|||
|
|
Rev 1.28 24/10/2003 10:58:40 AM SGrobety
|
|||
|
|
Made authentication work even if no OnAnthenticate envent handler present
|
|||
|
|
|
|||
|
|
Rev 1.27 10/18/2003 1:53:10 PM BGooijen
|
|||
|
|
Added include
|
|||
|
|
|
|||
|
|
Rev 1.26 10/17/2003 12:08:48 AM DSiders
|
|||
|
|
Added localization comments.
|
|||
|
|
|
|||
|
|
Rev 1.25 2003.10.14 1:27:52 PM czhower
|
|||
|
|
DotNet
|
|||
|
|
|
|||
|
|
Rev 1.24 10/7/2003 11:33:54 PM GGrieve
|
|||
|
|
Get works under DotNet
|
|||
|
|
|
|||
|
|
Rev 1.23 10/7/2003 10:07:04 PM GGrieve
|
|||
|
|
Get HTTP compiling for DotNet
|
|||
|
|
|
|||
|
|
Rev 1.22 10/4/2003 9:15:58 PM GGrieve
|
|||
|
|
fix to compile
|
|||
|
|
|
|||
|
|
Rev 1.21 9/26/2003 01:41:48 PM JPMugaas
|
|||
|
|
Fix for problem wihere "identity" was being added more than once to the
|
|||
|
|
accepted encoding contents.
|
|||
|
|
|
|||
|
|
Rev 1.20 9/14/2003 07:54:20 PM JPMugaas
|
|||
|
|
Published the Compressor property.
|
|||
|
|
|
|||
|
|
Rev 1.19 7/30/2003 05:34:22 AM JPMugaas
|
|||
|
|
Fix for bug where decompression was not done if the Content Length was
|
|||
|
|
specified. I found that at http://www.news.com.
|
|||
|
|
Added Identity to the content encoding to be consistant with Opera. Identity
|
|||
|
|
is the default Accept-Encoding (RFC 2616).
|
|||
|
|
|
|||
|
|
Rev 1.18 7/13/2003 10:57:28 PM BGooijen
|
|||
|
|
Fixed GZip and Deflate decoding
|
|||
|
|
|
|||
|
|
Rev 1.17 7/13/2003 11:29:06 AM JPMugaas
|
|||
|
|
Made sure some GZIP decompression stub code is in IdHTTP.
|
|||
|
|
|
|||
|
|
Rev 1.15 10.7.2003 <20>. 21:03:02 DBondzhev
|
|||
|
|
Fixed NTML proxy authorization
|
|||
|
|
|
|||
|
|
Rev 1.14 6/19/2003 02:36:56 PM JPMugaas
|
|||
|
|
Removed a connected check and it seems to work better that way.
|
|||
|
|
|
|||
|
|
Rev 1.13 6/5/2003 04:53:54 AM JPMugaas
|
|||
|
|
Reworkings and minor changes for new Reply exception framework.
|
|||
|
|
|
|||
|
|
Rev 1.12 4/30/2003 01:47:24 PM JPMugaas
|
|||
|
|
Added TODO concerning a ConnectTimeout.
|
|||
|
|
|
|||
|
|
Rev 1.11 4/2/2003 3:18:30 PM BGooijen
|
|||
|
|
fixed av when retrieving an url when no iohandler was assigned
|
|||
|
|
|
|||
|
|
Rev 1.10 3/26/2003 5:13:40 PM BGooijen
|
|||
|
|
TIdSSLIOHandlerSocketBase.URIToCheck is now set
|
|||
|
|
|
|||
|
|
Rev 1.9 3/13/2003 11:05:26 AM JPMugaas
|
|||
|
|
Now should work with 3rd party vendor SSL IOHandlers.
|
|||
|
|
|
|||
|
|
Rev 1.8 3/11/2003 10:14:52 PM BGooijen
|
|||
|
|
Undid the stripping of the CR
|
|||
|
|
|
|||
|
|
Rev 1.7 2/27/2003 2:04:26 PM BGooijen
|
|||
|
|
If any call to iohandler.readln returns a CR at the end, it is removed now.
|
|||
|
|
|
|||
|
|
Rev 1.6 2/26/2003 11:50:08 AM BGooijen
|
|||
|
|
things were messed up in TIdHTTPProtocol.RetrieveHeaders, because the call to
|
|||
|
|
readln doesn't strip the CR at the end (terminator=LF), therefore the end of
|
|||
|
|
the header was not found.
|
|||
|
|
|
|||
|
|
Rev 1.5 2/26/2003 11:42:46 AM BGooijen
|
|||
|
|
changed ReadLn (IOerror 6) to IOHandler.ReadLn
|
|||
|
|
|
|||
|
|
Rev 1.4 2/4/2003 6:30:44 PM BGooijen
|
|||
|
|
Re-enabled SSL-support
|
|||
|
|
|
|||
|
|
Rev 1.3 1/17/2003 04:14:42 PM JPMugaas
|
|||
|
|
Fixed warnings.
|
|||
|
|
|
|||
|
|
Rev 1.2 12/7/2002 05:32:16 PM JPMugaas
|
|||
|
|
Now compiles with destination removed.
|
|||
|
|
|
|||
|
|
Rev 1.1 12/6/2002 05:29:52 PM JPMugaas
|
|||
|
|
Now decend from TIdTCPClientCustom instead of TIdTCPClient.
|
|||
|
|
|
|||
|
|
Rev 1.0 11/13/2002 07:54:12 AM JPMugaas
|
|||
|
|
|
|||
|
|
2001-Nov Nick Panteleeff
|
|||
|
|
- Authentication and POST parameter extentsions
|
|||
|
|
|
|||
|
|
2001-Sept Doychin Bondzhev
|
|||
|
|
- New internal design and new Authentication procedures.
|
|||
|
|
- Bug fixes and new features in few other supporting components
|
|||
|
|
|
|||
|
|
2001-Jul-7 Doychin Bondzhev
|
|||
|
|
- new property AllowCookie
|
|||
|
|
- There is no more ExtraHeders property in Request/Response. Raw headers is used for that purpose.
|
|||
|
|
|
|||
|
|
2001-Jul-1 Doychin Bondzhev
|
|||
|
|
- SSL support is up again - Thanks to Gregor
|
|||
|
|
|
|||
|
|
2001-Jun-17 Doychin Bondzhev
|
|||
|
|
- New unit IdHTTPHeaderInfo.pas that contains the
|
|||
|
|
TIdHeaderInfo(TIdEntytiHeaderInfo, TIdRequestHeaderInfo and TIdResponseHeaderInfo)
|
|||
|
|
- Still in development and not verry well tested
|
|||
|
|
By default when there is no authorization object associated with HTTP compoenet and there is user name and password
|
|||
|
|
HTTP component creates and instance of TIdBasicAuthentication class. This behaivor is for both web server and proxy server
|
|||
|
|
authorizations
|
|||
|
|
|
|||
|
|
2001-Apr-17 Doychin Bondzhev
|
|||
|
|
- Added OnProxyAuthorization event. This event is called on 407 response from the HTTP Proxy.
|
|||
|
|
- Added 2 new properties in TIdHeaderInfo
|
|||
|
|
property AuthenticationScheme: TIdAuthenticationScheme - this property contains information for authentication scheme
|
|||
|
|
requested by the web server
|
|||
|
|
property ProxyAuthenticationScheme: TIdAuthenticationScheme - this property contains information for authentication scheme
|
|||
|
|
requested by the proxy server
|
|||
|
|
- Now the component authomaticly reconginizes the requested authorization scheme and it supports Basic like before and has been
|
|||
|
|
extend to support Digest authorization
|
|||
|
|
|
|||
|
|
2001-Mar-31 Doychin Bondzhev
|
|||
|
|
- If there is no CookieManager it does not support cookies.
|
|||
|
|
|
|||
|
|
2001-Feb-18 Doychin Bondzhev
|
|||
|
|
- Added OnAuthorization event. This event is called on 401 response from the HTTP server.
|
|||
|
|
This can be used to ask the user program to supply user name and password in order to acces
|
|||
|
|
the requested resource
|
|||
|
|
|
|||
|
|
2001-Feb-02 Doychin Bondzhev
|
|||
|
|
- Added Cookie support and relative paths on redirect
|
|||
|
|
|
|||
|
|
2000-Jul-25 Hadi Hariri
|
|||
|
|
- Overloaded POst and moved clearing to disconect.
|
|||
|
|
|
|||
|
|
2000-June-22 Hadi Hariri
|
|||
|
|
- Added Proxy support.
|
|||
|
|
|
|||
|
|
2000-June-10 Hadi Hariri
|
|||
|
|
- Added Chunk-Encoding support and HTTP version number. Some additional
|
|||
|
|
improvements.
|
|||
|
|
|
|||
|
|
2000-May-23 J. Peter Mugaas
|
|||
|
|
-added redirect capability and supporting properties. Redirect is optional
|
|||
|
|
and is set with HandleRedirects. Redirection is limited to RedirectMaximum
|
|||
|
|
to prevent stack overflow due to recursion and to prevent redirects between
|
|||
|
|
two places which would cause this to go on to infinity.
|
|||
|
|
|
|||
|
|
2000-May-22 J. Peter Mugaas
|
|||
|
|
-adjusted code for servers which returned LF instead of EOL
|
|||
|
|
-Headers are now retreived before an exception is raised. This
|
|||
|
|
also facilitates server redirection where the server tells the client to
|
|||
|
|
get a document from another location.
|
|||
|
|
|
|||
|
|
2000-May-01 Hadi Hariri
|
|||
|
|
-Converted to Mercury
|
|||
|
|
|
|||
|
|
2000-May-01 Hadi Hariri
|
|||
|
|
-Added PostFromStream and some clean up
|
|||
|
|
|
|||
|
|
2000-Apr-10 Hadi Hariri
|
|||
|
|
-Re-done quite a few things and fixed GET bugs and finished POST method.
|
|||
|
|
|
|||
|
|
2000-Jan-13 MTL
|
|||
|
|
-Moved to the New Palette Scheme
|
|||
|
|
|
|||
|
|
2000-Jan-08 MTL
|
|||
|
|
-Cleaned up a few compiler hints during 7.038 build
|
|||
|
|
|
|||
|
|
1999-Dec-10 Hadi Hariri
|
|||
|
|
-Started.
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
unit IdHTTP;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Implementation of the HTTP protcol as specified in RFC 2616, 2109, 2965.
|
|||
|
|
(See NOTE below for details of what is exactly implemented)
|
|||
|
|
|
|||
|
|
Author: Hadi Hariri (hadi@urusoft.com)
|
|||
|
|
Copyright: (c) Chad Z. Hower and The Winshoes Working Group.
|
|||
|
|
|
|||
|
|
Initials: Hadi Hariri - HH
|
|||
|
|
}
|
|||
|
|
{
|
|||
|
|
TODO: Figure out what to do with ConnectTimeout.
|
|||
|
|
Ideally, that should be in the core and is not the same as a read Timeout.
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
{$I IdCompilerDefines.inc}
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
Classes,
|
|||
|
|
IdException, IdExceptionCore, IdAssignedNumbers, IdHeaderList, IdHTTPHeaderInfo, IdReplyRFC,
|
|||
|
|
IdSSL, IdZLibCompressorBase,
|
|||
|
|
IdTCPClient, IdURI, IdCookie, IdCookieManager, IdAuthentication, IdAuthenticationManager,
|
|||
|
|
IdMultipartFormData, IdGlobal, IdBaseComponent, IdUriUtils;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
// TO DOCUMENTATION TEAM
|
|||
|
|
// ------------------------
|
|||
|
|
// For internal use. No need of documentation
|
|||
|
|
// hmConnect - Used to connect trought CERN proxy to SSL enabled sites.
|
|||
|
|
TIdHTTPMethod = string;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
Id_HTTPMethodHead = 'HEAD';
|
|||
|
|
Id_HTTPMethodGet = 'GET';
|
|||
|
|
Id_HTTPMethodPost = 'POST';
|
|||
|
|
Id_HTTPMethodOptions = 'OPTIONS';
|
|||
|
|
Id_HTTPMethodTrace = 'TRACE';
|
|||
|
|
Id_HTTPMethodPut = 'PUT';
|
|||
|
|
Id_HTTPMethodDelete = 'DELETE';
|
|||
|
|
Id_HTTPMethodConnect = 'CONNECT';
|
|||
|
|
Id_HTTPMethodPatch = 'PATCH';
|
|||
|
|
//(hmHead, hmGet, hmPost, hmOptions, hmTrace, hmPut, hmDelete, hmConnect, hmPatch);
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TIdHTTPWhatsNext = (wnGoToURL, wnJustExit, wnDontKnow, wnReadAndGo, wnAuthRequest);
|
|||
|
|
TIdHTTPConnectionType = (ctNormal, ctSSL, ctProxy, ctSSLProxy);
|
|||
|
|
|
|||
|
|
// Protocol options
|
|||
|
|
TIdHTTPOption = (hoInProcessAuth, hoKeepOrigProtocol, hoForceEncodeParams,
|
|||
|
|
hoNonSSLProxyUseConnectVerb, hoNoParseMetaHTTPEquiv, hoWaitForUnexpectedData,
|
|||
|
|
hoTreat302Like303, hoNoProtocolErrorException, hoNoReadMultipartMIME);
|
|||
|
|
TIdHTTPOptions = set of TIdHTTPOption;
|
|||
|
|
|
|||
|
|
// Must be documented
|
|||
|
|
TIdHTTPProtocolVersion = (pv1_0, pv1_1);
|
|||
|
|
|
|||
|
|
TIdHTTPOnRedirectEvent = procedure(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod) of object;
|
|||
|
|
TIdHTTPOnHeadersAvailable = procedure(Sender: TObject; AHeaders: TIdHeaderList; var VContinue: Boolean) of object;
|
|||
|
|
TIdOnSelectAuthorization = procedure(Sender: TObject; var AuthenticationClass: TIdAuthenticationClass; AuthInfo: TIdHeaderList) of object;
|
|||
|
|
TIdOnAuthorization = procedure(Sender: TObject; Authentication: TIdAuthentication; var Handled: Boolean) of object;
|
|||
|
|
// TIdProxyOnAuthorization = procedure(Sender: TObject; Authentication: TIdAuthentication; var Handled: boolean) of object;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
Id_TIdHTTP_ProtocolVersion = pv1_1;
|
|||
|
|
Id_TIdHTTP_RedirectMax = 15;
|
|||
|
|
Id_TIdHTTP_MaxHeaderLines = 255;
|
|||
|
|
Id_TIdHTTP_HandleRedirects = False;
|
|||
|
|
Id_TIdHTTP_MaxAuthRetries = 3;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TIdCustomHTTP = class;
|
|||
|
|
|
|||
|
|
// TO DOCUMENTATION TEAM
|
|||
|
|
// ------------------------
|
|||
|
|
// The following classes are used internally and no need of documentation
|
|||
|
|
// Only TIdHTTP must be documented
|
|||
|
|
//
|
|||
|
|
TIdHTTPResponse = class(TIdResponseHeaderInfo)
|
|||
|
|
protected
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FHTTP: TIdCustomHTTP;
|
|||
|
|
FResponseCode: Integer;
|
|||
|
|
FResponseText: string;
|
|||
|
|
FKeepAlive: Boolean;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FContentStream: TStream;
|
|||
|
|
FResponseVersion: TIdHTTPProtocolVersion;
|
|||
|
|
FMetaHTTPEquiv : TIdMetaHTTPEquiv;
|
|||
|
|
//
|
|||
|
|
function GetKeepAlive: Boolean;
|
|||
|
|
function GetResponseCode: Integer;
|
|||
|
|
|
|||
|
|
procedure SetResponseText(const AValue: String);
|
|||
|
|
procedure ProcessMetaHTTPEquiv;
|
|||
|
|
public
|
|||
|
|
constructor Create(AHTTP: TIdCustomHTTP); reintroduce; virtual;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
procedure Clear; override;
|
|||
|
|
property KeepAlive: Boolean read GetKeepAlive write FKeepAlive;
|
|||
|
|
property MetaHTTPEquiv: TIdMetaHTTPEquiv read FMetaHTTPEquiv;
|
|||
|
|
property ResponseText: string read FResponseText write SetResponseText;
|
|||
|
|
property ResponseCode: Integer read GetResponseCode write FResponseCode;
|
|||
|
|
property ResponseVersion: TIdHTTPProtocolVersion read FResponseVersion write FResponseVersion;
|
|||
|
|
property ContentStream: TStream read FContentStream write FContentStream;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdHTTPRequest = class(TIdRequestHeaderInfo)
|
|||
|
|
protected
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FHTTP: TIdCustomHTTP;
|
|||
|
|
FURL: string;
|
|||
|
|
FMethod: TIdHTTPMethod;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FSourceStream: TStream;
|
|||
|
|
FUseProxy: TIdHTTPConnectionType;
|
|||
|
|
FIPVersion: TIdIPVersion;
|
|||
|
|
FDestination: string;
|
|||
|
|
public
|
|||
|
|
constructor Create(AHTTP: TIdCustomHTTP); reintroduce; virtual;
|
|||
|
|
property URL: string read FURL write FURL;
|
|||
|
|
property Method: TIdHTTPMethod read FMethod write FMethod;
|
|||
|
|
property Source: TStream read FSourceStream write FSourceStream;
|
|||
|
|
property UseProxy: TIdHTTPConnectionType read FUseProxy;
|
|||
|
|
property IPVersion: TIdIPversion read FIPVersion write FIPVersion;
|
|||
|
|
property Destination: string read FDestination write FDestination;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdHTTPProtocol = class(TObject)
|
|||
|
|
protected
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FHTTP: TIdCustomHTTP;
|
|||
|
|
FRequest: TIdHTTPRequest;
|
|||
|
|
FResponse: TIdHTTPResponse;
|
|||
|
|
public
|
|||
|
|
constructor Create(AConnection: TIdCustomHTTP);
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
function ProcessResponse(AIgnoreReplies: array of Int16): TIdHTTPWhatsNext;
|
|||
|
|
procedure BuildAndSendRequest(AURI: TIdURI);
|
|||
|
|
procedure RetrieveHeaders(AMaxHeaderCount: integer);
|
|||
|
|
//
|
|||
|
|
property Request: TIdHTTPRequest read FRequest;
|
|||
|
|
property Response: TIdHTTPResponse read FResponse;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdCustomHTTP = class(TIdTCPClientCustom)
|
|||
|
|
protected
|
|||
|
|
{Retries counter for WWW authorization}
|
|||
|
|
FAuthRetries: Integer;
|
|||
|
|
{Retries counter for proxy authorization}
|
|||
|
|
FAuthProxyRetries: Integer;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FCookieManager: TIdCookieManager;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FCompressor : TIdZLibCompressorBase;
|
|||
|
|
FImplicitCookieManager: Boolean;
|
|||
|
|
{Max retries for authorization}
|
|||
|
|
FMaxAuthRetries: Integer;
|
|||
|
|
FMaxHeaderLines: integer;
|
|||
|
|
FAllowCookies: Boolean;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FAuthenticationManager: TIdAuthenticationManager;
|
|||
|
|
FProtocolVersion: TIdHTTPProtocolVersion;
|
|||
|
|
|
|||
|
|
{this is an internal counter for redirects}
|
|||
|
|
FRedirectCount: Integer;
|
|||
|
|
FRedirectMax: Integer;
|
|||
|
|
FHandleRedirects: Boolean;
|
|||
|
|
FOptions: TIdHTTPOptions;
|
|||
|
|
FURI: TIdURI;
|
|||
|
|
FHTTPProto: TIdHTTPProtocol;
|
|||
|
|
FProxyParameters: TIdProxyConnectionInfo;
|
|||
|
|
//
|
|||
|
|
FOnHeadersAvailable: TIdHTTPOnHeadersAvailable;
|
|||
|
|
FOnRedirect: TIdHTTPOnRedirectEvent;
|
|||
|
|
FOnSelectAuthorization: TIdOnSelectAuthorization;
|
|||
|
|
FOnSelectProxyAuthorization: TIdOnSelectAuthorization;
|
|||
|
|
FOnAuthorization: TIdOnAuthorization;
|
|||
|
|
FOnProxyAuthorization: TIdOnAuthorization;
|
|||
|
|
//
|
|||
|
|
{
|
|||
|
|
procedure SetHost(const Value: string); override;
|
|||
|
|
procedure SetPort(const Value: integer); override;
|
|||
|
|
}
|
|||
|
|
procedure DoRequest(const AMethod: TIdHTTPMethod; AURL: string;
|
|||
|
|
ASource, AResponseContent: TStream; AIgnoreReplies: array of Int16); virtual;
|
|||
|
|
function CreateProtocol: TIdHTTPProtocol; virtual;
|
|||
|
|
procedure InitComponent; override;
|
|||
|
|
function InternalReadLn: String;
|
|||
|
|
procedure SetAuthenticationManager(Value: TIdAuthenticationManager);
|
|||
|
|
procedure SetCookieManager(ACookieManager: TIdCookieManager);
|
|||
|
|
procedure SetAllowCookies(AValue: Boolean);
|
|||
|
|
function GetResponseCode: Integer;
|
|||
|
|
function GetResponseText: string;
|
|||
|
|
function DoOnAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean; virtual;
|
|||
|
|
function DoOnProxyAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean; virtual;
|
|||
|
|
function DoOnRedirect(var Location: string; var VMethod: TIdHTTPMethod; RedirectCount: integer): boolean; virtual;
|
|||
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|||
|
|
procedure ProcessCookies(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
function SetHostAndPort: TIdHTTPConnectionType;
|
|||
|
|
procedure SetCookies(AURL: TIdURI; ARequest: TIdHTTPRequest);
|
|||
|
|
procedure ReadResult(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
procedure PrepareRequest(ARequest: TIdHTTPRequest);
|
|||
|
|
procedure ConnectToHost(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
function GetResponse: TIdHTTPResponse;
|
|||
|
|
function GetRequest: TIdHTTPRequest;
|
|||
|
|
function GetMetaHTTPEquiv: TIdMetaHTTPEquiv;
|
|||
|
|
procedure SetRequest(Value: TIdHTTPRequest);
|
|||
|
|
procedure SetProxyParams(AValue: TIdProxyConnectionInfo);
|
|||
|
|
|
|||
|
|
function SetRequestParams(ASource: TStrings; AByteEncoding: IIdTextEncoding
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
|
|||
|
|
procedure CheckAndConnect(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
procedure DoOnDisconnected; override;
|
|||
|
|
|
|||
|
|
//misc internal stuff
|
|||
|
|
function ResponseCharset: String;
|
|||
|
|
public
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
|
|||
|
|
procedure Delete(AURL: string; AResponseContent: TStream); overload;
|
|||
|
|
function Delete(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
|
|||
|
|
procedure Options(AURL: string; AResponseContent: TStream); overload;
|
|||
|
|
function Options(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
|
|||
|
|
procedure Get(AURL: string; AResponseContent: TStream); overload;
|
|||
|
|
procedure Get(AURL: string; AResponseContent: TStream; AIgnoreReplies: array of Int16); overload;
|
|||
|
|
function Get(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
function Get(AURL: string; AIgnoreReplies: array of Int16
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
|
|||
|
|
procedure Trace(AURL: string; AResponseContent: TStream); overload;
|
|||
|
|
function Trace(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
procedure Head(AURL: string);
|
|||
|
|
|
|||
|
|
function Post(AURL: string; const ASourceFile: String
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
function Post(AURL: string; ASource: TStrings; AByteEncoding: IIdTextEncoding = nil
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil; ADestEncoding: IIdTextEncoding = nil{$ENDIF}): string; overload;
|
|||
|
|
function Post(AURL: string; ASource: TStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
function Post(AURL: string; ASource: TIdMultiPartFormDataStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
|
|||
|
|
procedure Post(AURL: string; const ASourceFile: String; AResponseContent: TStream); overload;
|
|||
|
|
procedure Post(AURL: string; ASource: TStrings; AResponseContent: TStream; AByteEncoding: IIdTextEncoding = nil
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}); overload;
|
|||
|
|
procedure Post(AURL: string; ASource, AResponseContent: TStream); overload;
|
|||
|
|
procedure Post(AURL: string; ASource: TIdMultiPartFormDataStream; AResponseContent: TStream); overload;
|
|||
|
|
|
|||
|
|
function Put(AURL: string; ASource: TStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
procedure Put(AURL: string; ASource, AResponseContent: TStream); overload;
|
|||
|
|
|
|||
|
|
procedure Patch(AURL: string; ASource, AResponseContent: TStream); overload;
|
|||
|
|
function Patch(AURL: string; ASource: TStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string; overload;
|
|||
|
|
|
|||
|
|
{This is an object that can compress and decompress HTTP Deflate encoding}
|
|||
|
|
property Compressor : TIdZLibCompressorBase read FCompressor write FCompressor;
|
|||
|
|
|
|||
|
|
{This is the response code number such as 404 for File not Found}
|
|||
|
|
property ResponseCode: Integer read GetResponseCode;
|
|||
|
|
{This is the text of the message such as "404 File Not Found here Sorry"}
|
|||
|
|
property ResponseText: string read GetResponseText;
|
|||
|
|
property Response: TIdHTTPResponse read GetResponse;
|
|||
|
|
property MetaHTTPEquiv: TIdMetaHTTPEquiv read GetMetaHTTPEquiv;
|
|||
|
|
{ This is the last processed URL }
|
|||
|
|
property URL: TIdURI read FURI;
|
|||
|
|
// number of retry attempts for Authentication
|
|||
|
|
property AuthRetries: Integer read FAuthRetries;
|
|||
|
|
property AuthProxyRetries: Integer read FAuthProxyRetries;
|
|||
|
|
// maximum number of Authentication retries permitted
|
|||
|
|
property MaxAuthRetries: Integer read FMaxAuthRetries write FMaxAuthRetries default Id_TIdHTTP_MaxAuthRetries;
|
|||
|
|
property AllowCookies: Boolean read FAllowCookies write SetAllowCookies;
|
|||
|
|
{Do we handle redirect requests or simply raise an exception and let the
|
|||
|
|
developer deal with it}
|
|||
|
|
property HandleRedirects: Boolean read FHandleRedirects write FHandleRedirects default Id_TIdHTTP_HandleRedirects;
|
|||
|
|
property ProtocolVersion: TIdHTTPProtocolVersion read FProtocolVersion write FProtocolVersion default Id_TIdHTTP_ProtocolVersion;
|
|||
|
|
//how many redirects were made in the last request
|
|||
|
|
property RedirectCount: Integer read FRedirectCount;
|
|||
|
|
{This is the maximum number of redirects we wish to handle, we limit this
|
|||
|
|
to prevent stack overflow due to recursion. Recursion is safe ONLY if
|
|||
|
|
prevented for continuing to infinity}
|
|||
|
|
property RedirectMaximum: Integer read FRedirectMax write FRedirectMax default Id_TIdHTTP_RedirectMax;
|
|||
|
|
// S.G. 6/4/2004: This is to prevent the server from responding with too many header lines
|
|||
|
|
property MaxHeaderLines: integer read FMaxHeaderLines write FMaxHeaderLines default Id_TIdHTTP_MaxHeaderLines;
|
|||
|
|
property ProxyParams: TIdProxyConnectionInfo read FProxyParameters write SetProxyParams;
|
|||
|
|
property Request: TIdHTTPRequest read GetRequest write SetRequest;
|
|||
|
|
property HTTPOptions: TIdHTTPOptions read FOptions write FOptions;
|
|||
|
|
//
|
|||
|
|
property OnHeadersAvailable: TIdHTTPOnHeadersAvailable read FOnHeadersAvailable write FOnHeadersAvailable;
|
|||
|
|
// Fired when a rediretion is requested.
|
|||
|
|
property OnRedirect: TIdHTTPOnRedirectEvent read FOnRedirect write FOnRedirect;
|
|||
|
|
property OnSelectAuthorization: TIdOnSelectAuthorization read FOnSelectAuthorization write FOnSelectAuthorization;
|
|||
|
|
property OnSelectProxyAuthorization: TIdOnSelectAuthorization read FOnSelectProxyAuthorization write FOnSelectProxyAuthorization;
|
|||
|
|
property OnAuthorization: TIdOnAuthorization read FOnAuthorization write FOnAuthorization;
|
|||
|
|
property OnProxyAuthorization: TIdOnAuthorization read FOnProxyAuthorization write FOnProxyAuthorization;
|
|||
|
|
// Cookie stuff
|
|||
|
|
property CookieManager: TIdCookieManager read FCookieManager write SetCookieManager;
|
|||
|
|
//
|
|||
|
|
property AuthenticationManager: TIdAuthenticationManager read FAuthenticationManager write SetAuthenticationManager;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdHTTP = class(TIdCustomHTTP)
|
|||
|
|
published
|
|||
|
|
// number of Authentication retries permitted
|
|||
|
|
property MaxAuthRetries;
|
|||
|
|
property AllowCookies;
|
|||
|
|
{ Do we handle redirect requests or simply raise an exception and let the
|
|||
|
|
developer deal with it }
|
|||
|
|
property HandleRedirects;
|
|||
|
|
property ProtocolVersion;
|
|||
|
|
{ This is the maximum number of redirects we wish to handle, we limit this
|
|||
|
|
to prevent stack overflow due to recursion. Recursion is safe ONLY if
|
|||
|
|
prevented for continuing to infinity }
|
|||
|
|
property RedirectMaximum;
|
|||
|
|
property ProxyParams;
|
|||
|
|
property Request;
|
|||
|
|
property HTTPOptions;
|
|||
|
|
//
|
|||
|
|
property OnHeadersAvailable;
|
|||
|
|
// Fired when a rediretion is requested.
|
|||
|
|
property OnRedirect;
|
|||
|
|
property OnSelectAuthorization;
|
|||
|
|
property OnSelectProxyAuthorization;
|
|||
|
|
property OnAuthorization;
|
|||
|
|
property OnProxyAuthorization;
|
|||
|
|
// property Host;
|
|||
|
|
// property Port default IdPORT_HTTP;
|
|||
|
|
// Cookie stuff
|
|||
|
|
property CookieManager;
|
|||
|
|
// property AuthenticationManager: TIdAuthenticationManager read FAuthenticationManager write SetAuthenticationManager;
|
|||
|
|
// ZLib compression library object for use with deflate and gzip encoding
|
|||
|
|
property Compressor;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
EIdUnknownProtocol = class(EIdException);
|
|||
|
|
EIdHTTPProtocolException = class( EIdReplyRFCError )
|
|||
|
|
protected
|
|||
|
|
FErrorMessage: string;
|
|||
|
|
public
|
|||
|
|
constructor CreateError(const anErrCode: Integer; const asReplyMessage: string;
|
|||
|
|
const asErrorMessage: string); reintroduce; virtual;
|
|||
|
|
property ErrorMessage: string read FErrorMessage;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
SysUtils,
|
|||
|
|
IdAllAuthentications, IdComponent, IdCoderMIME, IdTCPConnection,
|
|||
|
|
IdResourceStringsCore, IdResourceStringsProtocols, IdGlobalProtocols,
|
|||
|
|
IdIOHandler, IdIOHandlerSocket;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
ProtocolVersionString: array[TIdHTTPProtocolVersion] of string = ('1.0', '1.1'); {do not localize}
|
|||
|
|
|
|||
|
|
{ EIdHTTPProtocolException }
|
|||
|
|
|
|||
|
|
constructor EIdHTTPProtocolException.CreateError(const anErrCode: Integer;
|
|||
|
|
const asReplyMessage: string; const asErrorMessage: string);
|
|||
|
|
begin
|
|||
|
|
inherited CreateError(anErrCode, asReplyMessage);
|
|||
|
|
FErrorMessage := asErrorMessage;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdHTTP }
|
|||
|
|
|
|||
|
|
function IsContentTypeHtml(AInfo: TIdEntityHeaderInfo) : Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := IsHeaderMediaTypes(AInfo.ContentType, ['text/html', 'text/html-sandboxed','application/xhtml+xml']); {do not localize}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function IsContentTypeAppXml(AInfo: TIdEntityHeaderInfo) : Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := IsHeaderMediaTypes(AInfo.ContentType,
|
|||
|
|
['application/xml', 'application/xml-external-parsed-entity', 'application/xml-dtd'] {do not localize}
|
|||
|
|
);
|
|||
|
|
if not Result then
|
|||
|
|
begin
|
|||
|
|
Result := not IsHeaderMediaType(AInfo.ContentType, 'text'); {do not localize}
|
|||
|
|
if Result then begin
|
|||
|
|
Result := TextEndsWith(ExtractHeaderMediaSubType(AInfo.ContentType), '+xml') {do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdCustomHTTP.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FHTTPProto);
|
|||
|
|
FreeAndNil(FURI);
|
|||
|
|
FreeAndNil(FProxyParameters);
|
|||
|
|
SetCookieManager(nil);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Delete(AURL: string; AResponseContent: TStream);
|
|||
|
|
begin
|
|||
|
|
DoRequest(Id_HTTPMethodDelete, AURL, nil, AResponseContent, []);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Delete(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LStream: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LStream := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
DoRequest(Id_HTTPMethodDelete, AURL, nil, LStream, []);
|
|||
|
|
LStream.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LStream, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Options(AURL: string; AResponseContent: TStream);
|
|||
|
|
begin
|
|||
|
|
DoRequest(Id_HTTPMethodOptions, AURL, nil, AResponseContent, []);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Options(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LStream: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LStream := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
DoRequest(Id_HTTPMethodOptions, AURL, nil, LStream, []);
|
|||
|
|
LStream.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LStream, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Get(AURL: string; AResponseContent: TStream);
|
|||
|
|
begin
|
|||
|
|
Get(AURL, AResponseContent, []);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Trace(AURL: string; AResponseContent: TStream);
|
|||
|
|
begin
|
|||
|
|
DoRequest(Id_HTTPMethodTrace, AURL, nil, AResponseContent, []);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Head(AURL: string);
|
|||
|
|
begin
|
|||
|
|
DoRequest(Id_HTTPMethodHead, AURL, nil, nil, []);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Post(AURL: string; ASource, AResponseContent: TStream);
|
|||
|
|
var
|
|||
|
|
OldProtocol: TIdHTTPProtocolVersion;
|
|||
|
|
begin
|
|||
|
|
// PLEASE READ CAREFULLY
|
|||
|
|
|
|||
|
|
// Currently when issuing a POST, IdHTTP will automatically set the protocol
|
|||
|
|
// to version 1.0 independently of the value it had initially. This is because
|
|||
|
|
// there are some servers that don't respect the RFC to the full extent. In
|
|||
|
|
// particular, they don't respect sending/not sending the Expect: 100-Continue
|
|||
|
|
// header. Until we find an optimum solution that does NOT break the RFC, we
|
|||
|
|
// will restrict POSTS to version 1.0.
|
|||
|
|
OldProtocol := FProtocolVersion;
|
|||
|
|
try
|
|||
|
|
// If hoKeepOrigProtocol is SET, is possible to assume that the developer
|
|||
|
|
// is sure in operations of the server
|
|||
|
|
if not (hoKeepOrigProtocol in FOptions) then begin
|
|||
|
|
if Connected then begin
|
|||
|
|
Disconnect;
|
|||
|
|
end;
|
|||
|
|
FProtocolVersion := pv1_0;
|
|||
|
|
end;
|
|||
|
|
DoRequest(Id_HTTPMethodPost, AURL, ASource, AResponseContent, []);
|
|||
|
|
finally
|
|||
|
|
FProtocolVersion := OldProtocol;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// RLebeau 12/21/2010: this is based on W3's HTML standards:
|
|||
|
|
//
|
|||
|
|
// HTML 4.01
|
|||
|
|
// http://www.w3.org/TR/html401/
|
|||
|
|
//
|
|||
|
|
// HTML 5
|
|||
|
|
// http://www.w3.org/TR/html5/
|
|||
|
|
|
|||
|
|
function WWWFormUrlEncode(const ASrc: string; AByteEncoding: IIdTextEncoding
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
const
|
|||
|
|
// HTML 4.01 Section 17.13.4 ("Form content types") says:
|
|||
|
|
//
|
|||
|
|
// application/x-www-form-urlencoded
|
|||
|
|
//
|
|||
|
|
// Control names and values are escaped. Space characters are replaced by `+',
|
|||
|
|
// and then reserved characters are escaped as described in [RFC1738], section
|
|||
|
|
// 2.2: Non-alphanumeric characters are replaced by `%HH', a percent sign and
|
|||
|
|
// two hexadecimal digits representing the ASCII code of the character. Line
|
|||
|
|
// breaks are represented as "CR LF" pairs (i.e., `%0D%0A').
|
|||
|
|
//
|
|||
|
|
// On the other hand, HTML 5 Section 4.10.16.4 ("URL-encoded form data") says:
|
|||
|
|
//
|
|||
|
|
// If the character isn't in the range U+0020, U+002A, U+002D, U+002E,
|
|||
|
|
// U+0030 .. U+0039, U+0041 .. U+005A, U+005F, U+0061 .. U+007A then replace
|
|||
|
|
// the character with a string formed as follows: Start with the empty string,
|
|||
|
|
// and then, taking each byte of the character when expressed in the selected
|
|||
|
|
// character encoding in turn, append to the string a U+0025 PERCENT SIGN
|
|||
|
|
// character (%) followed by two characters in the ranges U+0030 DIGIT ZERO (0)
|
|||
|
|
// to U+0039 DIGIT NINE (9) and U+0041 LATIN CAPITAL LETTER A to
|
|||
|
|
// U+005A LATIN CAPITAL LETTER Z representing the hexadecimal value of the
|
|||
|
|
// byte zero-padded if necessary).
|
|||
|
|
//
|
|||
|
|
// If the character is a U+0020 SPACE character, replace it with a single
|
|||
|
|
// U+002B PLUS SIGN character (+).
|
|||
|
|
//
|
|||
|
|
// So, lets err on the side of caution and use the HTML 5.x definition, as it
|
|||
|
|
// encodes some of the characters that HTML 4.01 allows unencoded...
|
|||
|
|
//
|
|||
|
|
SafeChars: TIdUnicodeString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789*-._'; {do not localize}
|
|||
|
|
var
|
|||
|
|
I, J, CharLen, ByteLen: Integer;
|
|||
|
|
Buf: TIdBytes;
|
|||
|
|
{$IFDEF STRING_IS_ANSI}
|
|||
|
|
LChars: TIdWideChars;
|
|||
|
|
{$ENDIF}
|
|||
|
|
LChar: WideChar;
|
|||
|
|
Encoded: Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := ''; {Do not Localize}
|
|||
|
|
|
|||
|
|
// keep the compiler happy
|
|||
|
|
Buf := nil;
|
|||
|
|
{$IFDEF STRING_IS_ANSI}
|
|||
|
|
LChars := nil;
|
|||
|
|
{$ENDIF}
|
|||
|
|
|
|||
|
|
if ASrc = '' then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
EnsureEncoding(AByteEncoding, encUTF8);
|
|||
|
|
{$IFDEF STRING_IS_ANSI}
|
|||
|
|
EnsureEncoding(ASrcEncoding, encOSDefault);
|
|||
|
|
LChars := ASrcEncoding.GetChars(RawToBytes(ASrc[1], Length(ASrc)));
|
|||
|
|
{$ENDIF}
|
|||
|
|
|
|||
|
|
// 2 Chars to handle UTF-16 surrogates
|
|||
|
|
SetLength(Buf, AByteEncoding.GetMaxByteCount(2));
|
|||
|
|
|
|||
|
|
I := 0;
|
|||
|
|
while I < Length({$IFDEF STRING_IS_UNICODE}ASrc{$ELSE}LChars{$ENDIF}) do
|
|||
|
|
begin
|
|||
|
|
LChar := {$IFDEF STRING_IS_UNICODE}ASrc[I+1]{$ELSE}LChars[I]{$ENDIF};
|
|||
|
|
|
|||
|
|
// RLebeau 1/7/09: using Ord() for #128-#255 because in D2009 and later, the
|
|||
|
|
// compiler may change characters >= #128 from their Ansi codepage value to
|
|||
|
|
// their true Unicode codepoint value, depending on the codepage used for
|
|||
|
|
// the source code. For instance, #128 may become #$20AC...
|
|||
|
|
|
|||
|
|
if Ord(LChar) = 32 then {do not localize}
|
|||
|
|
begin
|
|||
|
|
Result := Result + '+'; {do not localize}
|
|||
|
|
Inc(I);
|
|||
|
|
end
|
|||
|
|
else if WideCharIsInSet(SafeChars, LChar) then
|
|||
|
|
begin
|
|||
|
|
Result := Result + Char(LChar);
|
|||
|
|
Inc(I);
|
|||
|
|
end else
|
|||
|
|
begin
|
|||
|
|
// HTML 5 Section 4.10.16.4 says:
|
|||
|
|
//
|
|||
|
|
// For each character ... that cannot be expressed using the selected character
|
|||
|
|
// encoding, replace the character by a string consisting of a U+0026 AMPERSAND
|
|||
|
|
// character (&), a U+0023 NUMBER SIGN character (#), one or more characters in
|
|||
|
|
// the range U+0030 DIGIT ZERO (0) to U+0039 DIGIT NINE (9) representing the
|
|||
|
|
// Unicode code point of the character in base ten, and finally a U+003B
|
|||
|
|
// SEMICOLON character (;).
|
|||
|
|
//
|
|||
|
|
CharLen := CalcUTF16CharLength(
|
|||
|
|
{$IFDEF STRING_IS_UNICODE}ASrc, I+1{$ELSE}LChars, I{$ENDIF}
|
|||
|
|
); // calculate length including surrogates
|
|||
|
|
ByteLen := AByteEncoding.GetBytes(
|
|||
|
|
{$IFDEF STRING_IS_UNICODE}ASrc, I+1{$ELSE}LChars, I{$ENDIF},
|
|||
|
|
CharLen, Buf, 0); // explicit Unicode->Ansi conversion
|
|||
|
|
|
|||
|
|
Encoded := (ByteLen > 0);
|
|||
|
|
if Encoded and (LChar <> '?') then begin {do not localize}
|
|||
|
|
for J := 0 to ByteLen-1 do begin
|
|||
|
|
if Buf[J] = Ord('?') then begin {do not localize}
|
|||
|
|
Encoded := False;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Encoded then begin
|
|||
|
|
for J := 0 to ByteLen-1 do begin
|
|||
|
|
Result := Result + '%' + IntToHex(Ord(Buf[J]), 2); {do not localize}
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
J := GetUTF16Codepoint(
|
|||
|
|
{$IFDEF STRING_IS_UNICODE}ASrc, I+1{$ELSE}LChars, I{$ENDIF});
|
|||
|
|
Result := Result + '&#' + IntToStr(J) + ';'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Inc(I, CharLen);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.SetRequestParams(ASource: TStrings; AByteEncoding: IIdTextEncoding
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
i: Integer;
|
|||
|
|
LPos: integer;
|
|||
|
|
LStr: string;
|
|||
|
|
LTemp: TStringList;
|
|||
|
|
|
|||
|
|
function EncodeLineBreaks(AStrings: TStrings): String;
|
|||
|
|
begin
|
|||
|
|
if AStrings.Count > 1 then begin
|
|||
|
|
// break trailing CR&LF
|
|||
|
|
Result := ReplaceAll(Trim(AStrings.Text), sLineBreak, '&'); {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
Result := Trim(AStrings.Text);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
if Assigned(ASource) then begin
|
|||
|
|
if hoForceEncodeParams in FOptions then begin
|
|||
|
|
// make a copy of ASource so the caller's TStrings object is not modified
|
|||
|
|
LTemp := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
LTemp.Assign(ASource);
|
|||
|
|
for i := 0 to LTemp.Count - 1 do begin
|
|||
|
|
LStr := LTemp[i];
|
|||
|
|
// TODO: use LTemp.NameValueSeparator on platforms that support it
|
|||
|
|
LPos := IndyPos('=', LStr); {do not localize}
|
|||
|
|
if LPos > 0 then begin
|
|||
|
|
LTemp[i] := WWWFormUrlEncode(LTemp.Names[i], AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF})
|
|||
|
|
+ '=' {do not localize}
|
|||
|
|
+ WWWFormUrlEncode(IndyValueFromIndex(LTemp, i), AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
|
|||
|
|
end else begin
|
|||
|
|
LTemp[i] := WWWFormUrlEncode(LStr, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Result := EncodeLineBreaks(LTemp);
|
|||
|
|
finally
|
|||
|
|
LTemp.Free;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Result := EncodeLineBreaks(ASource);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Result := '';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Post(AURL: string; const ASourceFile: String
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LSource: TIdReadFileExclusiveStream;
|
|||
|
|
begin
|
|||
|
|
LSource := TIdReadFileExclusiveStream.Create(ASourceFile);
|
|||
|
|
try
|
|||
|
|
Result := Post(AURL, LSource{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LSource);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Post(AURL: string; const ASourceFile: String; AResponseContent: TStream);
|
|||
|
|
var
|
|||
|
|
LSource: TStream;
|
|||
|
|
begin
|
|||
|
|
LSource := TIdReadFileExclusiveStream.Create(ASourceFile);
|
|||
|
|
try
|
|||
|
|
Post(AURL, LSource, AResponseContent);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LSource);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Post(AURL: string; ASource: TStrings; AResponseContent: TStream;
|
|||
|
|
AByteEncoding: IIdTextEncoding = nil
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
);
|
|||
|
|
var
|
|||
|
|
LParams: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
// Usual posting request have default ContentType is application/x-www-form-urlencoded
|
|||
|
|
if (Request.ContentType = '') or IsContentTypeHtml(Request) then begin
|
|||
|
|
Request.ContentType := 'application/x-www-form-urlencoded'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if ASource <> nil then
|
|||
|
|
begin
|
|||
|
|
LParams := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
WriteStringToStream(LParams, SetRequestParams(ASource, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}));
|
|||
|
|
LParams.Position := 0;
|
|||
|
|
Post(AURL, LParams, AResponseContent);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LParams);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Post(AURL, TStream(nil), AResponseContent);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Post(AURL: string; ASource: TStrings; AByteEncoding: IIdTextEncoding = nil
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LResponse: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LResponse := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
Post(AURL, ASource, LResponse, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
|
|||
|
|
LResponse.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LResponse, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LResponse);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Post(AURL: string; ASource: TStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LResponse: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LResponse := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
Post(AURL, ASource, LResponse);
|
|||
|
|
LResponse.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LResponse, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LResponse);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Put(AURL: string; ASource, AResponseContent: TStream);
|
|||
|
|
begin
|
|||
|
|
DoRequest(Id_HTTPMethodPut, AURL, ASource, AResponseContent, []);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Put(AURL: string; ASource: TStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LResponse: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LResponse := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
Put(AURL, ASource, LResponse);
|
|||
|
|
LResponse.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LResponse, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LResponse);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Get(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
begin
|
|||
|
|
Result := Get(AURL, []{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Trace(AURL: string
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LResponse: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LResponse := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
Trace(AURL, LResponse);
|
|||
|
|
LResponse.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LResponse, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LResponse);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.DoOnRedirect(var Location: string; var VMethod: TIdHTTPMethod; RedirectCount: integer): boolean;
|
|||
|
|
begin
|
|||
|
|
// TODO: convert relative URLs to full URLs here...
|
|||
|
|
Result := HandleRedirects;
|
|||
|
|
if Assigned(FOnRedirect) then begin
|
|||
|
|
FOnRedirect(Self, Location, RedirectCount, Result, VMethod);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.SetCookies(AURL: TIdURI; ARequest: TIdHTTPRequest);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LCookieManager: TIdCookieManager;
|
|||
|
|
begin
|
|||
|
|
LCookieManager := FCookieManager;
|
|||
|
|
if Assigned(LCookieManager) and AllowCookies then
|
|||
|
|
begin
|
|||
|
|
// Send secure cookies only if we have Secured connection
|
|||
|
|
LCookieManager.GenerateClientCookies(
|
|||
|
|
AURL,
|
|||
|
|
TextIsSame(AURL.Protocol, 'HTTPS'), {do not localize}
|
|||
|
|
ARequest.RawHeaders);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// This function sets the Host and Port and returns a boolean depending on
|
|||
|
|
// whether a PROXY is being used or not.
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.SetHostAndPort: TIdHTTPConnectionType;
|
|||
|
|
var
|
|||
|
|
LHost: string;
|
|||
|
|
LPort: Integer;
|
|||
|
|
begin
|
|||
|
|
// First check to see if a Proxy has been specified.
|
|||
|
|
if Length(ProxyParams.ProxyServer) > 0 then begin
|
|||
|
|
if (not TextIsSame(FHost, ProxyParams.ProxyServer)) or (FPort <> ProxyParams.ProxyPort) then begin
|
|||
|
|
if Connected then begin
|
|||
|
|
Disconnect;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LHost := ProxyParams.ProxyServer;
|
|||
|
|
LPort := ProxyParams.ProxyPort;
|
|||
|
|
if TextIsSame(URL.Protocol, 'HTTPS') then begin {do not localize}
|
|||
|
|
Result := ctSSLProxy;
|
|||
|
|
end else begin
|
|||
|
|
Result := ctProxy;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
if Assigned(Socket) then begin
|
|||
|
|
if Assigned(Socket.Binding) then begin
|
|||
|
|
if URL.IPVersion <> Socket.Binding.IPVersion then begin
|
|||
|
|
if Connected then begin
|
|||
|
|
Disconnect; // get rid of current socket handle
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LHost := URL.Host;
|
|||
|
|
LPort := IndyStrToInt(URL.Port, IdPORT_HTTP);
|
|||
|
|
if (not TextIsSame(FHost, LHost)) or (LPort <> FPort) then begin
|
|||
|
|
if Connected then begin
|
|||
|
|
Disconnect;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if TextIsSame(URL.Protocol, 'HTTPS') then begin {do not localize}
|
|||
|
|
Result := ctSSL;
|
|||
|
|
end else begin
|
|||
|
|
Result := ctNormal;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Host := LHost;
|
|||
|
|
Port := LPort;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.ReadResult(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
var
|
|||
|
|
LS: TStream;
|
|||
|
|
LOrigStream : TStream;
|
|||
|
|
LParseHTML : Boolean;
|
|||
|
|
LCreateTmpContent : Boolean;
|
|||
|
|
LDecMeth : Integer;
|
|||
|
|
//0 - no compression was used or we can't support that feature
|
|||
|
|
//1 - deflate
|
|||
|
|
//2 - gzip
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LCompressor: TIdZLibCompressorBase;
|
|||
|
|
|
|||
|
|
function CheckForPendingData(ATimeout: Integer): Boolean;
|
|||
|
|
begin
|
|||
|
|
if IOHandler.InputBufferIsEmpty then begin
|
|||
|
|
IOHandler.CheckForDataOnSource(ATimeout);
|
|||
|
|
end;
|
|||
|
|
Result := not IOHandler.InputBufferIsEmpty;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function ShouldRead: Boolean;
|
|||
|
|
var
|
|||
|
|
CanRead: Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
if IndyPos('chunked', LowerCase(AResponse.TransferEncoding)) > 0 then begin {do not localize}
|
|||
|
|
CanRead := True;
|
|||
|
|
end
|
|||
|
|
else if AResponse.HasContentLength then begin
|
|||
|
|
CanRead := AResponse.ContentLength > 0; // If chunked then this is also 0
|
|||
|
|
end
|
|||
|
|
else if IsHeaderMediaType(AResponse.ContentType, 'multipart') then begin {do not localize}
|
|||
|
|
CanRead := not (hoNoReadMultipartMIME in FOptions);
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
CanRead := True;
|
|||
|
|
end;
|
|||
|
|
if CanRead then
|
|||
|
|
begin
|
|||
|
|
// DO NOT READ IF THE REQUEST IS HEAD!!!
|
|||
|
|
// The server is supposed to send a 'Content-Length' header without sending
|
|||
|
|
// the actual data. 1xx, 204, and 304 replies are not supposed to contain
|
|||
|
|
// entity bodies, either...
|
|||
|
|
if TextIsSame(ARequest.Method, Id_HTTPMethodHead) or
|
|||
|
|
({TextIsSame(ARequest.Method, Id_HTTPMethodPost) and} TextIsSame(ARequest.MethodOverride, Id_HTTPMethodHead)) or
|
|||
|
|
// TODO: check for 'X-HTTP-Method' and 'X-METHOD-OVERRIDE' request headers as well...
|
|||
|
|
((AResponse.ResponseCode div 100) = 1) or
|
|||
|
|
(AResponse.ResponseCode = 204) or
|
|||
|
|
(AResponse.ResponseCode = 304) then
|
|||
|
|
begin
|
|||
|
|
// Have noticed one case where a non-conforming server did send an
|
|||
|
|
// entity body in response to a HEAD request. If requested, ignore
|
|||
|
|
// anything the server may send by accident
|
|||
|
|
if not (hoWaitForUnexpectedData in FOptions) then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
Result := CheckForPendingData(100);
|
|||
|
|
end
|
|||
|
|
else if (AResponse.ResponseCode div 100) = 3 then
|
|||
|
|
begin
|
|||
|
|
// This is a workaround for buggy HTTP 1.1 servers which
|
|||
|
|
// does not return any body with 302 response code
|
|||
|
|
Result := CheckForPendingData(5000);
|
|||
|
|
end else begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function ChunkSize: integer;
|
|||
|
|
var
|
|||
|
|
j: Integer;
|
|||
|
|
s: string;
|
|||
|
|
begin
|
|||
|
|
s := InternalReadLn;
|
|||
|
|
j := IndyPos(';', s); {do not localize}
|
|||
|
|
if j > 0 then begin
|
|||
|
|
s := Copy(s, 1, j - 1);
|
|||
|
|
end;
|
|||
|
|
Result := IndyStrToInt('$' + Trim(s), 0); {do not localize}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure ReadChunked;
|
|||
|
|
var
|
|||
|
|
LSize: Integer;
|
|||
|
|
LTrailHeader: String;
|
|||
|
|
begin
|
|||
|
|
DoStatus(hsStatusText, [RSHTTPChunkStarted]);
|
|||
|
|
BeginWork(wmRead);
|
|||
|
|
try
|
|||
|
|
LSize := ChunkSize;
|
|||
|
|
while LSize <> 0 do begin
|
|||
|
|
if Assigned(LS) then begin
|
|||
|
|
IOHandler.ReadStream(LS, LSize);
|
|||
|
|
end else begin
|
|||
|
|
IOHandler.Discard(LSize);
|
|||
|
|
end;
|
|||
|
|
InternalReadLn; // CRLF at end of chunk data
|
|||
|
|
LSize := ChunkSize;
|
|||
|
|
end;
|
|||
|
|
// read trailer headers
|
|||
|
|
LTrailHeader := InternalReadLn;
|
|||
|
|
while LTrailHeader <> '' do begin
|
|||
|
|
AResponse.RawHeaders.Add(LTrailHeader);
|
|||
|
|
LTrailHeader := InternalReadLn;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
EndWork(wmRead);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure ReadMIME;
|
|||
|
|
var
|
|||
|
|
LMIMEBoundary: TIdBytes;
|
|||
|
|
LIndex: Integer;
|
|||
|
|
LSize: Integer;
|
|||
|
|
begin
|
|||
|
|
LMIMEBoundary := ToBytes('--' + ExtractHeaderSubItem(AResponse.ContentType, 'boundary', QuoteHTTP) + '--');
|
|||
|
|
BeginWork(wmRead);
|
|||
|
|
try
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
LIndex := IOHandler.InputBuffer.IndexOf(LMIMEBoundary);
|
|||
|
|
if LIndex <> -1 then
|
|||
|
|
begin
|
|||
|
|
LSize := LIndex + Length(LMIMEBoundary);
|
|||
|
|
if Assigned(LS) then begin
|
|||
|
|
IOHandler.ReadStream(LS, LSize);
|
|||
|
|
end else begin
|
|||
|
|
IOHandler.Discard(LSize);
|
|||
|
|
end;
|
|||
|
|
InternalReadLn; // CRLF at end of boundary
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
LSize := IOHandler.InputBuffer.Size - (Length(LMIMEBoundary)-1);
|
|||
|
|
if LSize > 0 then begin
|
|||
|
|
if Assigned(LS) then begin
|
|||
|
|
IOHandler.ReadStream(LS, LSize);
|
|||
|
|
end else begin
|
|||
|
|
IOHandler.Discard(LSize);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
IOHandler.CheckForDataOnSource;
|
|||
|
|
IOHandler.CheckForDisconnect(True, True);
|
|||
|
|
until False;
|
|||
|
|
except
|
|||
|
|
on E: EIdConnClosedGracefully do begin
|
|||
|
|
if Assigned(LS) then begin
|
|||
|
|
IOHandler.InputBuffer.ExtractToStream(LS);
|
|||
|
|
end else begin
|
|||
|
|
IOHandler.InputBuffer.Clear;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
EndWork(wmRead);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
if not ShouldRead then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LDecMeth := 0;
|
|||
|
|
|
|||
|
|
LParseHTML := Assigned(AResponse.ContentStream) and IsContentTypeHtml(AResponse) and not (hoNoParseMetaHTTPEquiv in FOptions);
|
|||
|
|
LCreateTmpContent := LParseHTML and not (AResponse.ContentStream is TCustomMemoryStream);
|
|||
|
|
|
|||
|
|
LOrigStream := AResponse.ContentStream;
|
|||
|
|
if LCreateTmpContent then begin
|
|||
|
|
AResponse.ContentStream := TMemoryStream.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LCompressor := Compressor;
|
|||
|
|
try
|
|||
|
|
// we need to determine what type of decompression may need to be used
|
|||
|
|
// before we read from the IOHandler. If there is compression, then we
|
|||
|
|
// use a local stream to download the compressed data and decompress it.
|
|||
|
|
// If no compression is used, ContentStream will be used directly
|
|||
|
|
|
|||
|
|
if Assigned(AResponse.ContentStream) then begin
|
|||
|
|
if Assigned(LCompressor) and LCompressor.IsReady then begin
|
|||
|
|
LDecMeth := PosInStrArray(AResponse.ContentEncoding, ['deflate', 'gzip'], False) + 1; {do not localize}
|
|||
|
|
end;
|
|||
|
|
if LDecMeth > 0 then begin
|
|||
|
|
LS := TMemoryStream.Create;
|
|||
|
|
end else begin
|
|||
|
|
LS := AResponse.ContentStream;
|
|||
|
|
end;
|
|||
|
|
end else
|
|||
|
|
begin
|
|||
|
|
LS := nil;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
try
|
|||
|
|
if IndyPos('chunked', LowerCase(AResponse.TransferEncoding)) > 0 then begin {do not localize}
|
|||
|
|
ReadChunked;
|
|||
|
|
end
|
|||
|
|
else if AResponse.HasContentLength then begin
|
|||
|
|
if AResponse.ContentLength > 0 then begin// If chunked then this is also 0
|
|||
|
|
try
|
|||
|
|
if Assigned(LS) then begin
|
|||
|
|
IOHandler.ReadStream(LS, AResponse.ContentLength);
|
|||
|
|
end else begin
|
|||
|
|
IOHandler.Discard(AResponse.ContentLength);
|
|||
|
|
end;
|
|||
|
|
except
|
|||
|
|
// should this be caught here? We are being told the size, so a
|
|||
|
|
// premature disconnect should be an error, right?
|
|||
|
|
on E: EIdConnClosedGracefully do begin end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if IsHeaderMediaType(AResponse.ContentType, 'multipart') then begin {do not localize}
|
|||
|
|
ReadMIME;
|
|||
|
|
end else begin
|
|||
|
|
if Assigned(LS) then begin
|
|||
|
|
IOHandler.ReadStream(LS, -1, True);
|
|||
|
|
end else begin
|
|||
|
|
IOHandler.DiscardAll;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LDecMeth > 0 then begin
|
|||
|
|
LS.Position := 0;
|
|||
|
|
case LDecMeth of
|
|||
|
|
1 : LCompressor.DecompressDeflateStream(LS, AResponse.ContentStream);
|
|||
|
|
2 : LCompressor.DecompressGZipStream(LS, AResponse.ContentStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
if LDecMeth > 0 then begin
|
|||
|
|
FreeAndNil(LS);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LParseHTML then begin
|
|||
|
|
AResponse.ProcessMetaHTTPEquiv;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
if LCreateTmpContent then
|
|||
|
|
begin
|
|||
|
|
try
|
|||
|
|
LOrigStream.CopyFrom(AResponse.ContentStream, 0);
|
|||
|
|
finally
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
AResponse.ContentStream.Free;
|
|||
|
|
{$ENDIF}
|
|||
|
|
AResponse.ContentStream := LOrigStream;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// TODO: move the XML charset detector below to the IdGlobalProtocols unit so
|
|||
|
|
// it can be used in other components, like TIdMessageClient and TIdIMAP4...
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
XmlEncoding = (xmlUCS4BE, xmlUCS4BEOdd, xmlUCS4LE, xmlUCS4LEOdd,
|
|||
|
|
xmlUTF16BE, xmlUTF16LE, xmlUTF8, xmlEBCDIC, xmlUnknown
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
XmlBomInfo = record
|
|||
|
|
Charset: String;
|
|||
|
|
BOMLen: Integer;
|
|||
|
|
BOM: UInt32;
|
|||
|
|
BOMMask: UInt32;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
XmlNonBomInfo = record
|
|||
|
|
CharLen: Integer;
|
|||
|
|
FirstChar: UInt32;
|
|||
|
|
LastChar: UInt32;
|
|||
|
|
CharMask: UInt32;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
XmlBOMs: array[xmlUCS4BE..xmlUTF8] of XmlBomInfo = (
|
|||
|
|
(Charset: 'UCS-4BE'; BOMLen: 4; BOM: $0000FEFF; BOMMask: $FFFFFFFF), {do not localize}
|
|||
|
|
(Charset: ''; {UCS-4} BOMLen: 4; BOM: $0000FFFE; BOMMask: $FFFFFFFF),
|
|||
|
|
(Charset: 'UCS-4LE'; BOMLen: 4; BOM: $FFFE0000; BOMMask: $FFFFFFFF), {do not localize}
|
|||
|
|
(Charset: ''; {UCS-4} BOMLen: 4; BOM: $FEFF0000; BOMMask: $FFFFFFFF),
|
|||
|
|
(Charset: 'UTF-16BE'; BOMLen: 2; BOM: $FEFF0000; BOMMask: $FFFF0000), {do not localize}
|
|||
|
|
(Charset: 'UTF-16LE'; BOMLen: 2; BOM: $FFFE0000; BOMMask: $FFFF0000), {do not localize}
|
|||
|
|
(Charset: 'UTF-8'; BOMLen: 3; BOM: $EFBBBF00; BOMMask: $FFFFFF00) {do not localize}
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
XmlNonBOMs: array[xmlUCS4BE..xmlEBCDIC] of XmlNonBomInfo = (
|
|||
|
|
(CharLen: 4; FirstChar: $0000003C; LastChar: $0000003E; CharMask: $FFFFFFFF),
|
|||
|
|
(CharLen: 4; FirstChar: $00003C00; LastChar: $00003E00; CharMask: $FFFFFFFF),
|
|||
|
|
(CharLen: 4; FirstChar: $3C000000; LastChar: $3E000000; CharMask: $FFFFFFFF),
|
|||
|
|
(CharLen: 4; FirstChar: $003C0000; LastChar: $003E0000; CharMask: $FFFFFFFF),
|
|||
|
|
(CharLen: 2; FirstChar: $003C003F; LastChar: $003E0000; CharMask: $FFFF0000),
|
|||
|
|
(CharLen: 2; FirstChar: $3C003F00; LastChar: $3E000000; CharMask: $FFFF0000),
|
|||
|
|
(CharLen: 1; FirstChar: $3C3F786D; LastChar: $3E000000; CharMask: $FF000000),
|
|||
|
|
(CharLen: 1; FirstChar: $4C6FA794; LastChar: $6E000000; CharMask: $FF000000)
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
XmlUCS4AsciiIndex: array[xmlUCS4BE..xmlUCS4LEOdd] of Integer = (3, 2, 0, 1);
|
|||
|
|
|
|||
|
|
// RLebeau: only interested in EBCDIC ASCII characters that are allowed in
|
|||
|
|
// an XML declaration, we'll treat everything else as #01 for now...
|
|||
|
|
XmlEBCDICTable: array[Byte] of Char = (
|
|||
|
|
{ -0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -A -B -C -D -E -F }
|
|||
|
|
{0-} #01, #01, #01, #01, #01, #09, #01, #01, #01, #01, #01, #01, #01, #13, #01, #01, {do not localize}
|
|||
|
|
{1-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{2-} #01, #01, #01, #01, #01, #10, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{3-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{4-} ' ', #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, '.', '<', #01, #01, #01, {do not localize}
|
|||
|
|
{5-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{6-} '-', #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, '_', '>', '?', {do not localize}
|
|||
|
|
{7-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #27, '=', '"', {do not localize}
|
|||
|
|
{8-} #01, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{9-} #01, 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{A-} #01, #01, 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{B-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{C-} #01, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{D-} #01, 'J', 'K', 'L', 'N', 'N', 'O', 'P', 'Q', 'R', #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{E-} #01, #01, 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', #01, #01, #01, #01, #01, #01, {do not localize}
|
|||
|
|
{F-} '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', #01, #01, #01, #01, #01, #01 {do not localize}
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
function DetectXmlCharset(AStream: TStream): String;
|
|||
|
|
var
|
|||
|
|
Buffer: TIdBytes;
|
|||
|
|
InBuf, StreamPos, CurPos: TIdStreamSize;
|
|||
|
|
XmlDec, XmlEnc: String;
|
|||
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|||
|
|
LSB: TIdStringBuilder;
|
|||
|
|
{$ENDIF}
|
|||
|
|
I, Len: Integer;
|
|||
|
|
Enc: XmlEncoding;
|
|||
|
|
Signature: UInt32;
|
|||
|
|
|
|||
|
|
function BufferToUInt32: UInt32;
|
|||
|
|
begin
|
|||
|
|
Result := (UInt32(Buffer[0]) shl 24) or
|
|||
|
|
(UInt32(Buffer[1]) shl 16) or
|
|||
|
|
(UInt32(Buffer[2]) shl 8) or
|
|||
|
|
UInt32(Buffer[3]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
// XML's default encoding is UTF-8 unless specified otherwise, either
|
|||
|
|
// by a BOM or an explicit "encoding" in the XML's prolog...
|
|||
|
|
|
|||
|
|
Result := 'UTF-8'; {do not localize}
|
|||
|
|
|
|||
|
|
StreamPos := AStream.Position;
|
|||
|
|
try
|
|||
|
|
AStream.Position := 0;
|
|||
|
|
|
|||
|
|
SetLength(Buffer, 4);
|
|||
|
|
FillBytes(Buffer, 4, $00);
|
|||
|
|
|
|||
|
|
InBuf := ReadTIdBytesFromStream(AStream, Buffer, 4);
|
|||
|
|
if InBuf < 3 then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Signature := BufferToUInt32;
|
|||
|
|
|
|||
|
|
// check for known BOMs first...
|
|||
|
|
|
|||
|
|
for Enc := Low(XmlBOMs) to High(XmlBOMs) do begin
|
|||
|
|
if (Signature and XmlBOMs[Enc].BOMMask) = XmlBOMs[Enc].BOM then begin
|
|||
|
|
Inc(StreamPos, XmlBOMs[Enc].BOMLen);
|
|||
|
|
Result := XmlBOMs[Enc].Charset;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// check for non-BOM'ed encodings now...
|
|||
|
|
|
|||
|
|
if InBuf <> 4 then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
XmlDec := '';
|
|||
|
|
|
|||
|
|
for Enc := Low(XmlNonBOMs) to High(XmlNonBOMs) do begin
|
|||
|
|
if Signature = XmlNonBOMs[Enc].FirstChar then begin
|
|||
|
|
FillBytes(Buffer, 4, $00);
|
|||
|
|
while (AStream.Size - AStream.Position) >= XmlNonBOMs[Enc].CharLen do
|
|||
|
|
begin
|
|||
|
|
ReadTIdBytesFromStream(AStream, Buffer, XmlNonBOMs[Enc].CharLen);
|
|||
|
|
Signature := BufferToUInt32;
|
|||
|
|
if (Signature and XmlNonBOMs[Enc].CharMask) = XmlNonBOMs[Enc].LastChar then
|
|||
|
|
begin
|
|||
|
|
CurPos := AStream.Position;
|
|||
|
|
AStream.Position := 0;
|
|||
|
|
case Enc of
|
|||
|
|
xmlUCS4BE, xmlUCS4LE, xmlUCS4BEOdd, xmlUCS4LEOdd: begin
|
|||
|
|
// TODO: create UCS-4 IIdTextEncoding implementations...
|
|||
|
|
Len := CurPos div XmlNonBOMs[Enc].CharLen;
|
|||
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|||
|
|
LSB := TIdStringBuilder.Create(Len);
|
|||
|
|
{$ELSE}
|
|||
|
|
SetLength(XmlDec, Len);
|
|||
|
|
{$ENDIF}
|
|||
|
|
for I := 1 to Len do begin
|
|||
|
|
ReadTIdBytesFromStream(AStream, Buffer, XmlNonBOMs[Enc].CharLen);
|
|||
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|||
|
|
LSB.Append(Char(Buffer[XmlUCS4AsciiIndex[Enc]]));
|
|||
|
|
{$ELSE}
|
|||
|
|
XmlDec[I] := Char(Buffer[XmlUCS4AsciiIndex[Enc]]);
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|||
|
|
XmlDec := LSB.ToString;
|
|||
|
|
LSB := nil;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
xmlUTF16BE: begin
|
|||
|
|
XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_UTF16BE);
|
|||
|
|
end;
|
|||
|
|
xmlUTF16LE: begin
|
|||
|
|
XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_UTF16LE);
|
|||
|
|
end;
|
|||
|
|
xmlUTF8: begin
|
|||
|
|
XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_UTF8);
|
|||
|
|
end;
|
|||
|
|
xmlEBCDIC: begin
|
|||
|
|
// TODO: create an EBCDIC IIdTextEncoding implementation...
|
|||
|
|
{$IFDEF STRING_IS_IMMUTABLE}
|
|||
|
|
Len := ReadTIdBytesFromStream(AStream, Buffer, CurPos);
|
|||
|
|
LSB := TStringBuilder.Create(Len);
|
|||
|
|
for I := 0 to Len-1 do begin
|
|||
|
|
LSB.Append(XmlEBCDICTable[Buffer[I]]);
|
|||
|
|
end;
|
|||
|
|
XmlDec := LSB.ToString;
|
|||
|
|
{$ELSE}
|
|||
|
|
XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_8Bit);
|
|||
|
|
for I := 1 to Length(XmlDec) do begin
|
|||
|
|
XmlDec[I] := XmlEBCDICTable[Byte(XmlDec[I])];
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if XmlDec = '' then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
I := Pos('encoding', XmlDec); {do not localize}
|
|||
|
|
if I = 0 then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
XmlDec := TrimLeft(Copy(XmlDec, I+8, MaxInt));
|
|||
|
|
if not CharEquals(XmlDec, 1, '=') then begin {do not localize}
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
XmlDec := TrimLeft(Copy(XmlDec, 2, MaxInt));
|
|||
|
|
if XmlDec = '' then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if XmlDec[1] = #$27 then begin
|
|||
|
|
XmlDec := Copy(XmlDec, 2, MaxInt);
|
|||
|
|
XmlEnc := Fetch(XmlDec, #$27);
|
|||
|
|
end
|
|||
|
|
else if XmlDec[1] = '"' then begin
|
|||
|
|
XmlDec := Copy(XmlDec, 2, MaxInt);
|
|||
|
|
XmlEnc := Fetch(XmlDec, '"');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
XmlEnc := Trim(XmlEnc);
|
|||
|
|
if XmlEnc = '' then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Result := XmlEnc;
|
|||
|
|
finally
|
|||
|
|
AStream.Position := StreamPos;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.ResponseCharset: String;
|
|||
|
|
begin
|
|||
|
|
if IsContentTypeAppXml(Response) then begin
|
|||
|
|
// the media type is not a 'text/...' based XML type, so ignore the
|
|||
|
|
// charset from the headers, if present, and parse the XML itself...
|
|||
|
|
Result := DetectXmlCharset(Response.ContentStream);
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
// RLebeau 1/30/2012: Response.CharSet is now updated at the time
|
|||
|
|
// when HTML content is parsed for <meta> tags ...
|
|||
|
|
|
|||
|
|
// TODO: if the Charset is not specified, return an appropriate value
|
|||
|
|
// that is registered with IANA for the reported ContentType...
|
|||
|
|
|
|||
|
|
Result := Response.CharSet;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
Requires_HTTP_1_1: array[0..4] of String = (Id_HTTPMethodTrace, Id_HTTPMethodPut, Id_HTTPMethodOptions, Id_HTTPMethodDelete, Id_HTTPMethodPatch);
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.PrepareRequest(ARequest: TIdHTTPRequest);
|
|||
|
|
var
|
|||
|
|
LURI: TIdURI;
|
|||
|
|
LHost: string;
|
|||
|
|
begin
|
|||
|
|
LURI := TIdURI.Create(ARequest.URL);
|
|||
|
|
|
|||
|
|
try
|
|||
|
|
if Length(LURI.Username) > 0 then begin
|
|||
|
|
ARequest.Username := LURI.Username;
|
|||
|
|
ARequest.Password := LURI.Password;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
FURI.Username := ARequest.Username;
|
|||
|
|
FURI.Password := ARequest.Password;
|
|||
|
|
|
|||
|
|
FURI.Path := ProcessPath(FURI.Path, LURI.Path);
|
|||
|
|
FURI.Document := LURI.Document;
|
|||
|
|
FURI.Params := LURI.Params;
|
|||
|
|
|
|||
|
|
if Length(LURI.Host) > 0 then begin
|
|||
|
|
FURI.Host := LURI.Host;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(LURI.Protocol) > 0 then begin
|
|||
|
|
FURI.Protocol := LURI.Protocol;
|
|||
|
|
end
|
|||
|
|
// non elegant solution - to be recoded, only for pointing the bug / GREGOR
|
|||
|
|
else if TextIsSame(FURI.Protocol, 'https') then begin {do not localize}
|
|||
|
|
FURI.Protocol := 'https'; {do not localize}
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
FURI.Protocol := 'http'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(LURI.Port) > 0 then begin
|
|||
|
|
FURI.Port := LURI.Port;
|
|||
|
|
end
|
|||
|
|
else if TextIsSame(LURI.Protocol, 'http') then begin {do not localize}
|
|||
|
|
FURI.Port := IntToStr(IdPORT_HTTP);
|
|||
|
|
end
|
|||
|
|
else if TextIsSame(LURI.Protocol, 'https') then begin {do not localize}
|
|||
|
|
FURI.Port := IntToStr(IdPORT_https);
|
|||
|
|
end
|
|||
|
|
else if Length(FURI.Port) = 0 then begin
|
|||
|
|
raise EIdUnknownProtocol.Create(RSHTTPUnknownProtocol);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if (TextIsSame(ARequest.Method, Id_HTTPMethodOptions) or TextIsSame(ARequest.MethodOverride, Id_HTTPMethodOptions))
|
|||
|
|
and TextIsSame(LURI.Document, '*') then {do not localize}
|
|||
|
|
begin
|
|||
|
|
ARequest.URL := LURI.Document;
|
|||
|
|
end else begin
|
|||
|
|
// The URL part is not URL encoded at this place
|
|||
|
|
ARequest.URL := URL.GetPathAndParams;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
ARequest.IPVersion := LURI.IPVersion;
|
|||
|
|
FURI.IPVersion := ARequest.IPVersion;
|
|||
|
|
|
|||
|
|
// Check for valid HTTP request methods
|
|||
|
|
if (PosInStrArray(ARequest.Method, Requires_HTTP_1_1, False) > -1) or
|
|||
|
|
(PosInStrArray(ARequest.MethodOverride, Requires_HTTP_1_1, False) > -1) then
|
|||
|
|
begin
|
|||
|
|
if ProtocolVersion <> pv1_1 then begin
|
|||
|
|
raise EIdException.Create(RSHTTPMethodRequiresVersion);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Assigned(ARequest.Source) then begin
|
|||
|
|
ARequest.ContentLength := ARequest.Source.Size;
|
|||
|
|
end else begin
|
|||
|
|
ARequest.ContentLength := -1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// RLebeau: wrap an IPv6 address in brackets, per RFC 2732, and RFC 3986 section 3.2.2...
|
|||
|
|
if (FURI.IPVersion = Id_IPv6) and (MakeCanonicalIPv6Address(FURI.Host) <> '') then begin
|
|||
|
|
LHost := '[' + FURI.Host + ']'; {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
LHost := FURI.Host;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if (TextIsSame(FURI.Protocol, 'http') and (FURI.Port = IntToStr(IdPORT_HTTP))) or {do not localize}
|
|||
|
|
(TextIsSame(FURI.Protocol, 'https') and (FURI.Port = IntToStr(IdPORT_https))) then {do not localize}
|
|||
|
|
begin
|
|||
|
|
ARequest.Host := LHost;
|
|||
|
|
end else begin
|
|||
|
|
ARequest.Host := LHost + ':' + FURI.Port; {do not localize}
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LURI); // Free URI Object
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.CheckAndConnect(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
begin
|
|||
|
|
if not AResponse.KeepAlive then begin
|
|||
|
|
Disconnect;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Assigned(IOHandler) then begin
|
|||
|
|
IOHandler.InputBuffer.Clear;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
CheckForGracefulDisconnect(False);
|
|||
|
|
|
|||
|
|
if not Connected then try
|
|||
|
|
IPVersion := FURI.IPVersion;
|
|||
|
|
|
|||
|
|
case ARequest.UseProxy of
|
|||
|
|
ctNormal, ctProxy:
|
|||
|
|
begin
|
|||
|
|
if (IOHandler is TIdSSLIOHandlerSocketBase) then begin
|
|||
|
|
TIdSSLIOHandlerSocketBase(IOHandler).PassThrough := True;
|
|||
|
|
TIdSSLIOHandlerSocketBase(IOHandler).URIToCheck := FURI.URI;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
ctSSL, ctSSLProxy:
|
|||
|
|
begin
|
|||
|
|
// if an IOHandler has not been assigned yet, try to create a default SSL IOHandler object
|
|||
|
|
//
|
|||
|
|
// TODO: if an IOHandler has been assigned, but is not an SSL IOHandler,
|
|||
|
|
// release it and try to create a default SSL IOHandler object?
|
|||
|
|
//
|
|||
|
|
if IOHandler = nil then begin
|
|||
|
|
IOHandler := TIdIOHandler.TryMakeIOHandler(TIdSSLIOHandlerSocketBase, Self);
|
|||
|
|
if IOHandler = nil then begin
|
|||
|
|
raise EIdIOHandlerPropInvalid.Create(RSIOHandlerPropInvalid);
|
|||
|
|
end;
|
|||
|
|
IOHandler.OnStatus := OnStatus;
|
|||
|
|
ManagedIOHandler := True;
|
|||
|
|
end
|
|||
|
|
else if not (IOHandler is TIdSSLIOHandlerSocketBase) then begin
|
|||
|
|
raise EIdIOHandlerPropInvalid.Create(RSIOHandlerPropInvalid);
|
|||
|
|
end;
|
|||
|
|
TIdSSLIOHandlerSocketBase(IOHandler).URIToCheck := FURI.URI;
|
|||
|
|
TIdSSLIOHandlerSocketBase(IOHandler).PassThrough := (ARequest.UseProxy = ctSSLProxy);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Connect;
|
|||
|
|
except
|
|||
|
|
on E: EIdSSLProtocolReplyError do begin
|
|||
|
|
Disconnect;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.ConnectToHost(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
var
|
|||
|
|
LLocalHTTP: TIdHTTPProtocol;
|
|||
|
|
LUseConnectVerb: Boolean;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LCompressor: TIdZLibCompressorBase;
|
|||
|
|
LOldProxy: TIdHTTPConnectionType;
|
|||
|
|
LNewDest: string;
|
|||
|
|
begin
|
|||
|
|
LNewDest := URL.Host + ':' + URL.Port;
|
|||
|
|
|
|||
|
|
LOldProxy := ARequest.FUseProxy;
|
|||
|
|
ARequest.FUseProxy := SetHostAndPort;
|
|||
|
|
|
|||
|
|
if ARequest.UseProxy <> LOldProxy then begin
|
|||
|
|
if Connected then begin
|
|||
|
|
Disconnect;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if (ARequest.UseProxy = ctSSLProxy) and (not TextIsSame(ARequest.Destination, LNewDest)) then begin
|
|||
|
|
if Connected then begin
|
|||
|
|
Disconnect;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
ARequest.Destination := LNewDest;
|
|||
|
|
|
|||
|
|
LUseConnectVerb := False;
|
|||
|
|
|
|||
|
|
case ARequest.UseProxy of
|
|||
|
|
ctNormal:
|
|||
|
|
begin
|
|||
|
|
if (ProtocolVersion = pv1_0) and (Length(ARequest.Connection) = 0) then
|
|||
|
|
begin
|
|||
|
|
ARequest.Connection := 'keep-alive'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ctSSL, ctSSLProxy:
|
|||
|
|
begin
|
|||
|
|
ARequest.Connection := '';
|
|||
|
|
if ARequest.UseProxy = ctSSLProxy then begin
|
|||
|
|
// if already connected to an SSL proxy, DO NOT send another
|
|||
|
|
// CONNECT request, as it will be sent directly to the target
|
|||
|
|
// HTTP server and not to the proxy!
|
|||
|
|
LUseConnectVerb := not Connected;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ctProxy:
|
|||
|
|
begin
|
|||
|
|
ARequest.URL := FURI.URI;
|
|||
|
|
if (ProtocolVersion = pv1_0) and (Length(ARequest.Connection) = 0) then
|
|||
|
|
begin
|
|||
|
|
ARequest.ProxyConnection := 'keep-alive'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
if hoNonSSLProxyUseConnectVerb in FOptions then begin
|
|||
|
|
// if already connected to a proxy, DO NOT send another CONNECT
|
|||
|
|
// request, as it will be sent directly to the target HTTP server
|
|||
|
|
// and not to the proxy!
|
|||
|
|
LUseConnectVerb := not Connected;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LCompressor := FCompressor;
|
|||
|
|
if Assigned(LCompressor) and LCompressor.IsReady then begin
|
|||
|
|
if IndyPos('deflate', ARequest.AcceptEncoding) = 0 then {do not localize}
|
|||
|
|
begin
|
|||
|
|
if ARequest.AcceptEncoding <> '' then begin {do not localize}
|
|||
|
|
ARequest.AcceptEncoding := ARequest.AcceptEncoding + ', deflate'; {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
ARequest.AcceptEncoding := 'deflate'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if IndyPos('gzip', ARequest.AcceptEncoding) = 0 then {do not localize}
|
|||
|
|
begin
|
|||
|
|
if ARequest.AcceptEncoding <> '' then begin {do not localize}
|
|||
|
|
ARequest.AcceptEncoding := ARequest.AcceptEncoding + ', gzip'; {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
ARequest.AcceptEncoding := 'gzip'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}LCompressor := nil;{$ENDIF}
|
|||
|
|
|
|||
|
|
// TODO: if AcceptEncoding is blank, DON'T set it to 'identity'! Oddly,
|
|||
|
|
// some faulty servers do not understand 'identity' when explicitly
|
|||
|
|
// stated. It is the default behavior when no "Accept-Encoding" header
|
|||
|
|
// is sent, so just let the server fallback to it normally...
|
|||
|
|
if IndyPos('identity', ARequest.AcceptEncoding) = 0 then begin {do not localize}
|
|||
|
|
if ARequest.AcceptEncoding <> '' then begin
|
|||
|
|
ARequest.AcceptEncoding := ARequest.AcceptEncoding + ', identity'; {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
ARequest.AcceptEncoding := 'identity'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if LUseConnectVerb then begin
|
|||
|
|
LLocalHTTP := CreateProtocol;
|
|||
|
|
try
|
|||
|
|
LLocalHTTP.Request.UserAgent := ARequest.UserAgent;
|
|||
|
|
LLocalHTTP.Request.Host := ARequest.Host;
|
|||
|
|
LLocalHTTP.Request.Pragma := 'no-cache'; {do not localize}
|
|||
|
|
LLocalHTTP.Request.URL := ARequest.Destination;
|
|||
|
|
LLocalHTTP.Request.Method := Id_HTTPMethodConnect;
|
|||
|
|
LLocalHTTP.Request.ProxyConnection := 'keep-alive'; {do not localize}
|
|||
|
|
LLocalHTTP.Request.FUseProxy := ARequest.UseProxy;
|
|||
|
|
|
|||
|
|
// leaving LLocalHTTP.Response.ContentStream set to nil so response data is discarded without wasting memory
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
CheckAndConnect(LLocalHTTP.Request, LLocalHTTP.Response);
|
|||
|
|
LLocalHTTP.BuildAndSendRequest(nil);
|
|||
|
|
|
|||
|
|
LLocalHTTP.Response.ResponseText := InternalReadLn;
|
|||
|
|
if Length(LLocalHTTP.Response.ResponseText) = 0 then begin
|
|||
|
|
// Support for HTTP responses without status line and headers
|
|||
|
|
LLocalHTTP.Response.ResponseText := 'HTTP/1.0 200 OK'; {do not localize}
|
|||
|
|
LLocalHTTP.Response.Connection := 'close'; {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
LLocalHTTP.RetrieveHeaders(MaxHeaderLines);
|
|||
|
|
ProcessCookies(LLocalHTTP.Request, LLocalHTTP.Response);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if (LLocalHTTP.Response.ResponseCode div 100) = 2 then begin
|
|||
|
|
// Connection established
|
|||
|
|
if (ARequest.UseProxy = ctSSLProxy) and (IOHandler is TIdSSLIOHandlerSocketBase) then begin
|
|||
|
|
TIdSSLIOHandlerSocketBase(IOHandler).PassThrough := False;
|
|||
|
|
end;
|
|||
|
|
Break;
|
|||
|
|
end else begin
|
|||
|
|
LLocalHTTP.ProcessResponse([]);
|
|||
|
|
end;
|
|||
|
|
until False;
|
|||
|
|
except
|
|||
|
|
raise;
|
|||
|
|
// TODO: Add property that will contain the error messages.
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LLocalHTTP);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CheckAndConnect(ARequest, AResponse);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
FHTTPProto.BuildAndSendRequest(URL);
|
|||
|
|
|
|||
|
|
// RLebeau 1/31/2008: in order for TIdWebDAV to post data correctly, don't
|
|||
|
|
// restrict which HTTP methods can post (except logically for GET and HEAD),
|
|||
|
|
// especially since TIdCustomHTTP.PrepareRequest() does not differentiate when
|
|||
|
|
// setting up the 'Content-Length' header ...
|
|||
|
|
|
|||
|
|
// TODO: when sending an HTTP 1.1 request with an 'Expect: 100-continue' header,
|
|||
|
|
// do not send the Source data until the server replies with a 100 response code,
|
|||
|
|
// or until a timeout occurs if the server does not send a 100...
|
|||
|
|
|
|||
|
|
if ARequest.Source <> nil then begin
|
|||
|
|
IOHandler.Write(ARequest.Source, 0, False);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.SetAllowCookies(AValue: Boolean);
|
|||
|
|
begin
|
|||
|
|
FAllowCookies := AValue;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.ProcessCookies(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
|
|||
|
|
var
|
|||
|
|
LCookies: TStringList;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LCookieManager: TIdCookieManager;
|
|||
|
|
begin
|
|||
|
|
LCookieManager := FCookieManager;
|
|||
|
|
|
|||
|
|
if (not Assigned(LCookieManager)) and AllowCookies then begin
|
|||
|
|
LCookieManager := TIdCookieManager.Create(Self);
|
|||
|
|
SetCookieManager(LCookieManager);
|
|||
|
|
FImplicitCookieManager := True;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Assigned(LCookieManager) and AllowCookies then begin
|
|||
|
|
LCookies := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
AResponse.RawHeaders.Extract('Set-Cookie', LCookies); {do not localize}
|
|||
|
|
AResponse.MetaHTTPEquiv.RawHeaders.Extract('Set-Cookie', LCookies); {do not localize}
|
|||
|
|
LCookieManager.AddServerCookies(LCookies, FURI);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LCookies);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// under ARC, all weak references to a freed object get nil'ed automatically
|
|||
|
|
// so this is mostly redundant
|
|||
|
|
procedure TIdCustomHTTP.Notification(AComponent: TComponent; Operation: TOperation);
|
|||
|
|
begin
|
|||
|
|
if Operation = opRemove then begin
|
|||
|
|
if (AComponent = FCookieManager) then begin
|
|||
|
|
FCookieManager := nil;
|
|||
|
|
FImplicitCookieManager := False;
|
|||
|
|
end
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
else if (AComponent = FAuthenticationManager) then begin
|
|||
|
|
FAuthenticationManager := nil;
|
|||
|
|
end else if (AComponent = FCompressor) then begin
|
|||
|
|
FCompressor := nil;
|
|||
|
|
end
|
|||
|
|
{$ENDIF}
|
|||
|
|
;
|
|||
|
|
end;
|
|||
|
|
inherited Notification(AComponent, Operation);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.SetCookieManager(ACookieManager: TIdCookieManager);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LCookieManager: TIdCookieManager;
|
|||
|
|
begin
|
|||
|
|
LCookieManager := FCookieManager;
|
|||
|
|
|
|||
|
|
if LCookieManager <> ACookieManager then begin
|
|||
|
|
|
|||
|
|
// under ARC, all weak references to a freed object get nil'ed automatically
|
|||
|
|
|
|||
|
|
if Assigned(LCookieManager) then begin
|
|||
|
|
if FImplicitCookieManager then begin
|
|||
|
|
FCookieManager := nil;
|
|||
|
|
FImplicitCookieManager := False;
|
|||
|
|
IdDisposeAndNil(LCookieManager);
|
|||
|
|
end else begin
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
LCookieManager.RemoveFreeNotification(Self);
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
FCookieManager := ACookieManager;
|
|||
|
|
FImplicitCookieManager := False;
|
|||
|
|
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
if Assigned(ACookieManager) then begin
|
|||
|
|
ACookieManager.FreeNotification(Self);
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.DoOnAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean;
|
|||
|
|
var
|
|||
|
|
i: Integer;
|
|||
|
|
S: string;
|
|||
|
|
LAuthCls: TIdAuthenticationClass;
|
|||
|
|
LAuth: TIdAuthentication;
|
|||
|
|
begin
|
|||
|
|
Inc(FAuthRetries);
|
|||
|
|
if not Assigned(ARequest.Authentication) then begin
|
|||
|
|
// Find wich Authentication method is supported from us.
|
|||
|
|
LAuthCls := nil;
|
|||
|
|
|
|||
|
|
for i := 0 to AResponse.WWWAuthenticate.Count - 1 do begin
|
|||
|
|
S := AResponse.WWWAuthenticate[i];
|
|||
|
|
LAuthCls := FindAuthClass(Fetch(S));
|
|||
|
|
if Assigned(LAuthCls) then begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// let the user override us, if desired.
|
|||
|
|
if Assigned(FOnSelectAuthorization) then begin
|
|||
|
|
OnSelectAuthorization(Self, LAuthCls, AResponse.WWWAuthenticate);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if not Assigned(LAuthCls) then begin
|
|||
|
|
Result := False;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
ARequest.Authentication := LAuthCls.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
this is commented out as it breaks SSPI and NTLM authentication. it is
|
|||
|
|
normal and expected to get multiple 407 responses during negotiation.
|
|||
|
|
|
|||
|
|
// Clear password and reset autorization if previous failed
|
|||
|
|
if (AResponse.FResponseCode = 401) then begin
|
|||
|
|
ARequest.Password := '';
|
|||
|
|
ARequest.Authentication.Reset;
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
// S.G. 20/10/2003: Added part about the password. Not testing user name as some
|
|||
|
|
// S.G. 20/10/2003: web sites do not require user name, only password.
|
|||
|
|
//
|
|||
|
|
// RLebeau 11/18/2014: what about SSPI? It does not require an explicit
|
|||
|
|
// username/password as it can use the identity of the user token associated
|
|||
|
|
// with the calling thread!
|
|||
|
|
//
|
|||
|
|
Result := Assigned(FOnAuthorization) or (Trim(ARequest.Password) <> '');
|
|||
|
|
|
|||
|
|
if not Result then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LAuth := ARequest.Authentication;
|
|||
|
|
LAuth.Username := ARequest.Username;
|
|||
|
|
LAuth.Password := ARequest.Password;
|
|||
|
|
// S.G. 20/10/2003: ToDo: We need to have a marker here to prevent the code to test with the same username/password combo
|
|||
|
|
// S.G. 20/10/2003: if they are picked up from properties.
|
|||
|
|
LAuth.Params.Values['Authorization'] := ARequest.Authentication.Authentication; {do not localize}
|
|||
|
|
LAuth.AuthParams := AResponse.WWWAuthenticate;
|
|||
|
|
|
|||
|
|
Result := False;
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
case LAuth.Next of
|
|||
|
|
wnAskTheProgram:
|
|||
|
|
begin // Ask the user porgram to supply us with authorization information
|
|||
|
|
if Assigned(FOnAuthorization) then
|
|||
|
|
begin
|
|||
|
|
LAuth.UserName := ARequest.Username;
|
|||
|
|
LAuth.Password := ARequest.Password;
|
|||
|
|
|
|||
|
|
OnAuthorization(Self, LAuth, Result);
|
|||
|
|
|
|||
|
|
if Result then begin
|
|||
|
|
ARequest.BasicAuthentication := True;
|
|||
|
|
ARequest.Username := LAuth.UserName;
|
|||
|
|
ARequest.Password := LAuth.Password;
|
|||
|
|
end else begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
wnDoRequest:
|
|||
|
|
begin
|
|||
|
|
Result := True;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
wnFail:
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
until False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.DoOnProxyAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean;
|
|||
|
|
var
|
|||
|
|
i: Integer;
|
|||
|
|
S: string;
|
|||
|
|
LAuthCls: TIdAuthenticationClass;
|
|||
|
|
LAuth: TIdAuthentication;
|
|||
|
|
begin
|
|||
|
|
Inc(FAuthProxyRetries);
|
|||
|
|
if not Assigned(ProxyParams.Authentication) then begin
|
|||
|
|
// Find which Authentication method is supported from us.
|
|||
|
|
LAuthCls := nil;
|
|||
|
|
|
|||
|
|
for i := 0 to AResponse.ProxyAuthenticate.Count-1 do begin
|
|||
|
|
S := AResponse.ProxyAuthenticate[i];
|
|||
|
|
LAuthCls := FindAuthClass(Fetch(S));
|
|||
|
|
if Assigned(LAuthCls) then begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// let the user override us, if desired.
|
|||
|
|
if Assigned(FOnSelectProxyAuthorization) then begin
|
|||
|
|
OnSelectProxyAuthorization(Self, LAuthCls, AResponse.ProxyAuthenticate);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if not Assigned(LAuthCls) then begin
|
|||
|
|
Result := False;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
ProxyParams.Authentication := LAuthCls.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
this is commented out as it breaks SSPI and NTLM authentication. it is
|
|||
|
|
normal and expected to get multiple 407 responses during negotiation.
|
|||
|
|
|
|||
|
|
// Clear password and reset authorization if previous failed
|
|||
|
|
if (AResponse.FResponseCode = 407) then begin
|
|||
|
|
ProxyParams.ProxyPassword := '';
|
|||
|
|
ProxyParams.Authentication.Reset;
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
// RLebeau 11/18/2014: Added part about the password. Not testing user name
|
|||
|
|
// as some proxies do not require user name, only password.
|
|||
|
|
//
|
|||
|
|
// RLebeau 11/18/2014: what about SSPI? It does not require an explicit
|
|||
|
|
// username/password as it can use the identity of the user token associated
|
|||
|
|
// with the calling thread!
|
|||
|
|
//
|
|||
|
|
Result := Assigned(OnProxyAuthorization) or (Trim(ProxyParams.ProxyPassword) <> '');
|
|||
|
|
|
|||
|
|
if not Result then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LAuth := ProxyParams.Authentication;
|
|||
|
|
LAuth.Username := ProxyParams.ProxyUsername;
|
|||
|
|
LAuth.Password := ProxyParams.ProxyPassword;
|
|||
|
|
// TODO: do we need to set this, like DoOnAuthorization does?
|
|||
|
|
//LAuth.Params.Values['Authorization'] := ProxyParams.Authentication; {do not localize}
|
|||
|
|
LAuth.AuthParams := AResponse.ProxyAuthenticate;
|
|||
|
|
|
|||
|
|
Result := False;
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
case LAuth.Next of
|
|||
|
|
wnAskTheProgram: // Ask the user porgram to supply us with authorization information
|
|||
|
|
begin
|
|||
|
|
if Assigned(OnProxyAuthorization) then
|
|||
|
|
begin
|
|||
|
|
LAuth.Username := ProxyParams.ProxyUsername;
|
|||
|
|
LAuth.Password := ProxyParams.ProxyPassword;
|
|||
|
|
|
|||
|
|
OnProxyAuthorization(Self, LAuth, Result);
|
|||
|
|
|
|||
|
|
if Result then begin
|
|||
|
|
// TODO: do we need to set this, like DoOnAuthorization does?
|
|||
|
|
//ProxyParams.BasicAuthentication := True;
|
|||
|
|
ProxyParams.ProxyUsername := LAuth.Username;
|
|||
|
|
ProxyParams.ProxyPassword := LAuth.Password;
|
|||
|
|
end else begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
wnDoRequest:
|
|||
|
|
begin
|
|||
|
|
Result := True;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
wnFail:
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
until False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.GetResponseCode: Integer;
|
|||
|
|
begin
|
|||
|
|
Result := Response.ResponseCode;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.GetResponseText: string;
|
|||
|
|
begin
|
|||
|
|
Result := Response.ResponseText;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.GetResponse: TIdHTTPResponse;
|
|||
|
|
begin
|
|||
|
|
Result := FHTTPProto.Response;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.GetRequest: TIdHTTPRequest;
|
|||
|
|
begin
|
|||
|
|
Result := FHTTPProto.Request;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.GetMetaHTTPEquiv: TIdMetaHTTPEquiv;
|
|||
|
|
begin
|
|||
|
|
Result := Response.MetaHTTPEquiv;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.DoOnDisconnected;
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LAuthManager: TIdAuthenticationManager;
|
|||
|
|
begin
|
|||
|
|
inherited DoOnDisconnected;
|
|||
|
|
|
|||
|
|
if Assigned(Request.Authentication) and
|
|||
|
|
(Request.Authentication.CurrentStep = Request.Authentication.Steps) then
|
|||
|
|
begin
|
|||
|
|
LAuthManager := AuthenticationManager;
|
|||
|
|
if Assigned(LAuthManager) then begin
|
|||
|
|
LAuthManager.AddAuthentication(Request.Authentication, URL);
|
|||
|
|
end;
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
Request.Authentication.Free;
|
|||
|
|
{$ENDIF}
|
|||
|
|
Request.Authentication := nil;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Assigned(ProxyParams.Authentication) and
|
|||
|
|
(ProxyParams.Authentication.CurrentStep = ProxyParams.Authentication.Steps) then begin
|
|||
|
|
ProxyParams.Authentication.Reset;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.SetAuthenticationManager(Value: TIdAuthenticationManager);
|
|||
|
|
begin
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}
|
|||
|
|
// under ARC, all weak references to a freed object get nil'ed automatically
|
|||
|
|
FAuthenticationManager := Value;
|
|||
|
|
{$ELSE}
|
|||
|
|
if FAuthenticationManager <> Value then begin
|
|||
|
|
if Assigned(FAuthenticationManager) then begin
|
|||
|
|
FAuthenticationManager.RemoveFreeNotification(self);
|
|||
|
|
end;
|
|||
|
|
FAuthenticationManager := Value;
|
|||
|
|
if Assigned(FAuthenticationManager) then begin
|
|||
|
|
FAuthenticationManager.FreeNotification(Self);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
procedure TIdCustomHTTP.SetHost(const Value: string);
|
|||
|
|
begin
|
|||
|
|
inherited SetHost(Value);
|
|||
|
|
URL.Host := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.SetPort(const Value: integer);
|
|||
|
|
begin
|
|||
|
|
inherited SetPort(Value);
|
|||
|
|
URL.Port := IntToStr(Value);
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
procedure TIdCustomHTTP.SetRequest(Value: TIdHTTPRequest);
|
|||
|
|
begin
|
|||
|
|
FHTTPProto.Request.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.SetProxyParams(AValue: TIdProxyConnectionInfo);
|
|||
|
|
begin
|
|||
|
|
FProxyParameters.Assign(AValue);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Post(AURL: string; ASource: TIdMultiPartFormDataStream;
|
|||
|
|
AResponseContent: TStream);
|
|||
|
|
begin
|
|||
|
|
Assert(ASource<>nil);
|
|||
|
|
Request.ContentType := ASource.RequestContentType;
|
|||
|
|
// TODO: Request.CharSet := ASource.RequestCharSet;
|
|||
|
|
Post(AURL, TStream(ASource), AResponseContent);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Post(AURL: string; ASource: TIdMultiPartFormDataStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
begin
|
|||
|
|
Assert(ASource<>nil);
|
|||
|
|
Request.ContentType := ASource.RequestContentType;
|
|||
|
|
// TODO: Request.CharSet := ASource.RequestCharSet;
|
|||
|
|
Result := Post(AURL, TStream(ASource){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdHTTPResponse }
|
|||
|
|
|
|||
|
|
constructor TIdHTTPResponse.Create(AHTTP: TIdCustomHTTP);
|
|||
|
|
begin
|
|||
|
|
inherited Create(AHTTP);
|
|||
|
|
FHTTP := AHTTP;
|
|||
|
|
FResponseCode := -1;
|
|||
|
|
FMetaHTTPEquiv := TIdMetaHTTPEquiv.Create(AHTTP);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdHTTPResponse.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FMetaHTTPEquiv);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdHTTPResponse.Clear;
|
|||
|
|
begin
|
|||
|
|
inherited Clear;
|
|||
|
|
FMetaHTTPEquiv.Clear;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdHTTPResponse.ProcessMetaHTTPEquiv;
|
|||
|
|
var
|
|||
|
|
StdValues: TStringList;
|
|||
|
|
I: Integer;
|
|||
|
|
Name: String;
|
|||
|
|
begin
|
|||
|
|
FMetaHTTPEquiv.ProcessMetaHTTPEquiv(ContentStream);
|
|||
|
|
if FMetaHTTPEquiv.RawHeaders.Count > 0 then begin
|
|||
|
|
// TODO: optimize this
|
|||
|
|
StdValues := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
FMetaHTTPEquiv.RawHeaders.ConvertToStdValues(StdValues);
|
|||
|
|
for I := 0 to StdValues.Count-1 do begin
|
|||
|
|
Name := StdValues.Names[I];
|
|||
|
|
if Name <> '' then begin
|
|||
|
|
RawHeaders.Values[Name] := IndyValueFromIndex(StdValues, I);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
StdValues.Free;
|
|||
|
|
end;
|
|||
|
|
ProcessHeaders;
|
|||
|
|
end;
|
|||
|
|
if FMetaHTTPEquiv.CharSet <> '' then begin
|
|||
|
|
FCharSet := FMetaHTTPEquiv.CharSet;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdHTTPResponse.GetKeepAlive: Boolean;
|
|||
|
|
begin
|
|||
|
|
if FHTTP.Connected then begin
|
|||
|
|
FHTTP.IOHandler.CheckForDisconnect(False);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
FKeepAlive := FHTTP.Connected;
|
|||
|
|
|
|||
|
|
if FKeepAlive then
|
|||
|
|
begin
|
|||
|
|
case FHTTP.ProtocolVersion of // TODO: use ResponseVersion instead?
|
|||
|
|
pv1_1:
|
|||
|
|
{ By default we assume that keep-alive is by default and will close
|
|||
|
|
the connection only there is "close" }
|
|||
|
|
begin
|
|||
|
|
FKeepAlive := not (
|
|||
|
|
TextIsSame(Trim(Connection), 'CLOSE') or {do not localize}
|
|||
|
|
TextIsSame(Trim(ProxyConnection), 'CLOSE') {do not localize}
|
|||
|
|
);
|
|||
|
|
end;
|
|||
|
|
pv1_0:
|
|||
|
|
{ By default we assume that keep-alive is not by default and will keep
|
|||
|
|
the connection only if there is "keep-alive" }
|
|||
|
|
begin
|
|||
|
|
FKeepAlive :=
|
|||
|
|
TextIsSame(Trim(Connection), 'KEEP-ALIVE') or {do not localize}
|
|||
|
|
TextIsSame(Trim(ProxyConnection), 'KEEP-ALIVE') {do not localize}
|
|||
|
|
{ or ((ResponseVersion = pv1_1) and
|
|||
|
|
(Length(Trim(Connection)) = 0) and
|
|||
|
|
(Length(Trim(ProxyConnection)) = 0)) };
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Result := FKeepAlive;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdHTTPResponse.GetResponseCode: Integer;
|
|||
|
|
var
|
|||
|
|
S, Tmp: string;
|
|||
|
|
begin
|
|||
|
|
if FResponseCode = -1 then
|
|||
|
|
begin
|
|||
|
|
S := FResponseText;
|
|||
|
|
Fetch(S);
|
|||
|
|
S := Trim(S);
|
|||
|
|
// RLebeau: IIS supports status codes with decimals in them, but it is not supposed to
|
|||
|
|
// transmit them to clients, which is a violation of RFC 2616. But have seen it happen,
|
|||
|
|
// so check for it...
|
|||
|
|
Tmp := Fetch(S, ' ', False); {do not localize}
|
|||
|
|
S := Fetch(Tmp, '.', False); {do not localize}
|
|||
|
|
FResponseCode := IndyStrToInt(S, -1);
|
|||
|
|
end;
|
|||
|
|
Result := FResponseCode;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdHTTPResponse.SetResponseText(const AValue: String);
|
|||
|
|
var
|
|||
|
|
S: String;
|
|||
|
|
i: TIdHTTPProtocolVersion;
|
|||
|
|
begin
|
|||
|
|
FResponseText := AValue;
|
|||
|
|
FResponseCode := -1; // re-parse the next time it is accessed
|
|||
|
|
ResponseVersion := pv1_0; // default until determined otherwise...
|
|||
|
|
S := Copy(FResponseText, 6, 3);
|
|||
|
|
for i := Low(TIdHTTPProtocolVersion) to High(TIdHTTPProtocolVersion) do begin
|
|||
|
|
if TextIsSame(ProtocolVersionString[i], S) then begin
|
|||
|
|
ResponseVersion := i;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdHTTPRequest }
|
|||
|
|
|
|||
|
|
constructor TIdHTTPRequest.Create(AHTTP: TIdCustomHTTP);
|
|||
|
|
begin
|
|||
|
|
inherited Create(AHTTP);
|
|||
|
|
FHTTP := AHTTP;
|
|||
|
|
FUseProxy := ctNormal;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdHTTPProtocol }
|
|||
|
|
|
|||
|
|
constructor TIdHTTPProtocol.Create(AConnection: TIdCustomHTTP);
|
|||
|
|
begin
|
|||
|
|
inherited Create;
|
|||
|
|
FHTTP := AConnection;
|
|||
|
|
// Create the headers
|
|||
|
|
FRequest := TIdHTTPRequest.Create(FHTTP);
|
|||
|
|
FResponse := TIdHTTPResponse.Create(FHTTP);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdHTTPProtocol.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FRequest);
|
|||
|
|
FreeAndNil(FResponse);
|
|||
|
|
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdHTTPProtocol.BuildAndSendRequest(AURI: TIdURI);
|
|||
|
|
var
|
|||
|
|
i: Integer;
|
|||
|
|
LBufferingStarted: Boolean;
|
|||
|
|
begin
|
|||
|
|
// needed for Digest authentication, but maybe others as well...
|
|||
|
|
if Assigned(Request.Authentication) then begin
|
|||
|
|
// TODO: include entity body for Digest "auth-int" qop...
|
|||
|
|
Request.Authentication.SetRequest(Request.Method, Request.URL);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// TODO: disable header folding for HTTP 1.0 requests
|
|||
|
|
Request.SetHeaders;
|
|||
|
|
FHTTP.ProxyParams.SetHeaders(Request.RawHeaders);
|
|||
|
|
if Assigned(AURI) then begin
|
|||
|
|
FHTTP.SetCookies(AURI, Request);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// This is a workaround for some HTTP servers which do not implement
|
|||
|
|
// the HTTP protocol properly
|
|||
|
|
LBufferingStarted := not FHTTP.IOHandler.WriteBufferingActive;
|
|||
|
|
if LBufferingStarted then begin
|
|||
|
|
FHTTP.IOHandler.WriteBufferOpen;
|
|||
|
|
end;
|
|||
|
|
try
|
|||
|
|
FHTTP.IOHandler.WriteLn(Request.Method + ' ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]); {do not localize}
|
|||
|
|
// write the headers
|
|||
|
|
for i := 0 to Request.RawHeaders.Count - 1 do begin
|
|||
|
|
if Length(Request.RawHeaders.Strings[i]) > 0 then begin
|
|||
|
|
FHTTP.IOHandler.WriteLn(Request.RawHeaders.Strings[i]);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
FHTTP.IOHandler.WriteLn(''); {do not localize}
|
|||
|
|
if LBufferingStarted then begin
|
|||
|
|
FHTTP.IOHandler.WriteBufferClose;
|
|||
|
|
end;
|
|||
|
|
except
|
|||
|
|
if LBufferingStarted then begin
|
|||
|
|
FHTTP.IOHandler.WriteBufferCancel;
|
|||
|
|
end;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdHTTPProtocol.RetrieveHeaders(AMaxHeaderCount: integer);
|
|||
|
|
var
|
|||
|
|
s: string;
|
|||
|
|
LHeaderCount: Integer;
|
|||
|
|
begin
|
|||
|
|
// Set the response headers
|
|||
|
|
// Clear headers
|
|||
|
|
// Don't use Capture.
|
|||
|
|
// S.G. 6/4/2004: Added AmaxHeaderCount parameter to prevent the "header bombing" of the server
|
|||
|
|
Response.Clear;
|
|||
|
|
s := FHTTP.InternalReadLn;
|
|||
|
|
try
|
|||
|
|
LHeaderCount := 0;
|
|||
|
|
while (s <> '') and ( (AMaxHeaderCount > 0) or (LHeaderCount < AMaxHeaderCount) ) do
|
|||
|
|
begin
|
|||
|
|
Response.RawHeaders.Add(S);
|
|||
|
|
s := FHTTP.InternalReadLn;
|
|||
|
|
Inc(LHeaderCount);
|
|||
|
|
end;
|
|||
|
|
except
|
|||
|
|
on E: EIdConnClosedGracefully do begin
|
|||
|
|
FHTTP.Disconnect;
|
|||
|
|
end else begin
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Response.ProcessHeaders;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdHTTPProtocol.ProcessResponse(AIgnoreReplies: array of Int16): TIdHTTPWhatsNext;
|
|||
|
|
var
|
|||
|
|
LResponseCode, LResponseDigit: Integer;
|
|||
|
|
|
|||
|
|
procedure CheckException;
|
|||
|
|
var
|
|||
|
|
i: Integer;
|
|||
|
|
LTempResponse: TMemoryStream;
|
|||
|
|
LTempStream: TStream;
|
|||
|
|
begin
|
|||
|
|
LTempResponse := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
LTempStream := Response.ContentStream;
|
|||
|
|
Response.ContentStream := LTempResponse;
|
|||
|
|
try
|
|||
|
|
try
|
|||
|
|
FHTTP.ReadResult(Request, Response);
|
|||
|
|
except
|
|||
|
|
on E: EIdConnClosedGracefully do begin
|
|||
|
|
FHTTP.Disconnect;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if hoNoProtocolErrorException in FHTTP.HTTPOptions then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if High(AIgnoreReplies) > -1 then begin
|
|||
|
|
for i := Low(AIgnoreReplies) to High(AIgnoreReplies) do begin
|
|||
|
|
if LResponseCode = AIgnoreReplies[i] then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LTempResponse.Position := 0;
|
|||
|
|
raise EIdHTTPProtocolException.CreateError(LResponseCode, FHTTP.ResponseText,
|
|||
|
|
ReadStringAsCharset(LTempResponse, FHTTP.ResponseCharSet));
|
|||
|
|
finally
|
|||
|
|
Response.ContentStream := LTempStream;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LTempResponse);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure DiscardContent;
|
|||
|
|
var
|
|||
|
|
LOrigStream: TStream;
|
|||
|
|
begin
|
|||
|
|
LOrigStream := Response.ContentStream;
|
|||
|
|
Response.ContentStream := nil;
|
|||
|
|
try
|
|||
|
|
try
|
|||
|
|
FHTTP.ReadResult(Request, Response);
|
|||
|
|
except
|
|||
|
|
on E: EIdConnClosedGracefully do begin
|
|||
|
|
FHTTP.Disconnect;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
Response.ContentStream := LOrigStream;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function HeadersCanContinue: Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := True;
|
|||
|
|
if Assigned(FHTTP.OnHeadersAvailable) then begin
|
|||
|
|
FHTTP.OnHeadersAvailable(FHTTP, Response.RawHeaders, Result);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
var
|
|||
|
|
LLocation: string;
|
|||
|
|
LMethod: TIdHTTPMethod;
|
|||
|
|
LNeedAuth: Boolean;
|
|||
|
|
//LTemp: Integer;
|
|||
|
|
begin
|
|||
|
|
|
|||
|
|
// provide the user with the headers and let the user decide
|
|||
|
|
// whether the response processing should continue...
|
|||
|
|
if not HeadersCanContinue then begin
|
|||
|
|
Response.KeepAlive := False; // TODO: provide the user an option whether to force DoRequest() to disconnect the connection or not
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Cache this as ResponseCode calls GetResponseCode which parses it out
|
|||
|
|
LResponseCode := Response.ResponseCode;
|
|||
|
|
LResponseDigit := LResponseCode div 100;
|
|||
|
|
LNeedAuth := False;
|
|||
|
|
|
|||
|
|
// Handle Redirects
|
|||
|
|
// RLebeau: All 3xx replies other than 304 are redirects. Reply 201 has a
|
|||
|
|
// Location header but is NOT a redirect!
|
|||
|
|
|
|||
|
|
// RLebeau 4/21/2011: Amazon S3 includes a Location header in its 200 reply
|
|||
|
|
// to some PUT requests. Not sure if this is a bug or intentional, but we
|
|||
|
|
// should NOT perform a redirect for any replies other than 3xx. Amazon S3
|
|||
|
|
// does NOT include a Location header in its 301 reply, though! This is
|
|||
|
|
// intentional, per Amazon's documentation, as a way for developers to
|
|||
|
|
// detect when URLs are addressed incorrectly...
|
|||
|
|
|
|||
|
|
if (LResponseDigit = 3) and (LResponseCode <> 304) then
|
|||
|
|
begin
|
|||
|
|
if Response.Location = '' then begin
|
|||
|
|
CheckException;
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Inc(FHTTP.FRedirectCount);
|
|||
|
|
|
|||
|
|
// LLocation := TIdURI.URLDecode(Response.Location);
|
|||
|
|
LLocation := Response.Location;
|
|||
|
|
LMethod := Request.Method;
|
|||
|
|
|
|||
|
|
// fire the event
|
|||
|
|
if not FHTTP.DoOnRedirect(LLocation, LMethod, FHTTP.FRedirectCount) then begin
|
|||
|
|
CheckException;
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if (FHTTP.FHandleRedirects) and (FHTTP.FRedirectCount < FHTTP.FRedirectMax) then begin
|
|||
|
|
Result := wnGoToURL;
|
|||
|
|
Request.URL := LLocation;
|
|||
|
|
|
|||
|
|
// GDG 21/11/2003. If it's a 303, we should do a get this time
|
|||
|
|
|
|||
|
|
// RLebeau 7/15/2004 - do a GET on 302 as well, as mentioned in RFC 2616
|
|||
|
|
|
|||
|
|
// RLebeau 1/11/2008 - turns out both situations are WRONG! RFCs 2068 and
|
|||
|
|
// 2616 specifically state that changing the method to GET in response
|
|||
|
|
// to 302 and 303 is errorneous. Indy 9 did it right by reusing the
|
|||
|
|
// original method and source again and only changing the URL, so lets
|
|||
|
|
// revert back to that same behavior!
|
|||
|
|
|
|||
|
|
// RLebeau 12/28/2012 - one more time. RFCs 2068 and 2616 actually say that
|
|||
|
|
// changing the method in response to 302 is erroneous, but changing the
|
|||
|
|
// method to GET in response to 303 is intentional and why 303 was introduced
|
|||
|
|
// in the first place. Erroneous clients treat 302 as 303, though. Now
|
|||
|
|
// encountering servers that actually expect this 303 behavior, so we have
|
|||
|
|
// to enable it again! Adding an optional HTTPOption flag so clients can
|
|||
|
|
// enable the erroneous 302 behavior if they really need it.
|
|||
|
|
|
|||
|
|
if ((LResponseCode = 302) and (hoTreat302Like303 in FHTTP.HTTPOptions)) or
|
|||
|
|
(LResponseCode = 303) then
|
|||
|
|
begin
|
|||
|
|
Request.Source := nil;
|
|||
|
|
Request.Method := Id_HTTPMethodGet;
|
|||
|
|
end else begin
|
|||
|
|
Request.Method := LMethod;
|
|||
|
|
end;
|
|||
|
|
Request.MethodOverride := '';
|
|||
|
|
end else begin
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
Response.Location := LLocation;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if FHTTP.Connected then begin
|
|||
|
|
// This is a workaround for buggy HTTP 1.1 servers which
|
|||
|
|
// does not return any body with 302 response code
|
|||
|
|
DiscardContent; // may wait a few seconds for any kind of content
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//Ciaran, 30th Nov 2004: I commented out the following code. When a https server
|
|||
|
|
//sends a disconnect immediately after sending the requested page in an SSL
|
|||
|
|
//session (which they sometimes do to indicate a "session" is finished), the code
|
|||
|
|
//below causes a "Connection closed gracefully" exception BUT the returned page
|
|||
|
|
//is lost (IOHandler.Request is empty). If the code below is re-enabled by
|
|||
|
|
//someone for whatever reason, they MUST test for this case.
|
|||
|
|
// GREGOR Workaround
|
|||
|
|
// if we get an error we disconnect if we use SSLIOHandler
|
|||
|
|
//if Assigned(FHTTP.IOHandler) then
|
|||
|
|
//begin
|
|||
|
|
// Response.KeepAlive := not (FHTTP.Connected and (FHTTP.IOHandler is TIdSSLIOHandlerSocketBase) and Response.KeepAlive);
|
|||
|
|
//end;
|
|||
|
|
|
|||
|
|
// RLebeau 2/15/2006: RFC 1945 states the following:
|
|||
|
|
//
|
|||
|
|
// For response messages, whether or not an entity body is included with
|
|||
|
|
// a message is dependent on both the request method and the response
|
|||
|
|
// code. All responses to the HEAD request method must not include a
|
|||
|
|
// body, even though the presence of entity header fields may lead one
|
|||
|
|
// to believe they do. All 1xx (informational), 204 (no content), and
|
|||
|
|
// 304 (not modified) responses must not include a body. All other
|
|||
|
|
// responses must include an entity body or a Content-Length header
|
|||
|
|
// field defined with a value of zero (0).
|
|||
|
|
|
|||
|
|
if LResponseDigit <> 2 then begin
|
|||
|
|
case LResponseCode of
|
|||
|
|
401:
|
|||
|
|
begin // HTTP Server authorization required
|
|||
|
|
if (FHTTP.AuthRetries >= FHTTP.MaxAuthRetries) or
|
|||
|
|
(not FHTTP.DoOnAuthorization(Request, Response)) then begin
|
|||
|
|
if Assigned(Request.Authentication) then begin
|
|||
|
|
Request.Authentication.Reset;
|
|||
|
|
end;
|
|||
|
|
CheckException;
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
Exit;
|
|||
|
|
end else begin
|
|||
|
|
LNeedAuth := hoInProcessAuth in FHTTP.HTTPOptions;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
407:
|
|||
|
|
begin // Proxy Server authorization requered
|
|||
|
|
if (FHTTP.AuthProxyRetries >= FHTTP.MaxAuthRetries) or
|
|||
|
|
(not FHTTP.DoOnProxyAuthorization(Request, Response)) then
|
|||
|
|
begin
|
|||
|
|
if Assigned(FHTTP.ProxyParams.Authentication) then begin
|
|||
|
|
FHTTP.ProxyParams.Authentication.Reset;
|
|||
|
|
end;
|
|||
|
|
CheckException;
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
Exit;
|
|||
|
|
end else begin
|
|||
|
|
LNeedAuth := hoInProcessAuth in FHTTP.HTTPOptions;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
else begin
|
|||
|
|
CheckException;
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if LNeedAuth then begin
|
|||
|
|
// discard the content of Error message
|
|||
|
|
DiscardContent;
|
|||
|
|
Result := wnAuthRequest;
|
|||
|
|
end else
|
|||
|
|
begin
|
|||
|
|
// RLebeau 6/30/2006: DO NOT READ IF THE REQUEST IS HEAD!!!
|
|||
|
|
// The server is supposed to send a 'Content-Length' header
|
|||
|
|
// without sending the actual data...
|
|||
|
|
if TextIsSame(Request.Method, Id_HTTPMethodHead) or
|
|||
|
|
TextIsSame(Request.MethodOverride, Id_HTTPMethodHead) or
|
|||
|
|
(LResponseCode = 204) then
|
|||
|
|
begin
|
|||
|
|
// Have noticed one case where a non-conforming server did send an
|
|||
|
|
// entity body in response to a HEAD request. If requested, ignore
|
|||
|
|
// anything the server may send by accident
|
|||
|
|
DiscardContent;
|
|||
|
|
end else begin
|
|||
|
|
FHTTP.ReadResult(Request, Response);
|
|||
|
|
end;
|
|||
|
|
Result := wnJustExit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.CreateProtocol: TIdHTTPProtocol;
|
|||
|
|
begin
|
|||
|
|
Result := TIdHTTPProtocol.Create(Self);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.InitComponent;
|
|||
|
|
begin
|
|||
|
|
inherited;
|
|||
|
|
FURI := TIdURI.Create('');
|
|||
|
|
|
|||
|
|
FAuthRetries := 0;
|
|||
|
|
FAuthProxyRetries := 0;
|
|||
|
|
AllowCookies := True;
|
|||
|
|
FImplicitCookieManager := False;
|
|||
|
|
FOptions := [hoForceEncodeParams];
|
|||
|
|
|
|||
|
|
FRedirectMax := Id_TIdHTTP_RedirectMax;
|
|||
|
|
FHandleRedirects := Id_TIdHTTP_HandleRedirects;
|
|||
|
|
//
|
|||
|
|
FProtocolVersion := Id_TIdHTTP_ProtocolVersion;
|
|||
|
|
|
|||
|
|
FHTTPProto := CreateProtocol;
|
|||
|
|
FProxyParameters := TIdProxyConnectionInfo.Create;
|
|||
|
|
FProxyParameters.Clear;
|
|||
|
|
|
|||
|
|
FMaxAuthRetries := Id_TIdHTTP_MaxAuthRetries;
|
|||
|
|
FMaxHeaderLines := Id_TIdHTTP_MaxHeaderLines;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.InternalReadLn: String;
|
|||
|
|
begin
|
|||
|
|
Result := IOHandler.ReadLn;
|
|||
|
|
if IOHandler.ReadLnTimedout then begin
|
|||
|
|
raise EIdReadTimeout.Create(RSReadTimeout);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Get(AURL: string; AIgnoreReplies: array of Int16
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LStream: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LStream := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
Get(AURL, LStream, AIgnoreReplies);
|
|||
|
|
LStream.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LStream, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Get(AURL: string; AResponseContent: TStream;
|
|||
|
|
AIgnoreReplies: array of Int16);
|
|||
|
|
begin
|
|||
|
|
DoRequest(Id_HTTPMethodGet, AURL, nil, AResponseContent, AIgnoreReplies);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.DoRequest(const AMethod: TIdHTTPMethod;
|
|||
|
|
AURL: string; ASource, AResponseContent: TStream;
|
|||
|
|
AIgnoreReplies: array of Int16);
|
|||
|
|
var
|
|||
|
|
LResponseLocation: TIdStreamSize;
|
|||
|
|
begin
|
|||
|
|
//reset any counters
|
|||
|
|
FRedirectCount := 0;
|
|||
|
|
FAuthRetries := 0;
|
|||
|
|
FAuthProxyRetries := 0;
|
|||
|
|
|
|||
|
|
if Assigned(AResponseContent) then begin
|
|||
|
|
LResponseLocation := AResponseContent.Position;
|
|||
|
|
end else begin
|
|||
|
|
LResponseLocation := 0; // Just to avoid the warning message
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Request.URL := AURL;
|
|||
|
|
Request.Method := AMethod;
|
|||
|
|
Request.Source := ASource;
|
|||
|
|
Response.ContentStream := AResponseContent;
|
|||
|
|
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
PrepareRequest(Request);
|
|||
|
|
if IOHandler is TIdSSLIOHandlerSocketBase then begin
|
|||
|
|
TIdSSLIOHandlerSocketBase(IOHandler).URIToCheck := FURI.URI;
|
|||
|
|
end;
|
|||
|
|
ConnectToHost(Request, Response);
|
|||
|
|
|
|||
|
|
// Workaround for servers wich respond with 100 Continue on GET and HEAD
|
|||
|
|
// This workaround is just for temporary use until we have final HTTP 1.1
|
|||
|
|
// realisation. HTTP 1.1 is ongoing because of all the buggy and conflicting servers.
|
|||
|
|
repeat
|
|||
|
|
Response.ResponseText := InternalReadLn;
|
|||
|
|
FHTTPProto.RetrieveHeaders(MaxHeaderLines);
|
|||
|
|
ProcessCookies(Request, Response);
|
|||
|
|
until Response.ResponseCode <> 100;
|
|||
|
|
|
|||
|
|
case FHTTPProto.ProcessResponse(AIgnoreReplies) of
|
|||
|
|
wnAuthRequest:
|
|||
|
|
begin
|
|||
|
|
Request.URL := AURL;
|
|||
|
|
end;
|
|||
|
|
wnReadAndGo:
|
|||
|
|
begin
|
|||
|
|
ReadResult(Request, Response);
|
|||
|
|
if Assigned(AResponseContent) then begin
|
|||
|
|
AResponseContent.Position := LResponseLocation;
|
|||
|
|
AResponseContent.Size := LResponseLocation;
|
|||
|
|
end;
|
|||
|
|
FAuthRetries := 0;
|
|||
|
|
FAuthProxyRetries := 0;
|
|||
|
|
end;
|
|||
|
|
wnGoToURL:
|
|||
|
|
begin
|
|||
|
|
if Assigned(AResponseContent) then begin
|
|||
|
|
AResponseContent.Position := LResponseLocation;
|
|||
|
|
AResponseContent.Size := LResponseLocation;
|
|||
|
|
end;
|
|||
|
|
FAuthRetries := 0;
|
|||
|
|
FAuthProxyRetries := 0;
|
|||
|
|
end;
|
|||
|
|
wnJustExit:
|
|||
|
|
begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
wnDontKnow:
|
|||
|
|
begin
|
|||
|
|
raise EIdException.Create(RSHTTPNotAcceptable);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
until False;
|
|||
|
|
finally
|
|||
|
|
if not Response.KeepAlive then begin
|
|||
|
|
// TODO: do not disconnect if hoNoReadMultipartMIME is in effect
|
|||
|
|
Disconnect;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdCustomHTTP.Patch(AURL: string; ASource, AResponseContent: TStream);
|
|||
|
|
begin
|
|||
|
|
DoRequest(Id_HTTPMethodPatch, AURL, ASource, AResponseContent, []);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdCustomHTTP.Patch(AURL: string; ASource: TStream
|
|||
|
|
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
|
|||
|
|
): string;
|
|||
|
|
var
|
|||
|
|
LResponse: TMemoryStream;
|
|||
|
|
begin
|
|||
|
|
LResponse := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
Patch(AURL, ASource, LResponse);
|
|||
|
|
LResponse.Position := 0;
|
|||
|
|
Result := ReadStringAsCharset(LResponse, ResponseCharset{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
|
|||
|
|
// TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LResponse);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
end.
|
|||
|
|
|