IdHTTP.pas 114 KB

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