IdHTTP.pas 115 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.65 3/5/2005 3:33:52 PM JPMugaas
  18. Fix for some compiler warnings having to do with TStream.Read being platform
  19. specific. This was fixed by changing the Compressor API to use TIdStreamVCL
  20. instead of TStream. I also made appropriate adjustments to other units for
  21. this.
  22. Rev 1.64 2/13/2005 3:09:20 PM DSiders
  23. Modified TIdCustomHTTP.PrepareRequest to free the local URI instance if an
  24. exception occurs in the method. (try...finally)
  25. Rev 1.63 2/11/05 11:29:34 AM RLebeau
  26. Removed compiler warning
  27. Rev 1.62 2/9/05 2:12:08 AM RLebeau
  28. Fixes for Compiler errors
  29. Rev 1.61 2/8/05 6:43:42 PM RLebeau
  30. Added OnHeaderAvailable event
  31. Rev 1.60 1/11/05 1:25:08 AM RLebeau
  32. More changes to SetHostAndPort()
  33. Rev 1.59 1/6/05 2:28:52 PM RLebeau
  34. Fix for SetHostAndPort() not using its local variables properly
  35. Rev 1.58 06/01/2005 22:23:04 CCostelloe
  36. Bug fix (typo, gizp instead of gzip)
  37. Rev 1.57 05/12/2004 23:10:58 CCostelloe
  38. Recoded fix to suit Delphi < 7
  39. Rev 1.56 30/11/2004 23:46:12 CCostelloe
  40. Bug fix for SSL connections giving a "Connection closed gracefully" exception
  41. and requested page not getting returned (IOHandler.Response is empty)
  42. Rev 1.55 25/11/2004 21:28:06 CCostelloe
  43. Bug fix for POSTing fields that have the same name
  44. Rev 1.54 10/26/2004 10:13:24 PM JPMugaas
  45. Updated refs.
  46. Rev 1.53 7/16/04 1:19:20 AM RLebeau
  47. Fix for compiler error
  48. Rev 1.52 7/15/04 8:19:30 PM RLebeau
  49. Updated TIdHTTPProtocol.ProcessResponse() to treat 302 redirects like 303.
  50. Updated TIdHTTPProtocol.BuildAndSendRequest() to use a try...except block
  51. Rev 1.51 6/17/2004 8:30:04 AM DSiders
  52. TIdCustomHTTP modified:
  53. - Fixed error in AuthRetries property reading wrong member var.
  54. - Added AuthProxyRetries and MaxAuthRetries properties to public interface.
  55. TIdHTTP modified to publish AuthRetries, AuthProxyRetries, and MaxAuthRetries.
  56. TIdHTTPProtocol.ProcessResponse modified to use public properties
  57. AuthRetries, AuthProxyRetries, and MaxAutrhRetries.
  58. Rev 1.50 2004.05.20 11:36:46 AM czhower
  59. IdStreamVCL
  60. Rev 1.49 4/28/04 1:45:26 PM RLebeau
  61. Updated TIdCustomHTTP.SetRequestParams() to strip off the trailing CRLF
  62. before encoding rather than afterwards
  63. Rev 1.48 2004.04.07 11:18:08 PM czhower
  64. Bug and naming fix.
  65. Rev 1.47 7/4/2004 6:00:02 PM SGrobety
  66. Reformatted to match project guidelines
  67. Rev 1.46 7/4/2004 4:58:24 PM SGrobety
  68. Reformatted to match project guidelines
  69. Rev 1.45 6/4/2004 5:16:40 PM SGrobety
  70. Added AMaxHeaderCount: integer parameter to TIdHTTPProtocol.RetrieveHeaders
  71. and MaxHeaderLines property to TIdCustomHTTP (default to 255)
  72. Rev 1.44 2004.03.06 10:39:52 PM czhower
  73. Removed duplicate code
  74. Rev 1.43 2004.03.06 8:56:30 PM czhower
  75. -Change to disconnect
  76. -Addition of DisconnectNotifyPeer
  77. -WriteHeader now write bufers
  78. Rev 1.42 3/3/2004 5:58:00 AM JPMugaas
  79. Some IFDEF excluses were removed because the functionality is now in DotNET.
  80. Rev 1.41 2004.02.23 9:33:12 PM czhower
  81. Now can optionally ignore response codes for exceptions.
  82. Rev 1.40 2/15/2004 6:34:02 AM JPMugaas
  83. Fix for where I broke the HTTP client with a parameter change in the GZip
  84. decompress method.
  85. Rev 1.39 2004.02.03 5:43:44 PM czhower
  86. Name changes
  87. Rev 1.38 2004.02.03 2:12:10 PM czhower
  88. $I path change
  89. Rev 1.37 2004.01.27 11:41:18 PM czhower
  90. Removed const arguments
  91. Rev 1.35 24/01/2004 19:22:34 CCostelloe
  92. Cleaned up warnings
  93. Rev 1.34 2004.01.22 5:29:02 PM czhower
  94. TextIsSame
  95. Rev 1.33 2004.01.21 1:04:50 PM czhower
  96. InitComponenet
  97. Rev 1.32 1/2/2004 11:41:48 AM BGooijen
  98. Enabled IPv6 support
  99. Rev 1.31 22/11/2003 12:04:28 AM GGrieve
  100. Add support for HTTP status code 303
  101. Rev 1.30 10/25/2003 06:51:58 AM JPMugaas
  102. Updated for new API changes and tried to restore some functionality.
  103. Rev 1.29 2003.10.24 10:43:08 AM czhower
  104. TIdSTream to dos
  105. Rev 1.28 24/10/2003 10:58:40 AM SGrobety
  106. Made authentication work even if no OnAnthenticate envent handler present
  107. Rev 1.27 10/18/2003 1:53:10 PM BGooijen
  108. Added include
  109. Rev 1.26 10/17/2003 12:08:48 AM DSiders
  110. Added localization comments.
  111. Rev 1.25 2003.10.14 1:27:52 PM czhower
  112. DotNet
  113. Rev 1.24 10/7/2003 11:33:54 PM GGrieve
  114. Get works under DotNet
  115. Rev 1.23 10/7/2003 10:07:04 PM GGrieve
  116. Get HTTP compiling for DotNet
  117. Rev 1.22 10/4/2003 9:15:58 PM GGrieve
  118. fix to compile
  119. Rev 1.21 9/26/2003 01:41:48 PM JPMugaas
  120. Fix for problem wihere "identity" was being added more than once to the
  121. accepted encoding contents.
  122. Rev 1.20 9/14/2003 07:54:20 PM JPMugaas
  123. Published the Compressor property.
  124. Rev 1.19 7/30/2003 05:34:22 AM JPMugaas
  125. Fix for bug where decompression was not done if the Content Length was
  126. specified. I found that at http://www.news.com.
  127. Added Identity to the content encoding to be consistant with Opera. Identity
  128. is the default Accept-Encoding (RFC 2616).
  129. Rev 1.18 7/13/2003 10:57:28 PM BGooijen
  130. Fixed GZip and Deflate decoding
  131. Rev 1.17 7/13/2003 11:29:06 AM JPMugaas
  132. Made sure some GZIP decompression stub code is in IdHTTP.
  133. Rev 1.15 10.7.2003 ã. 21:03:02 DBondzhev
  134. Fixed NTML proxy authorization
  135. Rev 1.14 6/19/2003 02:36:56 PM JPMugaas
  136. Removed a connected check and it seems to work better that way.
  137. Rev 1.13 6/5/2003 04:53:54 AM JPMugaas
  138. Reworkings and minor changes for new Reply exception framework.
  139. Rev 1.12 4/30/2003 01:47:24 PM JPMugaas
  140. Added TODO concerning a ConnectTimeout.
  141. Rev 1.11 4/2/2003 3:18:30 PM BGooijen
  142. fixed av when retrieving an url when no iohandler was assigned
  143. Rev 1.10 3/26/2003 5:13:40 PM BGooijen
  144. TIdSSLIOHandlerSocketBase.URIToCheck is now set
  145. Rev 1.9 3/13/2003 11:05:26 AM JPMugaas
  146. Now should work with 3rd party vendor SSL IOHandlers.
  147. Rev 1.8 3/11/2003 10:14:52 PM BGooijen
  148. Undid the stripping of the CR
  149. Rev 1.7 2/27/2003 2:04:26 PM BGooijen
  150. If any call to iohandler.readln returns a CR at the end, it is removed now.
  151. Rev 1.6 2/26/2003 11:50:08 AM BGooijen
  152. things were messed up in TIdHTTPProtocol.RetrieveHeaders, because the call to
  153. readln doesn't strip the CR at the end (terminator=LF), therefore the end of
  154. the header was not found.
  155. Rev 1.5 2/26/2003 11:42:46 AM BGooijen
  156. changed ReadLn (IOerror 6) to IOHandler.ReadLn
  157. Rev 1.4 2/4/2003 6:30:44 PM BGooijen
  158. Re-enabled SSL-support
  159. Rev 1.3 1/17/2003 04:14:42 PM JPMugaas
  160. Fixed warnings.
  161. Rev 1.2 12/7/2002 05:32:16 PM JPMugaas
  162. Now compiles with destination removed.
  163. Rev 1.1 12/6/2002 05:29:52 PM JPMugaas
  164. Now decend from TIdTCPClientCustom instead of TIdTCPClient.
  165. Rev 1.0 11/13/2002 07:54:12 AM JPMugaas
  166. 2001-Nov Nick Panteleeff
  167. - Authentication and POST parameter extentsions
  168. 2001-Sept Doychin Bondzhev
  169. - New internal design and new Authentication procedures.
  170. - Bug fixes and new features in few other supporting components
  171. 2001-Jul-7 Doychin Bondzhev
  172. - new property AllowCookie
  173. - There is no more ExtraHeders property in Request/Response. Raw headers is used for that purpose.
  174. 2001-Jul-1 Doychin Bondzhev
  175. - SSL support is up again - Thanks to Gregor
  176. 2001-Jun-17 Doychin Bondzhev
  177. - New unit IdHTTPHeaderInfo.pas that contains the
  178. TIdHeaderInfo(TIdEntytiHeaderInfo, TIdRequestHeaderInfo and TIdResponseHeaderInfo)
  179. - Still in development and not verry well tested
  180. By default when there is no authorization object associated with HTTP compoenet and there is user name and password
  181. HTTP component creates and instance of TIdBasicAuthentication class. This behaivor is for both web server and proxy server
  182. authorizations
  183. 2001-Apr-17 Doychin Bondzhev
  184. - Added OnProxyAuthorization event. This event is called on 407 response from the HTTP Proxy.
  185. - Added 2 new properties in TIdHeaderInfo
  186. property AuthenticationScheme: TIdAuthenticationScheme - this property contains information for authentication scheme
  187. requested by the web server
  188. property ProxyAuthenticationScheme: TIdAuthenticationScheme - this property contains information for authentication scheme
  189. requested by the proxy server
  190. - Now the component authomaticly reconginizes the requested authorization scheme and it supports Basic like before and has been
  191. extend to support Digest authorization
  192. 2001-Mar-31 Doychin Bondzhev
  193. - If there is no CookieManager it does not support cookies.
  194. 2001-Feb-18 Doychin Bondzhev
  195. - Added OnAuthorization event. This event is called on 401 response from the HTTP server.
  196. This can be used to ask the user program to supply user name and password in order to acces
  197. the requested resource
  198. 2001-Feb-02 Doychin Bondzhev
  199. - Added Cookie support and relative paths on redirect
  200. 2000-Jul-25 Hadi Hariri
  201. - Overloaded POst and moved clearing to disconect.
  202. 2000-June-22 Hadi Hariri
  203. - Added Proxy support.
  204. 2000-June-10 Hadi Hariri
  205. - Added Chunk-Encoding support and HTTP version number. Some additional
  206. improvements.
  207. 2000-May-23 J. Peter Mugaas
  208. -added redirect capability and supporting properties. Redirect is optional
  209. and is set with HandleRedirects. Redirection is limited to RedirectMaximum
  210. to prevent stack overflow due to recursion and to prevent redirects between
  211. two places which would cause this to go on to infinity.
  212. 2000-May-22 J. Peter Mugaas
  213. -adjusted code for servers which returned LF instead of EOL
  214. -Headers are now retreived before an exception is raised. This
  215. also facilitates server redirection where the server tells the client to
  216. get a document from another location.
  217. 2000-May-01 Hadi Hariri
  218. -Converted to Mercury
  219. 2000-May-01 Hadi Hariri
  220. -Added PostFromStream and some clean up
  221. 2000-Apr-10 Hadi Hariri
  222. -Re-done quite a few things and fixed GET bugs and finished POST method.
  223. 2000-Jan-13 MTL
  224. -Moved to the New Palette Scheme
  225. 2000-Jan-08 MTL
  226. -Cleaned up a few compiler hints during 7.038 build
  227. 1999-Dec-10 Hadi Hariri
  228. -Started.
  229. }
  230. unit IdHTTP;
  231. {
  232. Implementation of the HTTP protcol as specified in RFC 2616, 2109, 2965.
  233. (See NOTE below for details of what is exactly implemented)
  234. Author: Hadi Hariri ([email protected])
  235. Copyright: (c) Chad Z. Hower and The Winshoes Working Group.
  236. Initials: Hadi Hariri - HH
  237. }
  238. {
  239. TODO: Figure out what to do with ConnectTimeout.
  240. Ideally, that should be in the core and is not the same as a read Timeout.
  241. }
  242. interface
  243. {$I IdCompilerDefines.inc}
  244. uses
  245. Classes,
  246. IdException, IdExceptionCore, IdAssignedNumbers, IdHeaderList, IdHTTPHeaderInfo, IdReplyRFC,
  247. IdSSL, IdZLibCompressorBase,
  248. IdTCPClient, IdURI, IdCookieManager, IdAuthentication, IdAuthenticationManager,
  249. IdMultipartFormData, IdGlobal, IdBaseComponent, IdUriUtils;
  250. type
  251. // TO DOCUMENTATION TEAM
  252. // ------------------------
  253. // For internal use. No need of documentation
  254. // hmConnect - Used to connect trought CERN proxy to SSL enabled sites.
  255. TIdHTTPMethod = string;
  256. const
  257. Id_HTTPMethodHead = 'HEAD';
  258. Id_HTTPMethodGet = 'GET';
  259. Id_HTTPMethodPost = 'POST';
  260. Id_HTTPMethodOptions = 'OPTIONS';
  261. Id_HTTPMethodTrace = 'TRACE';
  262. Id_HTTPMethodPut = 'PUT';
  263. Id_HTTPMethodDelete = 'DELETE';
  264. Id_HTTPMethodConnect = 'CONNECT';
  265. Id_HTTPMethodPatch = 'PATCH';
  266. //(hmHead, hmGet, hmPost, hmOptions, hmTrace, hmPut, hmDelete, hmConnect, hmPatch);
  267. type
  268. TIdHTTPWhatsNext = (wnGoToURL, wnJustExit, wnDontKnow, wnReadAndGo, wnAuthRequest);
  269. TIdHTTPConnectionType = (ctNormal, ctSSL, ctProxy, ctSSLProxy);
  270. // Protocol options
  271. TIdHTTPOption = (hoInProcessAuth, hoKeepOrigProtocol, hoForceEncodeParams,
  272. hoNonSSLProxyUseConnectVerb, hoNoParseMetaHTTPEquiv, hoWaitForUnexpectedData,
  273. hoTreat302Like303, hoNoProtocolErrorException, hoNoReadMultipartMIME,
  274. hoNoParseXmlCharset, hoWantProtocolErrorContent, hoNoReadChunked
  275. );
  276. TIdHTTPOptions = set of TIdHTTPOption;
  277. // Must be documented
  278. TIdHTTPProtocolVersion = (pv1_0, pv1_1);
  279. TIdHTTPOnRedirectEvent = procedure(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod) of object;
  280. TIdHTTPOnHeadersAvailable = procedure(Sender: TObject; AHeaders: TIdHeaderList; var VContinue: Boolean) of object;
  281. TIdOnSelectAuthorization = procedure(Sender: TObject; var AuthenticationClass: TIdAuthenticationClass; AuthInfo: TIdHeaderList) of object;
  282. TIdOnAuthorization = procedure(Sender: TObject; Authentication: TIdAuthentication; var Handled: Boolean) of object;
  283. // TIdProxyOnAuthorization = procedure(Sender: TObject; Authentication: TIdAuthentication; var Handled: boolean) of object;
  284. TIdOnChunkReceived = procedure(Sender : TObject; var Chunk: TIdBytes) of object;
  285. const
  286. Id_TIdHTTP_ProtocolVersion = pv1_1;
  287. Id_TIdHTTP_RedirectMax = 15;
  288. Id_TIdHTTP_MaxHeaderLines = 255;
  289. Id_TIdHTTP_HandleRedirects = False;
  290. Id_TIdHTTP_MaxAuthRetries = 3;
  291. type
  292. TIdCustomHTTP = class;
  293. // TO DOCUMENTATION TEAM
  294. // ------------------------
  295. // The following classes are used internally and no need of documentation
  296. // Only TIdHTTP must be documented
  297. //
  298. TIdHTTPResponse = class(TIdResponseHeaderInfo)
  299. protected
  300. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  301. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  302. {$IFEND} FHTTP: TIdCustomHTTP;
  303. //
  304. FResponseCode: Integer;
  305. FResponseText: string;
  306. FKeepAlive: Boolean;
  307. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  308. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  309. {$IFEND} FContentStream: TStream;
  310. FResponseVersion: TIdHTTPProtocolVersion;
  311. FMetaHTTPEquiv : TIdMetaHTTPEquiv;
  312. //
  313. function GetKeepAlive: Boolean;
  314. function GetResponseCode: Integer;
  315. procedure SetResponseText(const AValue: String);
  316. procedure ProcessMetaHTTPEquiv;
  317. public
  318. constructor Create(AHTTP: TIdCustomHTTP); reintroduce; virtual;
  319. destructor Destroy; override;
  320. procedure Clear; override;
  321. property KeepAlive: Boolean read GetKeepAlive write FKeepAlive;
  322. property MetaHTTPEquiv: TIdMetaHTTPEquiv read FMetaHTTPEquiv;
  323. property ResponseText: string read FResponseText write SetResponseText;
  324. property ResponseCode: Integer read GetResponseCode write FResponseCode;
  325. property ResponseVersion: TIdHTTPProtocolVersion read FResponseVersion write FResponseVersion;
  326. property ContentStream: TStream read FContentStream write FContentStream;
  327. end;
  328. TIdHTTPRequest = class(TIdRequestHeaderInfo)
  329. protected
  330. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  331. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  332. {$IFEND} FHTTP: TIdCustomHTTP;
  333. //
  334. FURL: string;
  335. FMethod: TIdHTTPMethod;
  336. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  337. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  338. {$IFEND} FSourceStream: TStream;
  339. FUseProxy: TIdHTTPConnectionType;
  340. FIPVersion: TIdIPVersion;
  341. FDestination: string;
  342. public
  343. constructor Create(AHTTP: TIdCustomHTTP); reintroduce; virtual;
  344. property URL: string read FURL write FURL;
  345. property Method: TIdHTTPMethod read FMethod write FMethod;
  346. property Source: TStream read FSourceStream write FSourceStream;
  347. property UseProxy: TIdHTTPConnectionType read FUseProxy;
  348. property IPVersion: TIdIPVersion read FIPVersion write FIPVersion;
  349. property Destination: string read FDestination write FDestination;
  350. end;
  351. TIdHTTPProtocol = class(TObject)
  352. protected
  353. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  354. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  355. {$IFEND} FHTTP: TIdCustomHTTP;
  356. //
  357. FRequest: TIdHTTPRequest;
  358. FResponse: TIdHTTPResponse;
  359. public
  360. constructor Create(AConnection: TIdCustomHTTP);
  361. destructor Destroy; override;
  362. function ProcessResponse(const AIgnoreReplies: array of Int16): TIdHTTPWhatsNext;
  363. procedure BuildAndSendRequest(AURI: TIdURI);
  364. procedure RetrieveHeaders(AMaxHeaderCount: integer);
  365. //
  366. property Request: TIdHTTPRequest read FRequest;
  367. property Response: TIdHTTPResponse read FResponse;
  368. end;
  369. TIdCustomHTTP = class(TIdTCPClientCustom)
  370. protected
  371. {Retries counter for WWW authorization}
  372. FAuthRetries: Integer;
  373. {Retries counter for proxy authorization}
  374. FAuthProxyRetries: Integer;
  375. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  376. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  377. {$IFEND} FCookieManager: TIdCookieManager;
  378. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  379. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  380. {$IFEND} FCompressor : TIdZLibCompressorBase;
  381. {Max retries for authorization}
  382. FMaxAuthRetries: Integer;
  383. FMaxHeaderLines: integer;
  384. FAllowCookies: Boolean;
  385. {$IF DEFINED(HAS_UNSAFE_OBJECT_REF)}[Unsafe]
  386. {$ELSEIF DEFINED(HAS_WEAK_OBJECT_REF)}[Weak]
  387. {$IFEND} FAuthenticationManager: TIdAuthenticationManager;
  388. FProtocolVersion: TIdHTTPProtocolVersion;
  389. {this is an internal counter for redirects}
  390. FRedirectCount: Integer;
  391. FRedirectMax: Integer;
  392. FHandleRedirects: Boolean;
  393. FOptions: TIdHTTPOptions;
  394. FURI: TIdURI;
  395. FHTTPProto: TIdHTTPProtocol;
  396. FProxyParameters: TIdProxyConnectionInfo;
  397. //
  398. FOnHeadersAvailable: TIdHTTPOnHeadersAvailable;
  399. FOnRedirect: TIdHTTPOnRedirectEvent;
  400. FOnSelectAuthorization: TIdOnSelectAuthorization;
  401. FOnSelectProxyAuthorization: TIdOnSelectAuthorization;
  402. FOnAuthorization: TIdOnAuthorization;
  403. FOnProxyAuthorization: TIdOnAuthorization;
  404. FOnChunkReceived: TIdOnChunkReceived;
  405. //
  406. {
  407. procedure SetHost(const Value: string); override;
  408. procedure SetPort(const Value: integer); override;
  409. }
  410. procedure DoRequest(const AMethod: TIdHTTPMethod; AURL: string;
  411. ASource, AResponseContent: TStream; const AIgnoreReplies: array of Int16); virtual;
  412. function CreateProtocol: TIdHTTPProtocol; virtual;
  413. function InternalReadLn: String;
  414. {$IFDEF USE_OBJECT_REF_FREENOTIF}
  415. procedure SetAuthenticationManager(Value: TIdAuthenticationManager);
  416. {$ENDIF}
  417. procedure SetCookieManager(ACookieManager: TIdCookieManager);
  418. procedure SetAllowCookies(AValue: Boolean);
  419. function GetResponseCode: Integer;
  420. function GetResponseText: string;
  421. function DoOnAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean; virtual;
  422. function DoOnProxyAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean; virtual;
  423. function DoOnRedirect(var Location: string; var VMethod: TIdHTTPMethod; RedirectCount: integer): boolean; virtual;
  424. {$IFDEF USE_OBJECT_REF_FREENOTIF}
  425. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  426. {$IFEND}
  427. procedure ProcessCookies(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  428. function SetHostAndPort: TIdHTTPConnectionType;
  429. procedure SetCookies(AURL: TIdURI; ARequest: TIdHTTPRequest);
  430. procedure ReadResult(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  431. procedure PrepareRequest(ARequest: TIdHTTPRequest);
  432. procedure ConnectToHost(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  433. function GetResponse: TIdHTTPResponse;
  434. function GetRequest: TIdHTTPRequest;
  435. function GetMetaHTTPEquiv: TIdMetaHTTPEquiv;
  436. procedure SetRequest(Value: TIdHTTPRequest);
  437. procedure SetProxyParams(AValue: TIdProxyConnectionInfo);
  438. function SetRequestParams(ASource: TStrings; AByteEncoding: IIdTextEncoding): string;
  439. procedure CheckAndConnect(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  440. procedure DoOnDisconnected; override;
  441. public
  442. constructor Create(AOwner: TComponent); override;
  443. destructor Destroy; override;
  444. procedure CustomRequest(const AMethod: TIdHTTPMethod; AURL: string;
  445. ASource, AResponseContent: TStream; const AIgnoreReplies: array of Int16);
  446. procedure Delete(AURL: string; AResponseContent: TStream); overload;
  447. function Delete(AURL: string): string; overload;
  448. function Delete(AURL: string; ASource: TStrings; AByteEncoding: IIdTextEncoding = nil): string; overload;
  449. function Delete(AURL: string; ASource: TStream): string; overload;
  450. procedure Delete(AURL: string; ASource: TStrings; AResponseContent: TStream; AByteEncoding: IIdTextEncoding = nil); overload;
  451. procedure Delete(AURL: string; ASource, AResponseContent: TStream); overload;
  452. procedure Options(AURL: string; AResponseContent: TStream); overload;
  453. function Options(AURL: string): string; overload;
  454. procedure Get(AURL: string; AResponseContent: TStream); overload;
  455. procedure Get(AURL: string; AResponseContent: TStream; AIgnoreReplies: const array of Int16); overload;
  456. function Get(AURL: string): string; overload;
  457. function Get(AURL: string; const AIgnoreReplies: array of Int16): string; overload;
  458. procedure Trace(AURL: string; AResponseContent: TStream); overload;
  459. function Trace(AURL: string): string; overload;
  460. procedure Head(AURL: string);
  461. function Post(AURL: string; const ASourceFile: String): string; overload;
  462. function Post(AURL: string; ASource: TStrings; AByteEncoding: IIdTextEncoding = nil): string; overload;
  463. function Post(AURL: string; ASource: TStream): string; overload;
  464. function Post(AURL: string; ASource: TIdMultiPartFormDataStream): string; overload;
  465. procedure Post(AURL: string; const ASourceFile: String; AResponseContent: TStream); overload;
  466. procedure Post(AURL: string; ASource: TStrings; AResponseContent: TStream; AByteEncoding: IIdTextEncoding = nil); overload;
  467. procedure Post(AURL: string; ASource, AResponseContent: TStream); overload;
  468. procedure Post(AURL: string; ASource: TIdMultiPartFormDataStream; AResponseContent: TStream); overload;
  469. function Put(AURL: string; ASource: TStream): string; overload;
  470. procedure Put(AURL: string; ASource, AResponseContent: TStream); overload;
  471. procedure Patch(AURL: string; ASource, AResponseContent: TStream); overload;
  472. function Patch(AURL: string; ASource: TStream): string; overload;
  473. {This is an object that can compress and decompress HTTP Deflate encoding}
  474. property Compressor : TIdZLibCompressorBase read FCompressor write FCompressor;
  475. {This is the response code number such as 404 for File not Found}
  476. property ResponseCode: Integer read GetResponseCode;
  477. {This is the text of the message such as "404 File Not Found here Sorry"}
  478. property ResponseText: string read GetResponseText;
  479. property Response: TIdHTTPResponse read GetResponse;
  480. property MetaHTTPEquiv: TIdMetaHTTPEquiv read GetMetaHTTPEquiv;
  481. { This is the last processed URL }
  482. property URL: TIdURI read FURI;
  483. // number of retry attempts for Authentication
  484. property AuthRetries: Integer read FAuthRetries;
  485. property AuthProxyRetries: Integer read FAuthProxyRetries;
  486. // maximum number of Authentication retries permitted
  487. property MaxAuthRetries: Integer read FMaxAuthRetries write FMaxAuthRetries default Id_TIdHTTP_MaxAuthRetries;
  488. property AllowCookies: Boolean read FAllowCookies write SetAllowCookies default True;
  489. {Do we handle redirect requests or simply raise an exception and let the
  490. developer deal with it}
  491. property HandleRedirects: Boolean read FHandleRedirects write FHandleRedirects default Id_TIdHTTP_HandleRedirects;
  492. property ProtocolVersion: TIdHTTPProtocolVersion read FProtocolVersion write FProtocolVersion default Id_TIdHTTP_ProtocolVersion;
  493. //how many redirects were made in the last request
  494. property RedirectCount: Integer read FRedirectCount;
  495. {This is the maximum number of redirects we wish to handle, we limit this
  496. to prevent stack overflow due to recursion. Recursion is safe ONLY if
  497. prevented for continuing to infinity}
  498. property RedirectMaximum: Integer read FRedirectMax write FRedirectMax default Id_TIdHTTP_RedirectMax;
  499. // S.G. 6/4/2004: This is to prevent the server from responding with too many header lines
  500. property MaxHeaderLines: integer read FMaxHeaderLines write FMaxHeaderLines default Id_TIdHTTP_MaxHeaderLines;
  501. property ProxyParams: TIdProxyConnectionInfo read FProxyParameters write SetProxyParams;
  502. property Request: TIdHTTPRequest read GetRequest write SetRequest;
  503. property HTTPOptions: TIdHTTPOptions read FOptions write FOptions;
  504. //
  505. property OnHeadersAvailable: TIdHTTPOnHeadersAvailable read FOnHeadersAvailable write FOnHeadersAvailable;
  506. // Fired when a rediretion is requested.
  507. property OnRedirect: TIdHTTPOnRedirectEvent read FOnRedirect write FOnRedirect;
  508. property OnSelectAuthorization: TIdOnSelectAuthorization read FOnSelectAuthorization write FOnSelectAuthorization;
  509. property OnSelectProxyAuthorization: TIdOnSelectAuthorization read FOnSelectProxyAuthorization write FOnSelectProxyAuthorization;
  510. property OnAuthorization: TIdOnAuthorization read FOnAuthorization write FOnAuthorization;
  511. property OnProxyAuthorization: TIdOnAuthorization read FOnProxyAuthorization write FOnProxyAuthorization;
  512. property OnChunkReceived: TIdOnChunkReceived read FOnChunkReceived write FOnChunkReceived;
  513. // Cookie stuff
  514. property CookieManager: TIdCookieManager read FCookieManager write SetCookieManager;
  515. //
  516. property AuthenticationManager: TIdAuthenticationManager read FAuthenticationManager write {$IFDEF USE_OBJECT_REF_FREENOTIF}SetAuthenticationManager{$ELSE}FAuthenticationManager{$ENDIF};
  517. end;
  518. TIdHTTP = class(TIdCustomHTTP)
  519. published
  520. // number of Authentication retries permitted
  521. property MaxAuthRetries;
  522. property AllowCookies;
  523. { Do we handle redirect requests or simply raise an exception and let the
  524. developer deal with it }
  525. property HandleRedirects;
  526. property ProtocolVersion;
  527. { This is the maximum number of redirects we wish to handle, we limit this
  528. to prevent stack overflow due to recursion. Recursion is safe ONLY if
  529. prevented for continuing to infinity }
  530. property RedirectMaximum;
  531. property ProxyParams;
  532. property Request;
  533. property HTTPOptions;
  534. //
  535. property OnHeadersAvailable;
  536. // Fired when a rediretion is requested.
  537. property OnRedirect;
  538. property OnSelectAuthorization;
  539. property OnSelectProxyAuthorization;
  540. property OnAuthorization;
  541. property OnProxyAuthorization;
  542. property OnChunkReceived;
  543. // property Host;
  544. // property Port default IdPORT_HTTP;
  545. // Cookie stuff
  546. property CookieManager;
  547. // property AuthenticationManager: TIdAuthenticationManager read FAuthenticationManager write SetAuthenticationManager;
  548. // ZLib compression library object for use with deflate and gzip encoding
  549. property Compressor;
  550. end;
  551. EIdUnknownProtocol = class(EIdException);
  552. EIdHTTPProtocolException = class( EIdReplyRFCError )
  553. protected
  554. FErrorMessage: string;
  555. public
  556. constructor CreateError(const anErrCode: Integer; const asReplyMessage: string;
  557. const asErrorMessage: string); reintroduce; virtual;
  558. property ErrorMessage: string read FErrorMessage;
  559. end;
  560. implementation
  561. uses
  562. SysUtils,
  563. IdAllAuthentications, IdComponent, IdCoderMIME, IdTCPConnection,
  564. IdResourceStringsCore, IdResourceStringsProtocols, IdGlobalProtocols,
  565. IdIOHandler, IdIOHandlerSocket;
  566. const
  567. ProtocolVersionString: array[TIdHTTPProtocolVersion] of string = ('1.0', '1.1'); {do not localize}
  568. { EIdHTTPProtocolException }
  569. constructor EIdHTTPProtocolException.CreateError(const anErrCode: Integer;
  570. const asReplyMessage: string; const asErrorMessage: string);
  571. begin
  572. inherited CreateError(anErrCode, asReplyMessage);
  573. FErrorMessage := asErrorMessage;
  574. end;
  575. { TIdHTTP }
  576. function IsContentTypeHtml(AInfo: TIdEntityHeaderInfo) : Boolean;
  577. begin
  578. Result := IsHeaderMediaTypes(AInfo.ContentType, ['text/html', 'text/html-sandboxed','application/xhtml+xml']); {do not localize}
  579. end;
  580. function IsContentTypeAppXml(AInfo: TIdEntityHeaderInfo) : Boolean;
  581. begin
  582. Result := IsHeaderMediaTypes(AInfo.ContentType,
  583. ['application/xml', 'application/xml-external-parsed-entity', 'application/xml-dtd'] {do not localize}
  584. );
  585. if not Result then
  586. begin
  587. Result := not IsHeaderMediaType(AInfo.ContentType, 'text'); {do not localize}
  588. if Result then begin
  589. Result := TextEndsWith(ExtractHeaderMediaSubType(AInfo.ContentType), '+xml') {do not localize}
  590. end;
  591. end;
  592. end;
  593. procedure TIdCustomHTTP.Delete(AURL: string; AResponseContent: TStream);
  594. begin
  595. DoRequest(Id_HTTPMethodDelete, AURL, nil, AResponseContent, []);
  596. end;
  597. function TIdCustomHTTP.Delete(AURL: string): string;
  598. var
  599. LStream: TMemoryStream;
  600. begin
  601. LStream := TMemoryStream.Create;
  602. try
  603. DoRequest(Id_HTTPMethodDelete, AURL, nil, LStream, []);
  604. LStream.Position := 0;
  605. Result := ReadStringAsCharset(LStream, Response.Charset);
  606. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  607. finally
  608. LStream.Free;
  609. end;
  610. end;
  611. function TIdCustomHTTP.Delete(AURL: string; ASource: TStrings; AByteEncoding: IIdTextEncoding = nil): string;
  612. var
  613. LParams: TMemoryStream;
  614. begin
  615. // Usual posting request have default ContentType is application/x-www-form-urlencoded
  616. if (AHTTP.Request.ContentType = '') or IsContentTypeHtml(AHTTP.Request) then begin
  617. AHTTP.Request.ContentType := 'application/x-www-form-urlencoded'; {do not localize}
  618. end;
  619. if ASource <> nil then
  620. begin
  621. LParams := TMemoryStream.Create;
  622. try
  623. WriteStringToStream(LParams, SetRequestParams(ASource, AByteEncoding));
  624. LParams.Position := 0;
  625. DoRequest(Id_HTTPMethodDelete, AURL, LParams, AResponseContent, []);
  626. finally
  627. LParams.Free;
  628. end;
  629. end else begin
  630. DoRequest(Id_HTTPMethodDelete, AURL, TStream(nil), AResponseContent, []);
  631. end;
  632. end;
  633. function TIdCustomHTTP.Delete(AURL: string; ASource: TStream): string;
  634. var
  635. LResponse: TMemoryStream;
  636. begin
  637. LResponse := TMemoryStream.Create;
  638. try
  639. DoRequest(Id_HTTPMethodDelete, AURL, ASource, LResponse, []);
  640. LResponse.Position := 0;
  641. Result := ReadStringAsCharset(LResponse, AHTTP.Response.Charset);
  642. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  643. finally
  644. LResponse.Free;
  645. end;
  646. end;
  647. procedure TIdCustomHTTP.Delete(AURL: string; ASource: TStrings; AResponseContent: TStream; AByteEncoding: IIdTextEncoding = nil);
  648. var
  649. LParams: TMemoryStream;
  650. begin
  651. // Usual posting request have default ContentType is application/x-www-form-urlencoded
  652. if (AHTTP.Request.ContentType = '') or IsContentTypeHtml(AHTTP.Request) then begin
  653. AHTTP.Request.ContentType := 'application/x-www-form-urlencoded'; {do not localize}
  654. end;
  655. if ASource <> nil then
  656. begin
  657. LParams := TMemoryStream.Create;
  658. try
  659. WriteStringToStream(LParams, SetRequestParams(ASource, AByteEncoding));
  660. LParams.Position := 0;
  661. DoRequest(Id_HTTPMethodDelete, AURL, LParams, AResponseContent, []);
  662. finally
  663. LParams.Free;
  664. end;
  665. end else begin
  666. DoRequest(Id_HTTPMethodDelete, AURL, TStream(nil), AResponseContent, []);
  667. end;
  668. end;
  669. procedure TIdCustomHTTP.Delete(AURL: string; ASource, AResponseContent: TStream);
  670. begin
  671. DoRequest(Id_HTTPMethodDelete, AURL, ASource, AResponseContent, []);
  672. end;
  673. procedure TIdCustomHTTP.Options(AURL: string; AResponseContent: TStream);
  674. begin
  675. DoRequest(Id_HTTPMethodOptions, AURL, nil, AResponseContent, []);
  676. end;
  677. function TIdCustomHTTP.Options(AURL: string): string;
  678. var
  679. LStream: TMemoryStream;
  680. begin
  681. LStream := TMemoryStream.Create;
  682. try
  683. DoRequest(Id_HTTPMethodOptions, AURL, nil, LStream, []);
  684. LStream.Position := 0;
  685. Result := ReadStringAsCharset(LStream, Response.Charset);
  686. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  687. finally
  688. LStream.Free;
  689. end;
  690. end;
  691. procedure TIdCustomHTTP.Get(AURL: string; AResponseContent: TStream);
  692. begin
  693. Get(AURL, AResponseContent, []);
  694. end;
  695. procedure TIdCustomHTTP.Trace(AURL: string; AResponseContent: TStream);
  696. begin
  697. DoRequest(Id_HTTPMethodTrace, AURL, nil, AResponseContent, []);
  698. end;
  699. procedure TIdCustomHTTP.Head(AURL: string);
  700. begin
  701. DoRequest(Id_HTTPMethodHead, AURL, nil, nil, []);
  702. end;
  703. procedure TIdCustomHTTP.Post(AURL: string; ASource, AResponseContent: TStream);
  704. var
  705. OldProtocol: TIdHTTPProtocolVersion;
  706. begin
  707. // PLEASE READ CAREFULLY
  708. // Currently when issuing a POST, IdHTTP will automatically set the protocol
  709. // to version 1.0 independently of the value it had initially. This is because
  710. // there are some servers that don't respect the RFC to the full extent. In
  711. // particular, they don't respect sending/not sending the Expect: 100-Continue
  712. // header. Until we find an optimum solution that does NOT break the RFC, we
  713. // will restrict POSTS to version 1.0.
  714. OldProtocol := FProtocolVersion;
  715. try
  716. // If hoKeepOrigProtocol is SET, is possible to assume that the developer
  717. // is sure in operations of the server
  718. if not (hoKeepOrigProtocol in FOptions) then begin
  719. if Connected then begin
  720. Disconnect;
  721. end;
  722. FProtocolVersion := pv1_0;
  723. end;
  724. DoRequest(Id_HTTPMethodPost, AURL, ASource, AResponseContent, []);
  725. finally
  726. FProtocolVersion := OldProtocol;
  727. end;
  728. end;
  729. // RLebeau 12/21/2010: this is based on W3's HTML standards:
  730. //
  731. // HTML 4.01
  732. // http://www.w3.org/TR/html401/
  733. //
  734. // HTML 5
  735. // http://www.w3.org/TR/html5/
  736. function WWWFormUrlEncode(const ASrc: string; AByteEncoding: IIdTextEncoding): string;
  737. const
  738. // HTML 4.01 Section 17.13.4 ("Form content types") says:
  739. //
  740. // application/x-www-form-urlencoded
  741. //
  742. // Control names and values are escaped. Space characters are replaced by `+',
  743. // and then reserved characters are escaped as described in [RFC1738], section
  744. // 2.2: Non-alphanumeric characters are replaced by `%HH', a percent sign and
  745. // two hexadecimal digits representing the ASCII code of the character. Line
  746. // breaks are represented as "CR LF" pairs (i.e., `%0D%0A').
  747. //
  748. // On the other hand, HTML 5 Section 4.10.16.4 ("URL-encoded form data") says:
  749. //
  750. // If the character isn't in the range U+0020, U+002A, U+002D, U+002E,
  751. // U+0030 .. U+0039, U+0041 .. U+005A, U+005F, U+0061 .. U+007A then replace
  752. // the character with a string formed as follows: Start with the empty string,
  753. // and then, taking each byte of the character when expressed in the selected
  754. // character encoding in turn, append to the string a U+0025 PERCENT SIGN
  755. // character (%) followed by two characters in the ranges U+0030 DIGIT ZERO (0)
  756. // to U+0039 DIGIT NINE (9) and U+0041 LATIN CAPITAL LETTER A to
  757. // U+005A LATIN CAPITAL LETTER Z representing the hexadecimal value of the
  758. // byte zero-padded if necessary).
  759. //
  760. // If the character is a U+0020 SPACE character, replace it with a single
  761. // U+002B PLUS SIGN character (+).
  762. //
  763. // So, lets err on the side of caution and use the HTML 5.x definition, as it
  764. // encodes some of the characters that HTML 4.01 allows unencoded...
  765. //
  766. SafeChars: UnicodeString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789*-._'; {do not localize}
  767. var
  768. I, J, CharLen, ByteLen: Integer;
  769. Buf: TIdBytes;
  770. LChar: WideChar;
  771. Encoded: Boolean;
  772. LTempStr: UnicodeString;
  773. begin
  774. Result := '';
  775. // keep the compiler happy
  776. Buf := nil;
  777. if ASrc = '' then begin
  778. Exit;
  779. end;
  780. EnsureEncoding(AByteEncoding, encUTF8);
  781. // 2 Chars to handle UTF-16 surrogates
  782. SetLength(Buf, AByteEncoding.GetMaxByteCount(2));
  783. I := 0;
  784. while I < Length(ASrc) do
  785. begin
  786. LChar := ASrc[I+1];
  787. // RLebeau 1/7/09: using Ord() for #128-#255 because in D2009 and later, the
  788. // compiler may change characters >= #128 from their Ansi codepage value to
  789. // their true Unicode codepoint value, depending on the codepage used for
  790. // the source code. For instance, #128 may become #$20AC...
  791. if Ord(LChar) = 32 then
  792. begin
  793. Result := Result + '+'; {do not localize}
  794. Inc(I);
  795. end
  796. else if WideCharIsInSet(SafeChars, LChar) then
  797. begin
  798. Result := Result + Char(LChar);
  799. Inc(I);
  800. end else
  801. begin
  802. // HTML 5 Section 4.10.16.4 says:
  803. //
  804. // 1. For each character ... that cannot be expressed using the selected character
  805. // encoding, replace the character by a string consisting of a U+0026 AMPERSAND
  806. // character (&), a U+0023 NUMBER SIGN character (#), one or more characters in
  807. // the range U+0030 DIGIT ZERO (0) to U+0039 DIGIT NINE (9) representing the
  808. // Unicode code point of the character in base ten, and finally a U+003B
  809. // SEMICOLON character (;).
  810. //
  811. //
  812. // 2. For each character in the entry's name and value, apply the following subsubsteps:
  813. //
  814. // 1. If the character isn't in the range U+0020, U+002A, U+002D, U+002E, U+0030 .. U+0039,
  815. // U+0041 .. U+005A, U+005F, U+0061 .. U+007A then replace the character with a string
  816. // formed as follows: Start with the empty string, and then, taking each byte of the
  817. // character when expressed in the selected character encoding in turn, append to the
  818. // string a U+0025 PERCENT SIGN character (%) followed by two characters in the ranges
  819. // U+0030 DIGIT ZERO (0) to U+0039 DIGIT NINE (9) and U+0041 LATIN CAPITAL LETTER A to
  820. // U+005A LATIN CAPITAL LETTER Z representing the hexadecimal value of the byte
  821. // (zero-padded if necessary).
  822. //
  823. // 2. If the character is a U+0020 SPACE character, replace it with a single U+002B PLUS SIGN character (+).
  824. //
  825. CharLen := CalcUTF16CharLength(ASrc, I+1); // calculate length including surrogates
  826. ByteLen := AByteEncoding.GetBytes(ASrc, I+1, CharLen, Buf, 0); // explicit Unicode->Ansi conversion
  827. Encoded := (ByteLen > 0);
  828. if Encoded and (LChar <> '?') then begin {do not localize}
  829. for J := 0 to ByteLen-1 do begin
  830. if Buf[J] = Ord('?') then begin {do not localize}
  831. Encoded := False;
  832. Break;
  833. end;
  834. end;
  835. end;
  836. // Note, the way 4.10.16.4 is written, it sounds like the '&#dddd;' replacement is
  837. // supposed to take place BEFORE the resulting bytes are then percent-encoded in '%HH'
  838. // format! So that is what we will do...
  839. if not Encoded then begin
  840. J := GetUTF16Codepoint(ASrc, I+1);
  841. LTempStr := '&#' + IntToStr(J) + ';'; {do not localize}
  842. ByteLen := AByteEncoding.GetBytes(LTempStr, 1, Length(LTempStr), Buf, 0);
  843. end;
  844. for J := 0 to ByteLen-1 do begin
  845. Result := Result + '%' + IntToHex(Ord(Buf[J]), 2); {do not localize}
  846. end;
  847. Inc(I, CharLen);
  848. end;
  849. end;
  850. end;
  851. function TIdCustomHTTP.SetRequestParams(ASource: TStrings; AByteEncoding: IIdTextEncoding): string;
  852. var
  853. i: Integer;
  854. LPos: integer;
  855. LStr: string;
  856. LTemp: TStringList;
  857. {$IFDEF HAS_TStrings_NameValueSeparator}
  858. LChar: string;
  859. J: Integer;
  860. {$ENDIF}
  861. function EncodeLineBreaks(AStrings: TStrings): String;
  862. begin
  863. if AStrings.Count > 1 then begin
  864. // break trailing CR&LF
  865. Result := ReplaceAll(Trim(AStrings.Text), AStrings.LineBreak, '&'); {do not localize}
  866. end else begin
  867. Result := Trim(AStrings.Text);
  868. end;
  869. end;
  870. begin
  871. if Assigned(ASource) then begin
  872. if hoForceEncodeParams in FOptions then begin
  873. // make a copy of ASource so the caller's TStrings object is not modified
  874. LTemp := TStringList.Create;
  875. try
  876. LTemp.Assign(ASource);
  877. for i := 0 to LTemp.Count - 1 do begin
  878. LStr := LTemp[i];
  879. {$IFDEF HAS_TStrings_NameValueSeparator}
  880. // RLebeau 11/8/16: Calling Pos() with a Char as input creates a temporary
  881. // String. Normally this is fine, but profiling reveils this to be a big
  882. // bottleneck for code that makes a lot of calls to Pos() in a loop, so we
  883. // will scan through the string looking for the character without a conversion...
  884. //
  885. // LPos := IndyPos(LTemp.NameValueSeparator, LStr);
  886. //
  887. LChar := LTemp.NameValueSeparator;
  888. LPos := 0;
  889. for J := 1 to Length(LStr) do begin
  890. //if CharEquals(LStr, LPos, LChar) then begin
  891. if LStr[J] = LChar then begin
  892. LPos := J;
  893. Break;
  894. end;
  895. end;
  896. {$ELSE}
  897. LPos := IndyPos('=', LStr); {do not localize}
  898. {$ENDIF}
  899. if LPos > 0 then begin
  900. LTemp[i] := WWWFormUrlEncode(LTemp.Names[i], AByteEncoding)
  901. + '=' {do not localize}
  902. + WWWFormUrlEncode(IndyValueFromIndex(LTemp, i), AByteEncoding);
  903. end else begin
  904. LTemp[i] := WWWFormUrlEncode(LStr, AByteEncoding);
  905. end;
  906. end;
  907. Result := EncodeLineBreaks(LTemp);
  908. finally
  909. LTemp.Free;
  910. end;
  911. end else begin
  912. Result := EncodeLineBreaks(ASource);
  913. end;
  914. end else begin
  915. Result := '';
  916. end;
  917. end;
  918. function TIdCustomHTTP.Post(AURL: string; const ASourceFile: String): string;
  919. var
  920. LSource: TIdReadFileExclusiveStream;
  921. begin
  922. LSource := TIdReadFileExclusiveStream.Create(ASourceFile);
  923. try
  924. Result := Post(AURL, LSource);
  925. finally
  926. LSource.Free;
  927. end;
  928. end;
  929. procedure TIdCustomHTTP.Post(AURL: string; const ASourceFile: String; AResponseContent: TStream);
  930. var
  931. LSource: TStream;
  932. begin
  933. LSource := TIdReadFileExclusiveStream.Create(ASourceFile);
  934. try
  935. Post(AURL, LSource, AResponseContent);
  936. finally
  937. LSource.Free;
  938. end;
  939. end;
  940. procedure TIdCustomHTTP.Post(AURL: string; ASource: TStrings; AResponseContent: TStream;
  941. AByteEncoding: IIdTextEncoding = nil);
  942. var
  943. LParams: TMemoryStream;
  944. begin
  945. // Usual posting request have default ContentType is application/x-www-form-urlencoded
  946. if (Request.ContentType = '') or IsContentTypeHtml(Request) then begin
  947. Request.ContentType := 'application/x-www-form-urlencoded'; {do not localize}
  948. end;
  949. if ASource <> nil then
  950. begin
  951. LParams := TMemoryStream.Create;
  952. try
  953. WriteStringToStream(LParams, SetRequestParams(ASource, AByteEncoding));
  954. LParams.Position := 0;
  955. Post(AURL, LParams, AResponseContent);
  956. finally
  957. LParams.Free;
  958. end;
  959. end else begin
  960. Post(AURL, TStream(nil), AResponseContent);
  961. end;
  962. end;
  963. function TIdCustomHTTP.Post(AURL: string; ASource: TStrings; AByteEncoding: IIdTextEncoding = nil): string;
  964. var
  965. LResponse: TMemoryStream;
  966. begin
  967. LResponse := TMemoryStream.Create;
  968. try
  969. Post(AURL, ASource, LResponse, AByteEncoding);
  970. LResponse.Position := 0;
  971. Result := ReadStringAsCharset(LResponse, Response.Charset);
  972. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  973. finally
  974. LResponse.Free;
  975. end;
  976. end;
  977. function TIdCustomHTTP.Post(AURL: string; ASource: TStream): string;
  978. var
  979. LResponse: TMemoryStream;
  980. begin
  981. LResponse := TMemoryStream.Create;
  982. try
  983. Post(AURL, ASource, LResponse);
  984. LResponse.Position := 0;
  985. Result := ReadStringAsCharset(LResponse, Response.Charset);
  986. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  987. finally
  988. LResponse.Free;
  989. end;
  990. end;
  991. procedure TIdCustomHTTP.Put(AURL: string; ASource, AResponseContent: TStream);
  992. begin
  993. DoRequest(Id_HTTPMethodPut, AURL, ASource, AResponseContent, []);
  994. end;
  995. function TIdCustomHTTP.Put(AURL: string; ASource: TStream): string;
  996. var
  997. LResponse: TMemoryStream;
  998. begin
  999. LResponse := TMemoryStream.Create;
  1000. try
  1001. Put(AURL, ASource, LResponse);
  1002. LResponse.Position := 0;
  1003. Result := ReadStringAsCharset(LResponse, Response.Charset);
  1004. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  1005. finally
  1006. LResponse.Free;
  1007. end;
  1008. end;
  1009. function TIdCustomHTTP.Get(AURL: string): string;
  1010. begin
  1011. Result := Get(AURL, []);
  1012. end;
  1013. function TIdCustomHTTP.Trace(AURL: string): string;
  1014. var
  1015. LResponse: TMemoryStream;
  1016. begin
  1017. LResponse := TMemoryStream.Create;
  1018. try
  1019. Trace(AURL, LResponse);
  1020. LResponse.Position := 0;
  1021. Result := ReadStringAsCharset(LResponse, Response.Charset);
  1022. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  1023. finally
  1024. LResponse.Free;
  1025. end;
  1026. end;
  1027. function TIdCustomHTTP.DoOnRedirect(var Location: string; var VMethod: TIdHTTPMethod; RedirectCount: integer): boolean;
  1028. begin
  1029. // TODO: convert relative URLs to full URLs here...
  1030. Result := HandleRedirects;
  1031. if Assigned(FOnRedirect) then begin
  1032. FOnRedirect(Self, Location, RedirectCount, Result, VMethod);
  1033. end;
  1034. end;
  1035. procedure TIdCustomHTTP.SetCookies(AURL: TIdURI; ARequest: TIdHTTPRequest);
  1036. var
  1037. // under ARC, convert a weak reference to a strong reference before working with it
  1038. LCookieManager: TIdCookieManager;
  1039. begin
  1040. LCookieManager := FCookieManager;
  1041. if Assigned(LCookieManager) and AllowCookies then
  1042. begin
  1043. // Send secure cookies only if we have Secured connection
  1044. LCookieManager.GenerateClientCookies(
  1045. AURL,
  1046. TextIsSame(AURL.Protocol, 'HTTPS'), {do not localize}
  1047. ARequest.RawHeaders);
  1048. end;
  1049. end;
  1050. // This function sets the Host and Port and returns a boolean depending on
  1051. // whether a PROXY is being used or not.
  1052. function TIdCustomHTTP.SetHostAndPort: TIdHTTPConnectionType;
  1053. var
  1054. LHost: string;
  1055. LPort: Integer;
  1056. begin
  1057. // First check to see if a Proxy has been specified.
  1058. if ProxyParams.ProxyServer <> '' then begin
  1059. if (not TextIsSame(FHost, ProxyParams.ProxyServer)) or (FPort <> ProxyParams.ProxyPort) then begin
  1060. if Connected then begin
  1061. Disconnect;
  1062. end;
  1063. end;
  1064. LHost := ProxyParams.ProxyServer;
  1065. LPort := ProxyParams.ProxyPort;
  1066. if TextIsSame(URL.Protocol, 'HTTPS') then begin {do not localize}
  1067. Result := ctSSLProxy;
  1068. end else begin
  1069. Result := ctProxy;
  1070. end;
  1071. end else begin
  1072. if Assigned(Socket) then begin
  1073. if Assigned(Socket.Binding) then begin
  1074. if URL.IPVersion <> Socket.Binding.IPVersion then begin
  1075. if Connected then begin
  1076. Disconnect; // get rid of current socket handle
  1077. end;
  1078. end;
  1079. end;
  1080. end;
  1081. LHost := URL.Host;
  1082. LPort := IndyStrToInt(URL.Port, IdPORT_HTTP);
  1083. if (not TextIsSame(FHost, LHost)) or (LPort <> FPort) then begin
  1084. if Connected then begin
  1085. Disconnect;
  1086. end;
  1087. end;
  1088. if TextIsSame(URL.Protocol, 'HTTPS') then begin {do not localize}
  1089. Result := ctSSL;
  1090. end else begin
  1091. Result := ctNormal;
  1092. end;
  1093. end;
  1094. Host := LHost;
  1095. Port := LPort;
  1096. end;
  1097. // TODO: move the XML charset detector below to the IdGlobalProtocols unit so
  1098. // it can be used in other components, like TIdMessageClient and TIdIMAP4...
  1099. type
  1100. XmlEncoding = (xmlUCS4BE, xmlUCS4BEOdd, xmlUCS4LE, xmlUCS4LEOdd,
  1101. xmlUTF16BE, xmlUTF16LE, xmlUTF8, xmlEBCDIC, xmlUnknown
  1102. );
  1103. XmlBomInfo = record
  1104. Charset: String;
  1105. BOMLen: Integer;
  1106. BOM: UInt32;
  1107. BOMMask: UInt32;
  1108. end;
  1109. XmlNonBomInfo = record
  1110. CharLen: Integer;
  1111. FirstChar: UInt32;
  1112. LastChar: UInt32;
  1113. CharMask: UInt32;
  1114. end;
  1115. const
  1116. XmlBOMs: array[xmlUCS4BE..xmlUTF8] of XmlBomInfo = (
  1117. (Charset: 'UCS-4BE'; BOMLen: 4; BOM: $0000FEFF; BOMMask: $FFFFFFFF), {do not localize}
  1118. (Charset: ''; {UCS-4} BOMLen: 4; BOM: $0000FFFE; BOMMask: $FFFFFFFF),
  1119. (Charset: 'UCS-4LE'; BOMLen: 4; BOM: $FFFE0000; BOMMask: $FFFFFFFF), {do not localize}
  1120. (Charset: ''; {UCS-4} BOMLen: 4; BOM: $FEFF0000; BOMMask: $FFFFFFFF),
  1121. (Charset: 'UTF-16BE'; BOMLen: 2; BOM: $FEFF0000; BOMMask: $FFFF0000), {do not localize}
  1122. (Charset: 'UTF-16LE'; BOMLen: 2; BOM: $FFFE0000; BOMMask: $FFFF0000), {do not localize}
  1123. (Charset: 'UTF-8'; BOMLen: 3; BOM: $EFBBBF00; BOMMask: $FFFFFF00) {do not localize}
  1124. );
  1125. XmlNonBOMs: array[xmlUCS4BE..xmlEBCDIC] of XmlNonBomInfo = (
  1126. (CharLen: 4; FirstChar: $0000003C; LastChar: $0000003E; CharMask: $FFFFFFFF),
  1127. (CharLen: 4; FirstChar: $00003C00; LastChar: $00003E00; CharMask: $FFFFFFFF),
  1128. (CharLen: 4; FirstChar: $3C000000; LastChar: $3E000000; CharMask: $FFFFFFFF),
  1129. (CharLen: 4; FirstChar: $003C0000; LastChar: $003E0000; CharMask: $FFFFFFFF),
  1130. (CharLen: 2; FirstChar: $003C003F; LastChar: $003E0000; CharMask: $FFFF0000),
  1131. (CharLen: 2; FirstChar: $3C003F00; LastChar: $3E000000; CharMask: $FFFF0000),
  1132. (CharLen: 1; FirstChar: $3C3F786D; LastChar: $3E000000; CharMask: $FF000000),
  1133. (CharLen: 1; FirstChar: $4C6FA794; LastChar: $6E000000; CharMask: $FF000000)
  1134. );
  1135. XmlUCS4AsciiIndex: array[xmlUCS4BE..xmlUCS4LEOdd] of Integer = (3, 2, 0, 1);
  1136. // RLebeau: only interested in EBCDIC ASCII characters that are allowed in
  1137. // an XML declaration, we'll treat everything else as #01 for now...
  1138. XmlEBCDICTable: array[Byte] of Char = (
  1139. { -0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -A -B -C -D -E -F }
  1140. {0-} #01, #01, #01, #01, #01, #09, #01, #01, #01, #01, #01, #01, #01, #13, #01, #01, {do not localize}
  1141. {1-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
  1142. {2-} #01, #01, #01, #01, #01, #10, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
  1143. {3-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
  1144. {4-} ' ', #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, '.', '<', #01, #01, #01, {do not localize}
  1145. {5-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
  1146. {6-} '-', #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, '_', '>', '?', {do not localize}
  1147. {7-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #27, '=', '"', {do not localize}
  1148. {8-} #01, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', #01, #01, #01, #01, #01, #01, {do not localize}
  1149. {9-} #01, 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', #01, #01, #01, #01, #01, #01, {do not localize}
  1150. {A-} #01, #01, 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', #01, #01, #01, #01, #01, #01, {do not localize}
  1151. {B-} #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, #01, {do not localize}
  1152. {C-} #01, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', #01, #01, #01, #01, #01, #01, {do not localize}
  1153. {D-} #01, 'J', 'K', 'L', 'N', 'N', 'O', 'P', 'Q', 'R', #01, #01, #01, #01, #01, #01, {do not localize}
  1154. {E-} #01, #01, 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', #01, #01, #01, #01, #01, #01, {do not localize}
  1155. {F-} '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', #01, #01, #01, #01, #01, #01 {do not localize}
  1156. );
  1157. function DetectXmlCharset(AStream: TStream): String;
  1158. var
  1159. Buffer: TIdBytes;
  1160. InBuf, StreamPos, CurPos: Int64;
  1161. XmlDec, XmlEnc: String;
  1162. {$IFDEF STRING_IS_IMMUTABLE}
  1163. LSB: TIdStringBuilder;
  1164. {$ENDIF}
  1165. I, Len: Integer;
  1166. Enc: XmlEncoding;
  1167. Signature: UInt32;
  1168. function BufferToUInt32: UInt32;
  1169. begin
  1170. Result := (UInt32(Buffer[0]) shl 24) or
  1171. (UInt32(Buffer[1]) shl 16) or
  1172. (UInt32(Buffer[2]) shl 8) or
  1173. UInt32(Buffer[3]);
  1174. end;
  1175. begin
  1176. // XML's default encoding is UTF-8 unless specified otherwise, either
  1177. // by a BOM or an explicit "encoding" in the XML's prolog...
  1178. Result := 'UTF-8'; {do not localize}
  1179. if AStream = nil then begin
  1180. Exit;
  1181. end;
  1182. StreamPos := AStream.Position;
  1183. try
  1184. AStream.Position := 0;
  1185. SetLength(Buffer, 4);
  1186. FillBytes(Buffer, 4, $00);
  1187. InBuf := ReadTIdBytesFromStream(AStream, Buffer, 4);
  1188. if InBuf < 3 then begin
  1189. Exit;
  1190. end;
  1191. Signature := BufferToUInt32;
  1192. // check for known BOMs first...
  1193. for Enc := Low(XmlBOMs) to High(XmlBOMs) do begin
  1194. if (Signature and XmlBOMs[Enc].BOMMask) = XmlBOMs[Enc].BOM then begin
  1195. Inc(StreamPos, XmlBOMs[Enc].BOMLen);
  1196. Result := XmlBOMs[Enc].Charset;
  1197. Exit;
  1198. end;
  1199. end;
  1200. // check for non-BOM'ed encodings now...
  1201. if InBuf <> 4 then begin
  1202. Exit;
  1203. end;
  1204. XmlDec := '';
  1205. for Enc := Low(XmlNonBOMs) to High(XmlNonBOMs) do begin
  1206. if Signature = XmlNonBOMs[Enc].FirstChar then begin
  1207. FillBytes(Buffer, 4, $00);
  1208. while (AStream.Size - AStream.Position) >= XmlNonBOMs[Enc].CharLen do
  1209. begin
  1210. ReadTIdBytesFromStream(AStream, Buffer, XmlNonBOMs[Enc].CharLen);
  1211. Signature := BufferToUInt32;
  1212. if (Signature and XmlNonBOMs[Enc].CharMask) = XmlNonBOMs[Enc].LastChar then
  1213. begin
  1214. CurPos := AStream.Position;
  1215. AStream.Position := 0;
  1216. case Enc of
  1217. xmlUCS4BE, xmlUCS4LE, xmlUCS4BEOdd, xmlUCS4LEOdd: begin
  1218. // TODO: create UCS-4 IIdTextEncoding implementations...
  1219. Len := CurPos div XmlNonBOMs[Enc].CharLen;
  1220. {$IFDEF STRING_IS_IMMUTABLE}
  1221. LSB := TIdStringBuilder.Create(Len);
  1222. {$ELSE}
  1223. SetLength(XmlDec, Len);
  1224. {$ENDIF}
  1225. for I := 1 to Len do begin
  1226. ReadTIdBytesFromStream(AStream, Buffer, XmlNonBOMs[Enc].CharLen);
  1227. {$IFDEF STRING_IS_IMMUTABLE}
  1228. LSB.Append(Char(Buffer[XmlUCS4AsciiIndex[Enc]]));
  1229. {$ELSE}
  1230. XmlDec[I] := Char(Buffer[XmlUCS4AsciiIndex[Enc]]);
  1231. {$ENDIF}
  1232. end;
  1233. {$IFDEF STRING_IS_IMMUTABLE}
  1234. XmlDec := LSB.ToString;
  1235. LSB := nil;
  1236. {$ENDIF}
  1237. end;
  1238. xmlUTF16BE: begin
  1239. XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_UTF16BE);
  1240. end;
  1241. xmlUTF16LE: begin
  1242. XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_UTF16LE);
  1243. end;
  1244. xmlUTF8: begin
  1245. XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_UTF8);
  1246. end;
  1247. xmlEBCDIC: begin
  1248. // TODO: create an EBCDIC IIdTextEncoding implementation...
  1249. {$IFDEF STRING_IS_IMMUTABLE}
  1250. Len := ReadTIdBytesFromStream(AStream, Buffer, CurPos);
  1251. LSB := TStringBuilder.Create(Len);
  1252. for I := 0 to Len-1 do begin
  1253. LSB.Append(XmlEBCDICTable[Buffer[I]]);
  1254. end;
  1255. XmlDec := LSB.ToString;
  1256. {$ELSE}
  1257. XmlDec := ReadStringFromStream(AStream, CurPos, IndyTextEncoding_8Bit);
  1258. for I := 1 to Length(XmlDec) do begin
  1259. XmlDec[I] := XmlEBCDICTable[Byte(XmlDec[I])];
  1260. end;
  1261. {$ENDIF}
  1262. end;
  1263. end;
  1264. Break;
  1265. end;
  1266. end;
  1267. Break;
  1268. end;
  1269. end;
  1270. if XmlDec = '' then begin
  1271. Exit;
  1272. end;
  1273. I := Pos('encoding', XmlDec); {do not localize}
  1274. if I = 0 then begin
  1275. Exit;
  1276. end;
  1277. XmlDec := TrimLeft(Copy(XmlDec, I+8, MaxInt));
  1278. if not CharEquals(XmlDec, 1, '=') then begin {do not localize}
  1279. Exit;
  1280. end;
  1281. XmlDec := TrimLeft(Copy(XmlDec, 2, MaxInt));
  1282. if XmlDec = '' then begin
  1283. Exit;
  1284. end;
  1285. if XmlDec[1] = #$27 then begin
  1286. XmlDec := Copy(XmlDec, 2, MaxInt);
  1287. XmlEnc := Fetch(XmlDec, #$27);
  1288. end
  1289. else if XmlDec[1] = '"' then begin
  1290. XmlDec := Copy(XmlDec, 2, MaxInt);
  1291. XmlEnc := Fetch(XmlDec, '"');
  1292. end;
  1293. XmlEnc := Trim(XmlEnc);
  1294. if XmlEnc = '' then begin
  1295. Exit;
  1296. end;
  1297. Result := XmlEnc;
  1298. finally
  1299. AStream.Position := StreamPos;
  1300. end;
  1301. end;
  1302. procedure TIdCustomHTTP.ReadResult(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  1303. var
  1304. LS: TStream;
  1305. LOrigStream, LTmpStream : TStream;
  1306. LParseMeth : Integer;
  1307. //0 - no parsing
  1308. //1 - html
  1309. //2 - xml
  1310. LCreateTmpContent : Boolean;
  1311. LDecMeth : Integer;
  1312. //0 - no compression was used or we can't support that feature
  1313. //1 - deflate
  1314. //2 - gzip
  1315. // under ARC, convert a weak reference to a strong reference before working with it
  1316. LCompressor: TIdZLibCompressorBase;
  1317. function CheckForPendingData(ATimeout: Integer): Boolean;
  1318. begin
  1319. Result := not IOHandler.InputBufferIsEmpty;
  1320. if not Result then begin
  1321. IOHandler.CheckForDataOnSource(ATimeout);
  1322. Result := not IOHandler.InputBufferIsEmpty;
  1323. end;
  1324. end;
  1325. function ShouldRead: Boolean;
  1326. var
  1327. CanRead: Boolean;
  1328. begin
  1329. Result := False;
  1330. if IndyPos('chunked', LowerCase(AResponse.TransferEncoding)) > 0 then begin {do not localize}
  1331. CanRead := not (hoNoReadChunked in FOptions);
  1332. end
  1333. else if AResponse.HasContentLength then begin
  1334. CanRead := AResponse.ContentLength > 0; // If chunked then this is also 0
  1335. end
  1336. else if IsHeaderMediaType(AResponse.ContentType, 'multipart') then begin {do not localize}
  1337. CanRead := not (hoNoReadMultipartMIME in FOptions);
  1338. end
  1339. else begin
  1340. CanRead := True;
  1341. end;
  1342. if CanRead then
  1343. begin
  1344. // DO NOT READ IF THE REQUEST IS HEAD!!!
  1345. // The server is supposed to send a 'Content-Length' header without sending
  1346. // the actual data. 1xx, 204, and 304 replies are not supposed to contain
  1347. // entity bodies, either...
  1348. if TextIsSame(ARequest.Method, Id_HTTPMethodHead) or
  1349. ({TextIsSame(ARequest.Method, Id_HTTPMethodPost) and} TextIsSame(ARequest.MethodOverride, Id_HTTPMethodHead)) or
  1350. // TODO: check for 'X-HTTP-Method' and 'X-METHOD-OVERRIDE' request headers as well...
  1351. ((AResponse.ResponseCode div 100) = 1) or
  1352. (AResponse.ResponseCode = 204) or
  1353. (AResponse.ResponseCode = 304) then
  1354. begin
  1355. // Have noticed one case where a non-conforming server did send an
  1356. // entity body in response to a HEAD request. If requested, ignore
  1357. // anything the server may send by accident
  1358. if not (hoWaitForUnexpectedData in FOptions) then begin
  1359. Exit;
  1360. end;
  1361. Result := CheckForPendingData(100);
  1362. end
  1363. else if (AResponse.ResponseCode div 100) = 3 then
  1364. begin
  1365. // This is a workaround for buggy HTTP 1.1 servers which
  1366. // does not return any body with 302 response code
  1367. Result := CheckForPendingData(5000);
  1368. end else begin
  1369. Result := True;
  1370. end;
  1371. end;
  1372. end;
  1373. function ChunkSize: integer;
  1374. var
  1375. j: Integer;
  1376. s: string;
  1377. begin
  1378. s := InternalReadLn;
  1379. j := IndyPos(';', s); {do not localize}
  1380. if j > 0 then begin
  1381. s := Copy(s, 1, j - 1);
  1382. end;
  1383. Result := IndyStrToInt('$' + Trim(s), 0); {do not localize}
  1384. end;
  1385. procedure ReadChunked;
  1386. var
  1387. LSize: Integer;
  1388. LTrailHeader: String;
  1389. LChunk : TIdBytes;
  1390. begin
  1391. DoStatus(hsStatusText, [RSHTTPChunkStarted]);
  1392. BeginWork(wmRead);
  1393. try
  1394. LSize := ChunkSize;
  1395. while LSize <> 0 do begin
  1396. // TODO: fire OnChunkReceived even if LS is nil? This way, the caller
  1397. // can choose to pass AContentStream=nil and rely solely on OnChunkReceived
  1398. // in cases where a chunked response is expected up front, like in
  1399. // server-side pushes...
  1400. if Assigned(LS) then begin
  1401. if Assigned(FOnChunkReceived) then begin
  1402. SetLength(LChunk, LSize);
  1403. IOHandler.ReadBytes(LChunk, LSize, False);
  1404. if Assigned(FOnChunkReceived) then begin
  1405. FOnChunkReceived(Self, LChunk);
  1406. end;
  1407. WriteTIdBytesToStream(LS, LChunk);
  1408. end else begin
  1409. IOHandler.ReadStream(LS, LSize);
  1410. end;
  1411. end else begin
  1412. IOHandler.Discard(LSize);
  1413. end;
  1414. InternalReadLn; // CRLF at end of chunk data
  1415. LSize := ChunkSize;
  1416. end;
  1417. // read trailer headers
  1418. LTrailHeader := InternalReadLn;
  1419. while LTrailHeader <> '' do begin
  1420. AResponse.RawHeaders.Add(LTrailHeader);
  1421. LTrailHeader := InternalReadLn;
  1422. end;
  1423. finally
  1424. EndWork(wmRead);
  1425. end;
  1426. end;
  1427. procedure ReadMIME;
  1428. var
  1429. LMIMEBoundary: TIdBytes;
  1430. LIndex: Integer;
  1431. LSize: Integer;
  1432. begin
  1433. LMIMEBoundary := ToBytes('--' + ExtractHeaderSubItem(AResponse.ContentType, 'boundary', QuoteHTTP) + '--');
  1434. BeginWork(wmRead);
  1435. try
  1436. try
  1437. repeat
  1438. LIndex := IOHandler.InputBuffer.IndexOf(LMIMEBoundary);
  1439. if LIndex <> -1 then
  1440. begin
  1441. LSize := LIndex + Length(LMIMEBoundary);
  1442. if Assigned(LS) then begin
  1443. // TODO: use TIdBuffer.ExtractToStream() instead, bypassing the
  1444. // overhead of TIdIOHandler.ReadStream() allocating a local buffer
  1445. // and calling IOHandler.ReadBytes() to fill that buffer in even
  1446. // multiples of the IOHandler's RecvBufferSize. The data we want
  1447. // is already in the Buffer's memory, so just read it directly...
  1448. //
  1449. // IOHandler.InputBuffer.ExtractToStream(LS, LSize);
  1450. IOHandler.ReadStream(LS, LSize);
  1451. end else begin
  1452. IOHandler.Discard(LSize);
  1453. end;
  1454. InternalReadLn; // CRLF at end of boundary
  1455. Break;
  1456. end;
  1457. LSize := IOHandler.InputBuffer.Size - (Length(LMIMEBoundary)-1);
  1458. if LSize > 0 then begin
  1459. if Assigned(LS) then begin
  1460. // TODO: use TIdBuffer.ExtractToStream() instead, bypassing the
  1461. // overhead of TIdIOHandler.ReadStream() allocating a local buffer
  1462. // and calling IOHandler.ReadBytes() to fill that buffer in even
  1463. // multiples of the IOHandler's RecvBufferSize. The data we want
  1464. // is already in the Buffer's memory, so just read it directly...
  1465. //
  1466. // IOHandler.InputBuffer.ExtractToStream(LS, LSize);
  1467. IOHandler.ReadStream(LS, LSize);
  1468. end else begin
  1469. IOHandler.Discard(LSize);
  1470. end;
  1471. end;
  1472. IOHandler.CheckForDataOnSource;
  1473. IOHandler.CheckForDisconnect(True, True);
  1474. until False;
  1475. except
  1476. on E: EIdConnClosedGracefully do begin
  1477. if Assigned(LS) then begin
  1478. IOHandler.InputBuffer.ExtractToStream(LS);
  1479. end else begin
  1480. IOHandler.InputBuffer.Clear;
  1481. end;
  1482. end;
  1483. end;
  1484. finally
  1485. EndWork(wmRead);
  1486. end;
  1487. end;
  1488. begin
  1489. if not ShouldRead then begin
  1490. Exit;
  1491. end;
  1492. LParseMeth := 0;
  1493. LDecMeth := 0;
  1494. if Assigned(AResponse.ContentStream) then begin
  1495. if IsContentTypeHtml(AResponse) then begin
  1496. if not (hoNoParseMetaHTTPEquiv in FOptions) then begin
  1497. LParseMeth := 1;
  1498. end;
  1499. end
  1500. else if IsContentTypeAppXml(Response) then begin
  1501. if not (hoNoParseXmlCharset in FOptions) then begin
  1502. LParseMeth := 2;
  1503. end;
  1504. end;
  1505. end;
  1506. // under ARC, AResponse.ContentStream uses weak referencing, so need to
  1507. // use local strong references to keep the streams alive...
  1508. LOrigStream := AResponse.ContentStream;
  1509. LCreateTmpContent := (LParseMeth <> 0) and not (LOrigStream is TCustomMemoryStream);
  1510. if LCreateTmpContent then begin
  1511. LTmpStream := TMemoryStream.Create;
  1512. end else begin
  1513. LTmpStream := nil;
  1514. end;
  1515. try
  1516. if LCreateTmpContent then begin
  1517. AResponse.ContentStream := LTmpStream;
  1518. end;
  1519. // we need to determine what type of decompression may need to be used
  1520. // before we read from the IOHandler. If there is compression, then we
  1521. // use a local stream to download the compressed data and decompress it.
  1522. // If no compression is used, ContentStream will be used directly
  1523. LCompressor := Compressor;
  1524. if Assigned(AResponse.ContentStream) then begin
  1525. if Assigned(LCompressor) and LCompressor.IsReady then begin
  1526. LDecMeth := PosInStrArray(AResponse.ContentEncoding, ['deflate', 'gzip'], False) + 1; {do not localize}
  1527. end;
  1528. if LDecMeth > 0 then begin
  1529. LS := TMemoryStream.Create;
  1530. end else begin
  1531. LS := AResponse.ContentStream;
  1532. end;
  1533. end else
  1534. begin
  1535. LS := nil;
  1536. end;
  1537. try
  1538. if IndyPos('chunked', LowerCase(AResponse.TransferEncoding)) > 0 then begin {do not localize}
  1539. ReadChunked;
  1540. end
  1541. else if AResponse.HasContentLength then begin
  1542. if AResponse.ContentLength > 0 then begin// If chunked then this is also 0
  1543. try
  1544. if Assigned(LS) then begin
  1545. IOHandler.ReadStream(LS, AResponse.ContentLength);
  1546. end else begin
  1547. IOHandler.Discard(AResponse.ContentLength);
  1548. end;
  1549. except
  1550. // should this be caught here? We are being told the size, so a
  1551. // premature disconnect should be an error, right?
  1552. on E: EIdConnClosedGracefully do begin end;
  1553. end;
  1554. end;
  1555. end
  1556. else if IsHeaderMediaType(AResponse.ContentType, 'multipart') then begin {do not localize}
  1557. ReadMIME;
  1558. end else begin
  1559. if Assigned(LS) then begin
  1560. IOHandler.ReadStream(LS, -1, True);
  1561. end else begin
  1562. IOHandler.DiscardAll;
  1563. end;
  1564. end;
  1565. if LDecMeth > 0 then begin
  1566. LS.Position := 0;
  1567. case LDecMeth of
  1568. 1 : LCompressor.DecompressDeflateStream(LS, AResponse.ContentStream);
  1569. 2 : LCompressor.DecompressGZipStream(LS, AResponse.ContentStream);
  1570. end;
  1571. end;
  1572. finally
  1573. if LDecMeth > 0 then begin
  1574. LS.Free;
  1575. end;
  1576. end;
  1577. case LParseMeth of
  1578. 1: begin
  1579. // RLebeau 1/30/2012: parse HTML <meta> tags, update Response.CharSet ...
  1580. AResponse.ProcessMetaHTTPEquiv;
  1581. end;
  1582. 2: begin
  1583. // the media type is not a 'text/...' based XML type, so ignore the
  1584. // charset from the headers, if present, and parse the XML itself...
  1585. AResponse.CharSet := DetectXmlCharset(AResponse.ContentStream);
  1586. end;
  1587. else
  1588. // TODO: if a Charset is not specified, return an appropriate value
  1589. // that is registered with IANA for the reported ContentType...
  1590. end;
  1591. finally
  1592. if LCreateTmpContent then
  1593. begin
  1594. try
  1595. LOrigStream.CopyFrom(LTmpStream, 0);
  1596. finally
  1597. {$IFNDEF USE_OBJECT_ARC}
  1598. LTmpStream.Free;
  1599. {$ENDIF}
  1600. AResponse.ContentStream := LOrigStream;
  1601. end;
  1602. end;
  1603. end;
  1604. end;
  1605. const
  1606. Requires_HTTP_1_1: array[0..4] of String = (Id_HTTPMethodTrace, Id_HTTPMethodPut, Id_HTTPMethodOptions, Id_HTTPMethodDelete, Id_HTTPMethodPatch);
  1607. Requires_Content_Length: array[0..1] of String = (Id_HTTPMethodPost, Id_HTTPMethodPut);
  1608. procedure TIdCustomHTTP.PrepareRequest(ARequest: TIdHTTPRequest);
  1609. var
  1610. LURI: TIdURI;
  1611. LHost: string;
  1612. begin
  1613. LURI := TIdURI.Create(ARequest.URL);
  1614. try
  1615. if LURI.Username <> '' then begin
  1616. ARequest.Username := LURI.Username;
  1617. ARequest.Password := LURI.Password;
  1618. end;
  1619. FURI.Username := ARequest.Username;
  1620. FURI.Password := ARequest.Password;
  1621. FURI.Path := ProcessPath(FURI.Path, LURI.Path);
  1622. FURI.Document := LURI.Document;
  1623. FURI.Params := LURI.Params;
  1624. if LURI.Host <> '' then begin
  1625. FURI.Host := LURI.Host;
  1626. end;
  1627. if LURI.Protocol <> '' then begin
  1628. FURI.Protocol := LURI.Protocol;
  1629. end
  1630. // non elegant solution - to be recoded, only for pointing the bug / GREGOR
  1631. else if TextIsSame(FURI.Protocol, 'https') then begin {do not localize}
  1632. FURI.Protocol := 'https'; {do not localize}
  1633. end
  1634. else begin
  1635. FURI.Protocol := 'http'; {do not localize}
  1636. end;
  1637. if LURI.Port <> '' then begin
  1638. FURI.Port := LURI.Port;
  1639. end
  1640. else if TextIsSame(LURI.Protocol, 'http') then begin {do not localize}
  1641. FURI.Port := IntToStr(IdPORT_HTTP);
  1642. end
  1643. else if TextIsSame(LURI.Protocol, 'https') then begin {do not localize}
  1644. FURI.Port := IntToStr(IdPORT_https);
  1645. end
  1646. else if FURI.Port = '' then begin
  1647. raise EIdUnknownProtocol.Create(RSHTTPUnknownProtocol);
  1648. end;
  1649. if (TextIsSame(ARequest.Method, Id_HTTPMethodOptions) or TextIsSame(ARequest.MethodOverride, Id_HTTPMethodOptions))
  1650. and TextIsSame(LURI.Document, '*') then {do not localize}
  1651. begin
  1652. ARequest.URL := LURI.Document;
  1653. end else begin
  1654. // The URL part is not URL encoded at this place
  1655. ARequest.URL := URL.GetPathAndParams;
  1656. end;
  1657. ARequest.IPVersion := LURI.IPVersion;
  1658. FURI.IPVersion := ARequest.IPVersion;
  1659. // Check for valid HTTP request methods
  1660. if (PosInStrArray(ARequest.Method, Requires_HTTP_1_1, False) > -1) or
  1661. (PosInStrArray(ARequest.MethodOverride, Requires_HTTP_1_1, False) > -1) then
  1662. begin
  1663. if ProtocolVersion <> pv1_1 then begin
  1664. raise EIdException.Create(RSHTTPMethodRequiresVersion); // TODO: create a new Exception class for this
  1665. end;
  1666. end;
  1667. if Assigned(ARequest.Source) then begin
  1668. ARequest.ContentLength := ARequest.Source.Size;
  1669. end
  1670. else if PosInStrArray(ARequest.Method, Requires_Content_Length, False) > -1 then begin
  1671. ARequest.ContentLength := 0;
  1672. end else begin
  1673. ARequest.ContentLength := -1;
  1674. end;
  1675. // RLebeau: wrap an IPv6 address in brackets, per RFC 2732, and RFC 3986 section 3.2.2...
  1676. if (FURI.IPVersion = Id_IPv6) and (MakeCanonicalIPv6Address(FURI.Host) <> '') then begin
  1677. LHost := '[' + FURI.Host + ']'; {do not localize}
  1678. end else begin
  1679. LHost := FURI.Host;
  1680. end;
  1681. if (TextIsSame(FURI.Protocol, 'http') and (FURI.Port = IntToStr(IdPORT_HTTP))) or {do not localize}
  1682. (TextIsSame(FURI.Protocol, 'https') and (FURI.Port = IntToStr(IdPORT_https))) then {do not localize}
  1683. begin
  1684. ARequest.Host := LHost;
  1685. end else begin
  1686. ARequest.Host := LHost + ':' + FURI.Port; {do not localize}
  1687. end;
  1688. finally
  1689. LURI.Free; // Free URI Object
  1690. end;
  1691. end;
  1692. procedure TIdCustomHTTP.CheckAndConnect(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  1693. begin
  1694. if not AResponse.KeepAlive then begin
  1695. Disconnect;
  1696. end;
  1697. if Assigned(IOHandler) then begin
  1698. IOHandler.InputBuffer.Clear;
  1699. end;
  1700. CheckForGracefulDisconnect(False);
  1701. if not Connected then try
  1702. IPVersion := FURI.IPVersion;
  1703. case ARequest.UseProxy of
  1704. ctNormal, ctProxy:
  1705. begin
  1706. if (IOHandler is TIdSSLIOHandlerSocketBase) then begin
  1707. TIdSSLIOHandlerSocketBase(IOHandler).PassThrough := True;
  1708. TIdSSLIOHandlerSocketBase(IOHandler).URIToCheck := FURI.URI;
  1709. end;
  1710. end;
  1711. ctSSL, ctSSLProxy:
  1712. begin
  1713. // if an IOHandler has not been assigned yet, try to create a default SSL IOHandler object
  1714. //
  1715. // TODO: if an IOHandler has been assigned, but is not an SSL IOHandler,
  1716. // release it and try to create a default SSL IOHandler object?
  1717. //
  1718. if IOHandler = nil then begin
  1719. IOHandler := TIdIOHandler.TryMakeIOHandler(TIdSSLIOHandlerSocketBase, Self);
  1720. if IOHandler = nil then begin
  1721. raise EIdSSLIOHandlerRequired.Create(RSHTTPSRequiresSSLIOHandler);
  1722. end;
  1723. IOHandler.OnStatus := OnStatus; // TODO: assign DoStatus() instead of the handler directly...
  1724. end
  1725. else if not (IOHandler is TIdSSLIOHandlerSocketBase) then begin
  1726. raise EIdSSLIOHandlerRequired.Create(RSHTTPSRequiresSSLIOHandler);
  1727. end;
  1728. TIdSSLIOHandlerSocketBase(IOHandler).URIToCheck := FURI.URI;
  1729. TIdSSLIOHandlerSocketBase(IOHandler).PassThrough := (ARequest.UseProxy = ctSSLProxy);
  1730. end;
  1731. end;
  1732. Connect;
  1733. except
  1734. on E: EIdSSLProtocolReplyError do begin
  1735. Disconnect;
  1736. raise;
  1737. end;
  1738. end;
  1739. end;
  1740. procedure TIdCustomHTTP.ConnectToHost(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  1741. var
  1742. LLocalHTTP: TIdHTTPProtocol;
  1743. LUseConnectVerb: Boolean;
  1744. // under ARC, convert a weak reference to a strong reference before working with it
  1745. LCompressor: TIdZLibCompressorBase;
  1746. LOldProxy: TIdHTTPConnectionType;
  1747. LNewDest: string;
  1748. begin
  1749. // RLebeau 5/29/2018: before doing anything else, clear the InputBuffer. If a
  1750. // previous HTTPS request through an SSL/TLS proxy fails due to a user-defined
  1751. // OnVerifyPeer handler returning False, the proxy tunnel is still established,
  1752. // but the underlying socket may be closed, and unread data left behind in the
  1753. // InputBuffer that will cause Connected() below to return True when it should
  1754. // be False instead. This leads to a situation where TIdHTTP can skip sending
  1755. // a CONNECT request when it creates a new socket connection to the proxy, but
  1756. // send an unencrypted HTTP request to the proxy, which may then get forwarded
  1757. // to the HTTPS server over a previously cached SSL/TLS tunnel...
  1758. if Assigned(IOHandler) then begin
  1759. IOHandler.InputBuffer.Clear;
  1760. end;
  1761. LNewDest := URL.Host + ':' + URL.Port;
  1762. LOldProxy := ARequest.FUseProxy;
  1763. ARequest.FUseProxy := SetHostAndPort;
  1764. if ARequest.UseProxy <> LOldProxy then begin
  1765. if Connected then begin
  1766. Disconnect;
  1767. end;
  1768. end
  1769. else if (ARequest.UseProxy = ctSSLProxy) and (not TextIsSame(ARequest.Destination, LNewDest)) then begin
  1770. if Connected then begin
  1771. Disconnect;
  1772. end;
  1773. end;
  1774. ARequest.Destination := LNewDest;
  1775. LUseConnectVerb := False;
  1776. case ARequest.UseProxy of
  1777. ctNormal, ctSSL:
  1778. begin
  1779. if (ProtocolVersion = pv1_0) and (ARequest.Connection = '') then
  1780. begin
  1781. ARequest.Connection := 'keep-alive'; {do not localize}
  1782. end;
  1783. end;
  1784. ctSSLProxy:
  1785. begin
  1786. // if already connected to an SSL proxy, DO NOT send another
  1787. // CONNECT request, as it will be sent directly to the target
  1788. // HTTP server and not to the proxy!
  1789. LUseConnectVerb := not Connected;
  1790. end;
  1791. ctProxy:
  1792. begin
  1793. ARequest.URL := FURI.URI;
  1794. if (ProtocolVersion = pv1_0) and (ARequest.Connection = '') then
  1795. begin
  1796. // TODO: per RFC 7230:
  1797. // "clients are encouraged not to send the Proxy-Connection header field in any requests."
  1798. ARequest.ProxyConnection := 'keep-alive'; {do not localize}
  1799. end;
  1800. if hoNonSSLProxyUseConnectVerb in FOptions then begin
  1801. // if already connected to a proxy, DO NOT send another CONNECT
  1802. // request, as it will be sent directly to the target HTTP server
  1803. // and not to the proxy!
  1804. LUseConnectVerb := not Connected;
  1805. end;
  1806. end;
  1807. end;
  1808. LCompressor := FCompressor;
  1809. if Assigned(LCompressor) and LCompressor.IsReady then begin
  1810. if IndyPos('deflate', ARequest.AcceptEncoding) = 0 then {do not localize}
  1811. begin
  1812. if ARequest.AcceptEncoding <> '' then begin {do not localize}
  1813. ARequest.AcceptEncoding := ARequest.AcceptEncoding + ', deflate'; {do not localize}
  1814. end else begin
  1815. ARequest.AcceptEncoding := 'deflate'; {do not localize}
  1816. end;
  1817. end;
  1818. if IndyPos('gzip', ARequest.AcceptEncoding) = 0 then {do not localize}
  1819. begin
  1820. if ARequest.AcceptEncoding <> '' then begin {do not localize}
  1821. ARequest.AcceptEncoding := ARequest.AcceptEncoding + ', gzip'; {do not localize}
  1822. end else begin
  1823. ARequest.AcceptEncoding := 'gzip'; {do not localize}
  1824. end;
  1825. end;
  1826. end else
  1827. begin
  1828. // TODO: if ARequest.AcceptEncoding is asking for deflate/gzip compression,
  1829. // remove it, unless the caller is prepared to decompress the data manually...
  1830. end;
  1831. {$IFDEF USE_OBJECT_ARC}LCompressor := nil;{$ENDIF}
  1832. // RLebeau 1/10/2015: if AcceptEncoding is blank, DON'T set it to 'identity'!
  1833. // Oddly, some faulty servers do not understand 'identity' when explicitly
  1834. // stated. 'identity' is the default behavior when no "Accept-Encoding" header
  1835. // is present, so just let the server fallback to that normally...
  1836. if ARequest.AcceptEncoding <> '' then begin
  1837. if IndyPos('identity', ARequest.AcceptEncoding) = 0 then begin {do not localize}
  1838. ARequest.AcceptEncoding := ARequest.AcceptEncoding + ', identity'; {do not localize}
  1839. end;
  1840. // TODO: if AcceptEncoding is 'identity', set it to a blank string?
  1841. {
  1842. if TextIsSame(ARequest.AcceptEncoding, 'identity') then begin {do not localize
  1843. ARequest.AcceptEncoding := '';
  1844. end;
  1845. }
  1846. end;
  1847. if LUseConnectVerb then begin
  1848. LLocalHTTP := CreateProtocol;
  1849. try
  1850. LLocalHTTP.Request.UserAgent := ARequest.UserAgent;
  1851. LLocalHTTP.Request.Host := ARequest.Host;
  1852. LLocalHTTP.Request.Pragma := 'no-cache'; {do not localize}
  1853. LLocalHTTP.Request.URL := ARequest.Destination;
  1854. LLocalHTTP.Request.Method := Id_HTTPMethodConnect;
  1855. // TODO: per RFC 7230:
  1856. // "clients are encouraged not to send the Proxy-Connection header field in any requests."
  1857. LLocalHTTP.Request.ProxyConnection := 'keep-alive'; {do not localize}
  1858. LLocalHTTP.Request.FUseProxy := ARequest.UseProxy;
  1859. // leaving LLocalHTTP.Response.ContentStream set to nil so response data is discarded without wasting memory
  1860. try
  1861. repeat
  1862. CheckAndConnect(LLocalHTTP.Request, LLocalHTTP.Response);
  1863. LLocalHTTP.BuildAndSendRequest(nil);
  1864. LLocalHTTP.Response.ResponseText := InternalReadLn;
  1865. if LLocalHTTP.Response.ResponseText = '' then begin
  1866. // Support for HTTP responses without status line and headers
  1867. LLocalHTTP.Response.ResponseText := 'HTTP/1.0 200 OK'; {do not localize}
  1868. LLocalHTTP.Response.Connection := 'close'; {do not localize}
  1869. end else begin
  1870. LLocalHTTP.RetrieveHeaders(MaxHeaderLines);
  1871. ProcessCookies(LLocalHTTP.Request, LLocalHTTP.Response);
  1872. end;
  1873. if (LLocalHTTP.Response.ResponseCode div 100) = 2 then begin
  1874. // Connection established
  1875. if (ARequest.UseProxy = ctSSLProxy) and (IOHandler is TIdSSLIOHandlerSocketBase) then begin
  1876. TIdSSLIOHandlerSocketBase(IOHandler).PassThrough := False;
  1877. end;
  1878. Break;
  1879. end;
  1880. case LLocalHTTP.ProcessResponse([]) of
  1881. wnAuthRequest:
  1882. begin
  1883. LLocalHTTP.Request.URL := ARequest.Destination;
  1884. end;
  1885. wnReadAndGo:
  1886. begin
  1887. ReadResult(LLocalHTTP.Request, LLocalHTTP.Response);
  1888. FAuthRetries := 0;
  1889. FAuthProxyRetries := 0;
  1890. end;
  1891. wnGoToURL:
  1892. begin
  1893. FAuthRetries := 0;
  1894. FAuthProxyRetries := 0;
  1895. end;
  1896. wnJustExit:
  1897. begin
  1898. Break;
  1899. end;
  1900. wnDontKnow:
  1901. begin
  1902. raise EIdException.Create(RSHTTPNotAcceptable); // TODO: create a new Exception class for this
  1903. end;
  1904. end;
  1905. until False;
  1906. except
  1907. raise;
  1908. // TODO: Add property that will contain the error messages.
  1909. end;
  1910. finally
  1911. LLocalHTTP.Free;
  1912. end;
  1913. end else begin
  1914. CheckAndConnect(ARequest, AResponse);
  1915. end;
  1916. FHTTPProto.BuildAndSendRequest(URL);
  1917. // RLebeau 1/31/2008: in order for TIdWebDAV to post data correctly, don't
  1918. // restrict which HTTP methods can post (except logically for GET and HEAD),
  1919. // especially since TIdCustomHTTP.PrepareRequest() does not differentiate when
  1920. // setting up the 'Content-Length' header ...
  1921. // TODO: when sending an HTTP 1.1 request with an 'Expect: 100-continue' header,
  1922. // do not send the Source data until the server replies with a 100 response code,
  1923. // or until a timeout occurs if the server does not send a 100...
  1924. if ARequest.Source <> nil then begin
  1925. IOHandler.Write(ARequest.Source, 0, False);
  1926. end;
  1927. end;
  1928. procedure TIdCustomHTTP.SetAllowCookies(AValue: Boolean);
  1929. begin
  1930. FAllowCookies := AValue;
  1931. end;
  1932. procedure TIdCustomHTTP.ProcessCookies(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse);
  1933. var
  1934. LCookies: TStringList;
  1935. // under ARC, convert a weak reference to a strong reference before working with it
  1936. LCookieManager: TIdCookieManager;
  1937. begin
  1938. LCookieManager := FCookieManager;
  1939. if (not Assigned(LCookieManager)) and AllowCookies then begin
  1940. LCookieManager := TIdCookieManager.Create(Self);
  1941. SetCookieManager(LCookieManager);
  1942. end;
  1943. if Assigned(LCookieManager) and AllowCookies then begin
  1944. LCookies := TStringList.Create;
  1945. try
  1946. AResponse.RawHeaders.Extract('Set-Cookie', LCookies); {do not localize}
  1947. AResponse.MetaHTTPEquiv.RawHeaders.Extract('Set-Cookie', LCookies); {do not localize}
  1948. LCookieManager.AddServerCookies(LCookies, FURI);
  1949. finally
  1950. LCookies.Free;
  1951. end;
  1952. end;
  1953. end;
  1954. // under ARC, all weak references to a freed object get nil'ed automatically
  1955. {$IFDEF USE_OBJECT_REF_FREENOTIF}
  1956. procedure TIdCustomHTTP.Notification(AComponent: TComponent; Operation: TOperation);
  1957. begin
  1958. if Operation = opRemove then begin
  1959. if (AComponent = FCookieManager) then begin
  1960. FCookieManager := nil;
  1961. end
  1962. else if (AComponent = FAuthenticationManager) then begin
  1963. FAuthenticationManager := nil;
  1964. end
  1965. else if (AComponent = FCompressor) then begin
  1966. FCompressor := nil;
  1967. end;
  1968. end;
  1969. inherited Notification(AComponent, Operation);
  1970. end;
  1971. {$ENDIF}
  1972. procedure TIdCustomHTTP.SetCookieManager(ACookieManager: TIdCookieManager);
  1973. var
  1974. // under ARC, convert a weak reference to a strong reference before working with it
  1975. LCookieManager: TIdCookieManager;
  1976. begin
  1977. LCookieManager := FCookieManager;
  1978. if LCookieManager <> ACookieManager then begin
  1979. // under ARC, all weak references to a freed object get nil'ed automatically
  1980. if Assigned(LCookieManager) then begin
  1981. if LCookieManager.Owner = Self then begin
  1982. FCookieManager := nil;
  1983. IdDisposeAndNil(LCookieManager);
  1984. end
  1985. {$IFDEF USE_OBJECT_REF_FREENOTIF}
  1986. else begin
  1987. LCookieManager.RemoveFreeNotification(Self);
  1988. end
  1989. {$ENDIF}
  1990. ;
  1991. end;
  1992. FCookieManager := ACookieManager;
  1993. {$IFDEF USE_OBJECT_REF_FREENOTIF}
  1994. if Assigned(ACookieManager) then begin
  1995. ACookieManager.FreeNotification(Self);
  1996. end;
  1997. {$ENDIF}
  1998. end;
  1999. end;
  2000. function TIdCustomHTTP.DoOnAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean;
  2001. var
  2002. i: Integer;
  2003. S: string;
  2004. LAuthCls: TIdAuthenticationClass;
  2005. LAuth: TIdAuthentication;
  2006. begin
  2007. Inc(FAuthRetries);
  2008. // TODO: trigger OnSelectAuthorization on every request, or at least if
  2009. // FAuthRetries is 1, or the server has sent a new 'WWW-Authenticate'
  2010. // list that does not include the class currently assigned...
  2011. if not Assigned(ARequest.Authentication) then begin
  2012. // Find wich Authentication method is supported from us.
  2013. LAuthCls := nil;
  2014. for i := 0 to AResponse.WWWAuthenticate.Count - 1 do begin
  2015. S := AResponse.WWWAuthenticate[i];
  2016. LAuthCls := FindAuthClass(Fetch(S));
  2017. if Assigned(LAuthCls) then begin
  2018. Break;
  2019. end;
  2020. end;
  2021. // let the user override us, if desired.
  2022. if Assigned(FOnSelectAuthorization) then begin
  2023. OnSelectAuthorization(Self, LAuthCls, AResponse.WWWAuthenticate);
  2024. end;
  2025. if not Assigned(LAuthCls) then begin
  2026. Result := False;
  2027. Exit;
  2028. end;
  2029. ARequest.Authentication := LAuthCls.Create;
  2030. end;
  2031. {
  2032. this is commented out as it breaks SSPI and NTLM authentication. it is
  2033. normal and expected to get multiple 407 responses during negotiation.
  2034. // Clear password and reset autorization if previous failed
  2035. if (AResponse.FResponseCode = 401) then begin
  2036. ARequest.Password := '';
  2037. ARequest.Authentication.Reset;
  2038. end;
  2039. }
  2040. // S.G. 20/10/2003: Added part about the password. Not testing user name as some
  2041. // S.G. 20/10/2003: web sites do not require user name, only password.
  2042. //
  2043. // RLebeau 11/18/2014: what about SSPI? It does not require an explicit
  2044. // username/password as it can use the identity of the user token associated
  2045. // with the calling thread!
  2046. LAuth := ARequest.Authentication;
  2047. LAuth.Username := ARequest.Username;
  2048. LAuth.Password := ARequest.Password;
  2049. // 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
  2050. // S.G. 20/10/2003: if they are picked up from properties.
  2051. LAuth.Params.Values['Authorization'] := ARequest.Authentication.Authentication; {do not localize}
  2052. LAuth.AuthParams := AResponse.WWWAuthenticate;
  2053. Result := False;
  2054. repeat
  2055. case LAuth.Next of
  2056. wnAskTheProgram:
  2057. begin // Ask the user porgram to supply us with authorization information
  2058. if not Assigned(FOnAuthorization) then
  2059. begin
  2060. Result := False;
  2061. Break;
  2062. end;
  2063. LAuth.UserName := ARequest.Username;
  2064. LAuth.Password := ARequest.Password;
  2065. OnAuthorization(Self, LAuth, Result);
  2066. if not Result then begin
  2067. Break;
  2068. end;
  2069. ARequest.BasicAuthentication := True;
  2070. ARequest.Username := LAuth.UserName;
  2071. ARequest.Password := LAuth.Password;
  2072. end;
  2073. wnDoRequest:
  2074. begin
  2075. Result := True;
  2076. Break;
  2077. end;
  2078. wnFail:
  2079. begin
  2080. Result := False;
  2081. Break;
  2082. end;
  2083. end;
  2084. until False;
  2085. end;
  2086. function TIdCustomHTTP.DoOnProxyAuthorization(ARequest: TIdHTTPRequest; AResponse: TIdHTTPResponse): Boolean;
  2087. var
  2088. i: Integer;
  2089. S: string;
  2090. LAuthCls: TIdAuthenticationClass;
  2091. LAuth: TIdAuthentication;
  2092. begin
  2093. Inc(FAuthProxyRetries);
  2094. // TODO: trigger OnSelectProxyAuthorization on every request, or at least if
  2095. // FAuthProxyRetries is 1, or the server has sent a new 'Proxy-Authenticate'
  2096. // list that does not include the class currently assigned...
  2097. if not Assigned(ProxyParams.Authentication) then begin
  2098. // Find which Authentication method is supported from us.
  2099. LAuthCls := nil;
  2100. for i := 0 to AResponse.ProxyAuthenticate.Count-1 do begin
  2101. S := AResponse.ProxyAuthenticate[i];
  2102. LAuthCls := FindAuthClass(Fetch(S));
  2103. if Assigned(LAuthCls) then begin
  2104. Break;
  2105. end;
  2106. end;
  2107. // let the user override us, if desired.
  2108. if Assigned(FOnSelectProxyAuthorization) then begin
  2109. OnSelectProxyAuthorization(Self, LAuthCls, AResponse.ProxyAuthenticate);
  2110. end;
  2111. if not Assigned(LAuthCls) then begin
  2112. Result := False;
  2113. Exit;
  2114. end;
  2115. ProxyParams.Authentication := LAuthCls.Create;
  2116. end;
  2117. {
  2118. this is commented out as it breaks SSPI and NTLM authentication. it is
  2119. normal and expected to get multiple 407 responses during negotiation.
  2120. // Clear password and reset authorization if previous failed
  2121. if (AResponse.FResponseCode = 407) then begin
  2122. ProxyParams.ProxyPassword := '';
  2123. ProxyParams.Authentication.Reset;
  2124. end;
  2125. }
  2126. // RLebeau 11/18/2014: Added part about the password. Not testing user name
  2127. // as some proxies do not require user name, only password.
  2128. //
  2129. // RLebeau 11/18/2014: what about SSPI? It does not require an explicit
  2130. // username/password as it can use the identity of the user token associated
  2131. // with the calling thread!
  2132. LAuth := ProxyParams.Authentication;
  2133. LAuth.Username := ProxyParams.ProxyUsername;
  2134. LAuth.Password := ProxyParams.ProxyPassword;
  2135. // TODO: do we need to set this, like DoOnAuthorization does?
  2136. //LAuth.Params.Values['Authorization'] := ProxyParams.Authentication; {do not localize}
  2137. LAuth.AuthParams := AResponse.ProxyAuthenticate;
  2138. Result := False;
  2139. repeat
  2140. case LAuth.Next of
  2141. wnAskTheProgram: // Ask the user porgram to supply us with authorization information
  2142. begin
  2143. if not Assigned(OnProxyAuthorization) then begin
  2144. Result := False;
  2145. Break;
  2146. end;
  2147. LAuth.Username := ProxyParams.ProxyUsername;
  2148. LAuth.Password := ProxyParams.ProxyPassword;
  2149. OnProxyAuthorization(Self, LAuth, Result);
  2150. if not Result then begin
  2151. Break;
  2152. end;
  2153. // TODO: do we need to set this, like DoOnAuthorization does?
  2154. //ProxyParams.BasicAuthentication := True;
  2155. ProxyParams.ProxyUsername := LAuth.Username;
  2156. ProxyParams.ProxyPassword := LAuth.Password;
  2157. end;
  2158. wnDoRequest:
  2159. begin
  2160. Result := True;
  2161. Break;
  2162. end;
  2163. wnFail:
  2164. begin
  2165. Result := False;
  2166. Break;
  2167. end;
  2168. end;
  2169. until False;
  2170. end;
  2171. function TIdCustomHTTP.GetResponseCode: Integer;
  2172. begin
  2173. Result := Response.ResponseCode;
  2174. end;
  2175. function TIdCustomHTTP.GetResponseText: string;
  2176. begin
  2177. Result := Response.ResponseText;
  2178. end;
  2179. function TIdCustomHTTP.GetResponse: TIdHTTPResponse;
  2180. begin
  2181. Result := FHTTPProto.Response;
  2182. end;
  2183. function TIdCustomHTTP.GetRequest: TIdHTTPRequest;
  2184. begin
  2185. Result := FHTTPProto.Request;
  2186. end;
  2187. function TIdCustomHTTP.GetMetaHTTPEquiv: TIdMetaHTTPEquiv;
  2188. begin
  2189. Result := Response.MetaHTTPEquiv;
  2190. end;
  2191. procedure TIdCustomHTTP.DoOnDisconnected;
  2192. var
  2193. // under ARC, convert weak references to strong references before working with them
  2194. LAuthManager: TIdAuthenticationManager;
  2195. LAuth: TIdAuthentication;
  2196. begin
  2197. // TODO: in order to handle the case where authentications are used when
  2198. // keep-alives are in effect, move this logic somewhere more appropriate,
  2199. // like at the end of DoRequest()...
  2200. inherited DoOnDisconnected;
  2201. LAuth := Request.Authentication;
  2202. if Assigned(LAuth) and (LAuth.CurrentStep = LAuth.Steps) then
  2203. begin
  2204. LAuthManager := AuthenticationManager;
  2205. if Assigned(LAuthManager) then begin
  2206. LAuthManager.AddAuthentication(LAuth, URL);
  2207. end;
  2208. {$IFNDEF USE_OBJECT_ARC}
  2209. LAuth.Free;
  2210. {$ENDIF}
  2211. Request.Authentication := nil;
  2212. end;
  2213. LAuth := ProxyParams.Authentication;
  2214. if Assigned(LAuth) and (LAuth.CurrentStep = LAuth.Steps) then begin
  2215. LAuth.Reset;
  2216. end;
  2217. end;
  2218. // under ARC, all weak references to a freed object get nil'ed automatically
  2219. {$IFDEF USE_OBJECT_REF_FREENOTIF}
  2220. procedure TIdCustomHTTP.SetAuthenticationManager(Value: TIdAuthenticationManager);
  2221. begin
  2222. if FAuthenticationManager <> Value then begin
  2223. if Assigned(FAuthenticationManager) then begin
  2224. FAuthenticationManager.RemoveFreeNotification(self);
  2225. end;
  2226. FAuthenticationManager := Value;
  2227. if Assigned(FAuthenticationManager) then begin
  2228. FAuthenticationManager.FreeNotification(Self);
  2229. end;
  2230. end;
  2231. end;
  2232. {$ENDIF}
  2233. {
  2234. procedure TIdCustomHTTP.SetHost(const Value: string);
  2235. begin
  2236. inherited SetHost(Value);
  2237. URL.Host := Value;
  2238. end;
  2239. procedure TIdCustomHTTP.SetPort(const Value: integer);
  2240. begin
  2241. inherited SetPort(Value);
  2242. URL.Port := IntToStr(Value);
  2243. end;
  2244. }
  2245. procedure TIdCustomHTTP.SetRequest(Value: TIdHTTPRequest);
  2246. begin
  2247. FHTTPProto.Request.Assign(Value);
  2248. end;
  2249. procedure TIdCustomHTTP.SetProxyParams(AValue: TIdProxyConnectionInfo);
  2250. begin
  2251. FProxyParameters.Assign(AValue);
  2252. end;
  2253. procedure TIdCustomHTTP.Post(AURL: string; ASource: TIdMultiPartFormDataStream;
  2254. AResponseContent: TStream);
  2255. begin
  2256. Assert(ASource<>nil);
  2257. Request.ContentType := ASource.RequestContentType;
  2258. // TODO: Request.CharSet := ASource.RequestCharSet;
  2259. Post(AURL, TStream(ASource), AResponseContent);
  2260. end;
  2261. function TIdCustomHTTP.Post(AURL: string; ASource: TIdMultiPartFormDataStream): string;
  2262. begin
  2263. Assert(ASource<>nil);
  2264. Request.ContentType := ASource.RequestContentType;
  2265. // TODO: Request.CharSet := ASource.RequestCharSet;
  2266. Result := Post(AURL, TStream(ASource));
  2267. end;
  2268. { TIdHTTPResponse }
  2269. constructor TIdHTTPResponse.Create(AHTTP: TIdCustomHTTP);
  2270. begin
  2271. inherited Create(AHTTP);
  2272. FHTTP := AHTTP;
  2273. FResponseCode := -1;
  2274. FMetaHTTPEquiv := TIdMetaHTTPEquiv.Create(AHTTP);
  2275. end;
  2276. destructor TIdHTTPResponse.Destroy;
  2277. begin
  2278. FMetaHTTPEquiv.Free;
  2279. inherited Destroy;
  2280. end;
  2281. procedure TIdHTTPResponse.Clear;
  2282. begin
  2283. inherited Clear;
  2284. ResponseText := '';
  2285. FMetaHTTPEquiv.Clear;
  2286. end;
  2287. procedure TIdHTTPResponse.ProcessMetaHTTPEquiv;
  2288. var
  2289. StdValues: TStringList;
  2290. I: Integer;
  2291. Name: String;
  2292. begin
  2293. FMetaHTTPEquiv.ProcessMetaHTTPEquiv(ContentStream);
  2294. if FMetaHTTPEquiv.RawHeaders.Count > 0 then begin
  2295. // TODO: optimize this
  2296. StdValues := TStringList.Create;
  2297. try
  2298. FMetaHTTPEquiv.RawHeaders.ConvertToStdValues(StdValues);
  2299. for I := 0 to StdValues.Count-1 do begin
  2300. Name := StdValues.Names[I];
  2301. if Name <> '' then begin
  2302. RawHeaders.Values[Name] := IndyValueFromIndex(StdValues, I);
  2303. end;
  2304. end;
  2305. finally
  2306. StdValues.Free;
  2307. end;
  2308. ProcessHeaders;
  2309. end;
  2310. if FMetaHTTPEquiv.CharSet <> '' then begin
  2311. FCharSet := FMetaHTTPEquiv.CharSet;
  2312. end;
  2313. end;
  2314. function TIdHTTPResponse.GetKeepAlive: Boolean;
  2315. begin
  2316. if FHTTP.Connected then begin
  2317. FHTTP.IOHandler.CheckForDisconnect(False);
  2318. end;
  2319. // has the connection already been closed?
  2320. FKeepAlive := FHTTP.Connected;
  2321. if FKeepAlive then
  2322. begin
  2323. // did the client request the connection to be closed?
  2324. FKeepAlive := not TextIsSame(Trim(FHTTP.Request.Connection), 'CLOSE'); {do not localize}
  2325. if FKeepAlive and (FHTTP.Request.UseProxy in [ctProxy, ctSSLProxy]) then begin
  2326. FKeepAlive := not TextIsSame(Trim(FHTTP.Request.ProxyConnection), 'CLOSE'); {do not localize}
  2327. end;
  2328. end;
  2329. if FKeepAlive then
  2330. begin
  2331. // did the server/proxy say the connection will be closed?
  2332. case FHTTP.ProtocolVersion of // TODO: use ResponseVersion instead?
  2333. pv1_1:
  2334. { By default we assume that keep-alive is used and will close
  2335. the connection only if there is "close" }
  2336. begin
  2337. FKeepAlive := not TextIsSame(Trim(Connection), 'CLOSE'); {do not localize}
  2338. if FKeepAlive and (FHTTP.Request.UseProxy in [ctProxy, ctSSLProxy]) then begin
  2339. FKeepAlive := not TextIsSame(Trim(ProxyConnection), 'CLOSE'); {do not localize}
  2340. end;
  2341. end;
  2342. pv1_0:
  2343. { By default we assume that keep-alive is not used and will keep
  2344. the connection only if there is "keep-alive" }
  2345. begin
  2346. FKeepAlive := TextIsSame(Trim(Connection), 'KEEP-ALIVE') {do not localize}
  2347. { or ((ResponseVersion = pv1_1) and (Trim(Connection) = '')) }
  2348. ;
  2349. if FKeepAlive and (FHTTP.Request.UseProxy in [ctProxy, ctSSLProxy]) then begin
  2350. FKeepAlive := TextIsSame(Trim(ProxyConnection), 'KEEP-ALIVE') {do not localize}
  2351. { or ((ResponseVersion = pv1_1) and (Trim(ProxyConnection) = '')) }
  2352. ;
  2353. end;
  2354. end;
  2355. end;
  2356. end;
  2357. Result := FKeepAlive;
  2358. end;
  2359. function TIdHTTPResponse.GetResponseCode: Integer;
  2360. var
  2361. S, Tmp: string;
  2362. begin
  2363. if FResponseCode = -1 then
  2364. begin
  2365. S := FResponseText;
  2366. Fetch(S);
  2367. S := Trim(S);
  2368. // RLebeau: IIS supports status codes with decimals in them, but it is not supposed to
  2369. // transmit them to clients, which is a violation of RFC 2616. But have seen it happen,
  2370. // so check for it...
  2371. Tmp := Fetch(S, ' ', False); {do not localize}
  2372. S := Fetch(Tmp, '.', False); {do not localize}
  2373. FResponseCode := IndyStrToInt(S, -1);
  2374. end;
  2375. Result := FResponseCode;
  2376. end;
  2377. procedure TIdHTTPResponse.SetResponseText(const AValue: String);
  2378. var
  2379. S: String;
  2380. i: TIdHTTPProtocolVersion;
  2381. begin
  2382. FResponseText := AValue;
  2383. FResponseCode := -1; // re-parse the next time it is accessed
  2384. FResponseVersion := pv1_0; // default until determined otherwise...
  2385. S := Copy(FResponseText, 6, 3);
  2386. for i := Low(TIdHTTPProtocolVersion) to High(TIdHTTPProtocolVersion) do begin
  2387. if TextIsSame(ProtocolVersionString[i], S) then begin
  2388. FResponseVersion := i;
  2389. Exit;
  2390. end;
  2391. end;
  2392. end;
  2393. { TIdHTTPRequest }
  2394. constructor TIdHTTPRequest.Create(AHTTP: TIdCustomHTTP);
  2395. begin
  2396. inherited Create(AHTTP);
  2397. FHTTP := AHTTP;
  2398. FUseProxy := ctNormal;
  2399. FIPVersion := ID_DEFAULT_IP_VERSION;
  2400. end;
  2401. { TIdHTTPProtocol }
  2402. constructor TIdHTTPProtocol.Create(AConnection: TIdCustomHTTP);
  2403. begin
  2404. inherited Create;
  2405. FHTTP := AConnection;
  2406. // Create the headers
  2407. FRequest := TIdHTTPRequest.Create(FHTTP);
  2408. FResponse := TIdHTTPResponse.Create(FHTTP);
  2409. end;
  2410. destructor TIdHTTPProtocol.Destroy;
  2411. begin
  2412. FRequest.Free;
  2413. FResponse.Free;
  2414. inherited Destroy;
  2415. end;
  2416. procedure TIdHTTPProtocol.BuildAndSendRequest(AURI: TIdURI);
  2417. var
  2418. i: Integer;
  2419. LBufferingStarted: Boolean;
  2420. begin
  2421. Response.Clear;
  2422. // needed for Digest authentication, but maybe others as well...
  2423. if Assigned(Request.Authentication) then begin
  2424. // TODO: include entity body for Digest "auth-int" qop...
  2425. Request.Authentication.SetRequest(Request.Method, Request.URL);
  2426. end;
  2427. // TODO: disable header folding for HTTP 1.0 requests
  2428. Request.SetHeaders;
  2429. FHTTP.ProxyParams.SetHeaders(Request.RawHeaders);
  2430. if Assigned(AURI) then begin
  2431. FHTTP.SetCookies(AURI, Request);
  2432. end;
  2433. // This is a workaround for some HTTP servers which do not implement
  2434. // the HTTP protocol properly
  2435. LBufferingStarted := not FHTTP.IOHandler.WriteBufferingActive;
  2436. if LBufferingStarted then begin
  2437. FHTTP.IOHandler.WriteBufferOpen;
  2438. end;
  2439. try
  2440. FHTTP.IOHandler.WriteLn(Request.Method + ' ' + Request.URL + ' HTTP/' + ProtocolVersionString[FHTTP.ProtocolVersion]); {do not localize}
  2441. // write the headers
  2442. for i := 0 to Request.RawHeaders.Count - 1 do begin
  2443. if Request.RawHeaders.Strings[i] <> '' then begin
  2444. FHTTP.IOHandler.WriteLn(Request.RawHeaders.Strings[i]);
  2445. end;
  2446. end;
  2447. FHTTP.IOHandler.WriteLn;
  2448. if LBufferingStarted then begin
  2449. FHTTP.IOHandler.WriteBufferClose;
  2450. end;
  2451. except
  2452. if LBufferingStarted then begin
  2453. FHTTP.IOHandler.WriteBufferCancel;
  2454. end;
  2455. raise;
  2456. end;
  2457. end;
  2458. procedure TIdHTTPProtocol.RetrieveHeaders(AMaxHeaderCount: integer);
  2459. var
  2460. s: string;
  2461. LHeaderCount: Integer;
  2462. begin
  2463. // Set the response headers
  2464. // Don't use Capture.
  2465. // S.G. 6/4/2004: Added AmaxHeaderCount parameter to prevent the "header bombing" of the server
  2466. s := FHTTP.InternalReadLn;
  2467. try
  2468. LHeaderCount := 0;
  2469. while (s <> '') and ( (AMaxHeaderCount > 0) or (LHeaderCount < AMaxHeaderCount) ) do
  2470. begin
  2471. Response.RawHeaders.Add(S);
  2472. s := FHTTP.InternalReadLn;
  2473. Inc(LHeaderCount);
  2474. end;
  2475. except
  2476. on E: Exception do begin
  2477. FHTTP.Disconnect;
  2478. if not (E is EIdConnClosedGracefully) then begin
  2479. raise;
  2480. end;
  2481. end;
  2482. end;
  2483. Response.ProcessHeaders;
  2484. end;
  2485. function TIdHTTPProtocol.ProcessResponse(const AIgnoreReplies: array of Int16): TIdHTTPWhatsNext;
  2486. var
  2487. LResponseCode, LResponseDigit: Integer;
  2488. procedure CheckException;
  2489. var
  2490. i: Integer;
  2491. LTempStream: TMemoryStream;
  2492. LOrigStream: TStream;
  2493. LRaiseException: Boolean;
  2494. LDiscardContent: Boolean;
  2495. begin
  2496. LRaiseException := True;
  2497. LDiscardContent := True;
  2498. if hoNoProtocolErrorException in FHTTP.HTTPOptions then begin
  2499. LRaiseException := False;
  2500. LDiscardContent := not (hoWantProtocolErrorContent in FHTTP.HTTPOptions);
  2501. end
  2502. else if High(AIgnoreReplies) > -1 then begin
  2503. for i := Low(AIgnoreReplies) to High(AIgnoreReplies) do begin
  2504. if LResponseCode = AIgnoreReplies[i] then begin
  2505. LRaiseException := False;
  2506. LDiscardContent := not (hoWantProtocolErrorContent in FHTTP.HTTPOptions);
  2507. Break;
  2508. end;
  2509. end;
  2510. end;
  2511. if LRaiseException then begin
  2512. LTempStream := TMemoryStream.Create;
  2513. end else begin
  2514. LTempStream := nil;
  2515. end;
  2516. try
  2517. if LRaiseException or LDiscardContent then begin
  2518. LOrigStream := Response.ContentStream;
  2519. Response.ContentStream := LTempStream;
  2520. end else begin
  2521. LOrigStream := nil;
  2522. end;
  2523. try
  2524. try
  2525. FHTTP.ReadResult(Request, Response);
  2526. except
  2527. on E: Exception do begin
  2528. FHTTP.Disconnect;
  2529. if not (E is EIdConnClosedGracefully) then begin
  2530. raise;
  2531. end;
  2532. end;
  2533. end;
  2534. if LRaiseException then begin
  2535. LTempStream.Position := 0;
  2536. raise EIdHTTPProtocolException.CreateError(LResponseCode, Response.ResponseText,
  2537. ReadStringAsCharset(LTempStream, Response.CharSet));
  2538. end;
  2539. finally
  2540. if LRaiseException or LDiscardContent then begin
  2541. Response.ContentStream := LOrigStream;
  2542. end;
  2543. end;
  2544. finally
  2545. if LRaiseException then begin
  2546. LTempStream.Free;
  2547. end;
  2548. end;
  2549. end;
  2550. procedure DiscardContent;
  2551. var
  2552. LOrigStream: TStream;
  2553. begin
  2554. LOrigStream := Response.ContentStream;
  2555. Response.ContentStream := nil;
  2556. try
  2557. try
  2558. FHTTP.ReadResult(Request, Response);
  2559. except
  2560. on E: Exception do begin
  2561. FHTTP.Disconnect;
  2562. if not (E is EIdConnClosedGracefully) then begin
  2563. raise;
  2564. end;
  2565. end;
  2566. end;
  2567. finally
  2568. Response.ContentStream := LOrigStream;
  2569. end;
  2570. end;
  2571. function HeadersCanContinue: Boolean;
  2572. begin
  2573. Result := True;
  2574. if Assigned(FHTTP.OnHeadersAvailable) then begin
  2575. FHTTP.OnHeadersAvailable(FHTTP, Response.RawHeaders, Result);
  2576. end;
  2577. end;
  2578. var
  2579. LLocation: string;
  2580. LMethod: TIdHTTPMethod;
  2581. LNeedAuth: Boolean;
  2582. //LTemp: Integer;
  2583. begin
  2584. // provide the user with the headers and let the user decide
  2585. // whether the response processing should continue...
  2586. if not HeadersCanContinue then begin
  2587. // TODO: provide the user an option whether to force DoRequest() to disconnect the connection or not
  2588. Response.KeepAlive := False;
  2589. Response.Connection := 'close'; {do not localize}
  2590. Result := wnJustExit;
  2591. Exit;
  2592. end;
  2593. // Cache this as ResponseCode calls GetResponseCode which parses it out
  2594. LResponseCode := Response.ResponseCode;
  2595. LResponseDigit := LResponseCode div 100;
  2596. LNeedAuth := False;
  2597. // Handle Redirects
  2598. // RLebeau: All 3xx replies other than 304 are redirects. Reply 201 has a
  2599. // Location header but is NOT a redirect!
  2600. // RLebeau 4/21/2011: Amazon S3 includes a Location header in its 200 reply
  2601. // to some PUT requests. Not sure if this is a bug or intentional, but we
  2602. // should NOT perform a redirect for any replies other than 3xx. Amazon S3
  2603. // does NOT include a Location header in its 301 reply, though! This is
  2604. // intentional, per Amazon's documentation, as a way for developers to
  2605. // detect when URLs are addressed incorrectly...
  2606. if (LResponseDigit = 3) and (LResponseCode <> 304) then
  2607. begin
  2608. if Response.Location = '' then begin
  2609. CheckException;
  2610. Result := wnJustExit;
  2611. Exit;
  2612. end;
  2613. Inc(FHTTP.FRedirectCount);
  2614. // LLocation := TIdURI.URLDecode(Response.Location);
  2615. LLocation := Response.Location;
  2616. LMethod := Request.Method;
  2617. // fire the event
  2618. if not FHTTP.DoOnRedirect(LLocation, LMethod, FHTTP.FRedirectCount) then begin
  2619. CheckException;
  2620. Result := wnJustExit;
  2621. Exit;
  2622. end;
  2623. if (FHTTP.FHandleRedirects) and (FHTTP.FRedirectCount < FHTTP.FRedirectMax) then begin
  2624. Result := wnGoToURL;
  2625. Request.URL := LLocation;
  2626. // GDG 21/11/2003. If it's a 303, we should do a get this time
  2627. // RLebeau 7/15/2004 - do a GET on 302 as well, as mentioned in RFC 2616
  2628. // RLebeau 1/11/2008 - turns out both situations are WRONG! RFCs 2068 and
  2629. // 2616 specifically state that changing the method to GET in response
  2630. // to 302 and 303 is errorneous. Indy 9 did it right by reusing the
  2631. // original method and source again and only changing the URL, so lets
  2632. // revert back to that same behavior!
  2633. // RLebeau 12/28/2012 - one more time. RFCs 2068 and 2616 actually say that
  2634. // changing the method in response to 302 is erroneous, but changing the
  2635. // method to GET in response to 303 is intentional and why 303 was introduced
  2636. // in the first place. Erroneous clients treat 302 as 303, though. Now
  2637. // encountering servers that actually expect this 303 behavior, so we have
  2638. // to enable it again! Adding an optional HTTPOption flag so clients can
  2639. // enable the erroneous 302 behavior if they really need it.
  2640. if ((LResponseCode = 302) and (hoTreat302Like303 in FHTTP.HTTPOptions)) or
  2641. (LResponseCode = 303) then
  2642. begin
  2643. Request.Source := nil;
  2644. Request.Method := Id_HTTPMethodGet;
  2645. // TODO: if the previous request was a POST with an 'application/x-www-webform-urlencoded'
  2646. // body, move the body data into the URL query string this time...
  2647. end else begin
  2648. Request.Method := LMethod;
  2649. end;
  2650. Request.MethodOverride := '';
  2651. end else begin
  2652. Result := wnJustExit;
  2653. Response.Location := LLocation;
  2654. end;
  2655. if FHTTP.Connected then begin
  2656. // This is a workaround for buggy HTTP 1.1 servers which
  2657. // does not return any body with 302 response code
  2658. DiscardContent; // may wait a few seconds for any kind of content
  2659. end;
  2660. end else begin
  2661. //Ciaran, 30th Nov 2004: I commented out the following code. When a https server
  2662. //sends a disconnect immediately after sending the requested page in an SSL
  2663. //session (which they sometimes do to indicate a "session" is finished), the code
  2664. //below causes a "Connection closed gracefully" exception BUT the returned page
  2665. //is lost (IOHandler.Request is empty). If the code below is re-enabled by
  2666. //someone for whatever reason, they MUST test for this case.
  2667. // GREGOR Workaround
  2668. // if we get an error we disconnect if we use SSLIOHandler
  2669. //if Assigned(FHTTP.IOHandler) then
  2670. //begin
  2671. // Response.KeepAlive := not (FHTTP.Connected and (FHTTP.IOHandler is TIdSSLIOHandlerSocketBase) and Response.KeepAlive);
  2672. //end;
  2673. // RLebeau 2/15/2006: RFC 1945 states the following:
  2674. //
  2675. // For response messages, whether or not an entity body is included with
  2676. // a message is dependent on both the request method and the response
  2677. // code. All responses to the HEAD request method must not include a
  2678. // body, even though the presence of entity header fields may lead one
  2679. // to believe they do. All 1xx (informational), 204 (no content), and
  2680. // 304 (not modified) responses must not include a body. All other
  2681. // responses must include an entity body or a Content-Length header
  2682. // field defined with a value of zero (0).
  2683. if LResponseDigit <> 2 then begin
  2684. case LResponseCode of
  2685. 101:
  2686. begin
  2687. Response.KeepAlive := True;
  2688. Result := wnJustExit;
  2689. Exit;
  2690. end;
  2691. 401:
  2692. begin // HTTP Server authorization required
  2693. if (FHTTP.AuthRetries >= FHTTP.MaxAuthRetries) or
  2694. (not FHTTP.DoOnAuthorization(Request, Response)) then begin
  2695. if Assigned(Request.Authentication) then begin
  2696. Request.Authentication.Reset;
  2697. end;
  2698. CheckException;
  2699. Result := wnJustExit;
  2700. Exit;
  2701. end else begin
  2702. LNeedAuth := hoInProcessAuth in FHTTP.HTTPOptions;
  2703. end;
  2704. end;
  2705. 407:
  2706. begin // Proxy Server authorization requered
  2707. if (FHTTP.AuthProxyRetries >= FHTTP.MaxAuthRetries) or
  2708. (not FHTTP.DoOnProxyAuthorization(Request, Response)) then
  2709. begin
  2710. if Assigned(FHTTP.ProxyParams.Authentication) then begin
  2711. FHTTP.ProxyParams.Authentication.Reset;
  2712. end;
  2713. CheckException;
  2714. Result := wnJustExit;
  2715. Exit;
  2716. end else begin
  2717. LNeedAuth := hoInProcessAuth in FHTTP.HTTPOptions;
  2718. end;
  2719. end;
  2720. else begin
  2721. CheckException;
  2722. Result := wnJustExit;
  2723. Exit;
  2724. end;
  2725. end;
  2726. end;
  2727. if LNeedAuth then begin
  2728. // discard the content of Error message
  2729. DiscardContent;
  2730. Result := wnAuthRequest;
  2731. end else
  2732. begin
  2733. // RLebeau 6/30/2006: DO NOT READ IF THE REQUEST IS HEAD!!!
  2734. // The server is supposed to send a 'Content-Length' header
  2735. // without sending the actual data...
  2736. if TextIsSame(Request.Method, Id_HTTPMethodHead) or
  2737. TextIsSame(Request.MethodOverride, Id_HTTPMethodHead) or
  2738. (LResponseCode = 204) then
  2739. begin
  2740. // Have noticed one case where a non-conforming server did send an
  2741. // entity body in response to a HEAD request. If requested, ignore
  2742. // anything the server may send by accident
  2743. DiscardContent;
  2744. end else begin
  2745. FHTTP.ReadResult(Request, Response);
  2746. end;
  2747. Result := wnJustExit;
  2748. end;
  2749. end;
  2750. end;
  2751. function TIdCustomHTTP.CreateProtocol: TIdHTTPProtocol;
  2752. begin
  2753. Result := TIdHTTPProtocol.Create(Self);
  2754. end;
  2755. constructor TIdCustomHTTP.Create(AOwner: TComponent);
  2756. begin
  2757. inherited Create(AOwner);
  2758. FURI := TIdURI.Create('');
  2759. FAuthRetries := 0;
  2760. FAuthProxyRetries := 0;
  2761. AllowCookies := True;
  2762. FOptions := [hoForceEncodeParams];
  2763. FRedirectMax := Id_TIdHTTP_RedirectMax;
  2764. FHandleRedirects := Id_TIdHTTP_HandleRedirects;
  2765. //
  2766. FProtocolVersion := Id_TIdHTTP_ProtocolVersion;
  2767. FHTTPProto := CreateProtocol;
  2768. FProxyParameters := TIdProxyConnectionInfo.Create;
  2769. FProxyParameters.Clear;
  2770. FMaxAuthRetries := Id_TIdHTTP_MaxAuthRetries;
  2771. FMaxHeaderLines := Id_TIdHTTP_MaxHeaderLines;
  2772. end;
  2773. destructor TIdCustomHTTP.Destroy;
  2774. begin
  2775. FHTTPProto.Free;
  2776. FURI.Free;
  2777. FProxyParameters.Free;
  2778. SetCookieManager(nil);
  2779. inherited Destroy;
  2780. end;
  2781. procedure TIdCustomHTTP.CustomRequest(const AMethod: TIdHTTPMethod;
  2782. AURL: string; ASource, AResponseContent: TStream;
  2783. const AIgnoreReplies: array of Int16);
  2784. begin
  2785. DoRequest(AMethod, AURL, ASource, AResponseContent, AIgnoreReplies);
  2786. end;
  2787. function TIdCustomHTTP.InternalReadLn: String;
  2788. begin
  2789. // TODO: add ReadLnTimeoutAction property to TIdIOHandler...
  2790. Result := IOHandler.ReadLn;
  2791. if IOHandler.ReadLnTimedout then begin
  2792. raise EIdReadTimeout.Create(RSReadTimeout);
  2793. end;
  2794. end;
  2795. function TIdCustomHTTP.Get(AURL: string; const AIgnoreReplies: array of Int16): string;
  2796. var
  2797. LStream: TMemoryStream;
  2798. begin
  2799. LStream := TMemoryStream.Create;
  2800. try
  2801. Get(AURL, LStream, AIgnoreReplies);
  2802. LStream.Position := 0;
  2803. Result := ReadStringAsCharset(LStream, Response.Charset);
  2804. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  2805. finally
  2806. LStream.Free;
  2807. end;
  2808. end;
  2809. procedure TIdCustomHTTP.Get(AURL: string; AResponseContent: TStream;
  2810. const AIgnoreReplies: array of Int16);
  2811. begin
  2812. DoRequest(Id_HTTPMethodGet, AURL, nil, AResponseContent, AIgnoreReplies);
  2813. end;
  2814. procedure TIdCustomHTTP.DoRequest(const AMethod: TIdHTTPMethod;
  2815. AURL: string; ASource, AResponseContent: TStream;
  2816. const AIgnoreReplies: array of Int16);
  2817. var
  2818. LResponseLocation: Int64;
  2819. begin
  2820. //reset any counters
  2821. FRedirectCount := 0;
  2822. FAuthRetries := 0;
  2823. FAuthProxyRetries := 0;
  2824. if Assigned(AResponseContent) then begin
  2825. LResponseLocation := AResponseContent.Position;
  2826. end else begin
  2827. LResponseLocation := 0; // Just to avoid the warning message
  2828. end;
  2829. Request.URL := AURL;
  2830. Request.Method := AMethod;
  2831. Request.Source := ASource;
  2832. Response.ContentStream := AResponseContent;
  2833. try
  2834. repeat
  2835. PrepareRequest(Request);
  2836. if IOHandler is TIdSSLIOHandlerSocketBase then begin
  2837. TIdSSLIOHandlerSocketBase(IOHandler).URIToCheck := FURI.URI;
  2838. end;
  2839. ConnectToHost(Request, Response);
  2840. // Workaround for servers which respond with 100 Continue on GET and HEAD
  2841. // This workaround is just for temporary use until we have final HTTP 1.1
  2842. // realisation. HTTP 1.1 is ongoing because of all the buggy and conflicting servers.
  2843. //
  2844. // This is also necessary as servers are allowed to send any number of
  2845. // 1xx informational responses before sending the final response.
  2846. //
  2847. // Except in the case of 101 SWITCHING PROTOCOLS, which is a final response.
  2848. // The protocol on the line is then switched to the requested protocol, per
  2849. // the response's 'Upgrade' header, following the 101 response, so we need to
  2850. // stop and exit immediately if 101 is received, and let the caller handle
  2851. // the new protocol as needed.
  2852. repeat
  2853. Response.ResponseText := InternalReadLn;
  2854. FHTTPProto.RetrieveHeaders(MaxHeaderLines);
  2855. ProcessCookies(Request, Response);
  2856. if ((Response.ResponseCode div 100) <> 1) or (Response.ResponseCode = 101) then begin
  2857. Break;
  2858. end;
  2859. Response.Clear;
  2860. until False;
  2861. case FHTTPProto.ProcessResponse(AIgnoreReplies) of
  2862. wnAuthRequest:
  2863. begin
  2864. Request.URL := AURL;
  2865. end;
  2866. wnReadAndGo:
  2867. begin
  2868. ReadResult(Request, Response);
  2869. if Assigned(AResponseContent) then begin
  2870. AResponseContent.Position := LResponseLocation;
  2871. AResponseContent.Size := LResponseLocation;
  2872. end;
  2873. FAuthRetries := 0;
  2874. FAuthProxyRetries := 0;
  2875. end;
  2876. wnGoToURL:
  2877. begin
  2878. if Assigned(AResponseContent) then begin
  2879. AResponseContent.Position := LResponseLocation;
  2880. AResponseContent.Size := LResponseLocation;
  2881. end;
  2882. FAuthRetries := 0;
  2883. FAuthProxyRetries := 0;
  2884. end;
  2885. wnJustExit:
  2886. begin
  2887. Break;
  2888. end;
  2889. wnDontKnow:
  2890. begin
  2891. raise EIdException.Create(RSHTTPNotAcceptable); // TODO: create a new Exception class for this
  2892. end;
  2893. end;
  2894. until False;
  2895. finally
  2896. if not (
  2897. Response.KeepAlive or
  2898. ((hoNoReadMultipartMIME in FOptions) and IsHeaderMediaType(Response.ContentType, 'multipart')) or {do not localize}
  2899. ((hoNoReadChunked in FOptions) and (IndyPos('chunked', LowerCase(Response.TransferEncoding)) > 0)) {do not localize}
  2900. ) then
  2901. begin
  2902. Disconnect;
  2903. end;
  2904. end;
  2905. end;
  2906. procedure TIdCustomHTTP.Patch(AURL: string; ASource, AResponseContent: TStream);
  2907. begin
  2908. DoRequest(Id_HTTPMethodPatch, AURL, ASource, AResponseContent, []);
  2909. end;
  2910. function TIdCustomHTTP.Patch(AURL: string; ASource: TStream): string;
  2911. var
  2912. LResponse: TMemoryStream;
  2913. begin
  2914. LResponse := TMemoryStream.Create;
  2915. try
  2916. Patch(AURL, ASource, LResponse);
  2917. LResponse.Position := 0;
  2918. Result := ReadStringAsCharset(LResponse, Response.Charset);
  2919. // TODO: if the data is XML, add/update the declared encoding to 'UTF-16LE'...
  2920. finally
  2921. LResponse.Free;
  2922. end;
  2923. end;
  2924. end.