Posted By

reboltutorial on 12/11/10


Tagged


Versions (?)

http protocol


 / Published in: R
 

URL: http://rebol.wik.is/Protocols/Http

I've made some changes to the create-request function to allow http PUT and GET with cookie support.

Eg.

read/custom URL [ put %file [ Cookie: "authtoken=foo" ]] will upload a file to URL and also send the cookie header.

read/custom URL [ put "some text" ] will PUT the "some text" to the URL

read/custom URL [ get "" [ Cookie: "authtoken=anotherfoo" ]] will read the page at URL while sending the cookie header.

NB: Rebol2's existing prot-http currently supports this undocumented method using a 'header keyword

read URL [ header [ Cookie: "authtoken=anotherfoo" ]]

read/custom URL reduce [ 'soap payload [soapaction: "" ]] will send the SOAP payload to the URL

Graham

7-Aug-2009

added HEAD support

read/custom URL [ HEAD "" ]

  1. REBOL [
  2. Title: "REBOL Protocols: HTTP"
  3. Version: 2.7.6
  4. Rights: "Copyright REBOL Technologies 2008. All rights reserved."
  5. Home: http://www.rebol.com
  6. Date: 14-Mar-2008
  7.  
  8. ; You are free to use, modify, and distribute this file as long as the
  9. ; above header, copyright, and this entire comment remains intact.
  10. ; This software is provided "as is" without warranties of any kind.
  11. ; In no event shall REBOL Technologies or source contributors be liable
  12. ; for any damages of any kind, even if advised of the possibility of such
  13. ; damage. See license for more information.
  14.  
  15. ; Please help us to improve this software by contributing changes and
  16. ; fixes. See http://www.rebol.com/support.html for details.
  17. ]
  18.  
  19. make Root-Protocol [
  20. "The HTTP protocol."
  21. open: func [
  22. port "the port to open"
  23. /local http-packet http-command response-actions success error response-line
  24. target headers http-version post-data result generic-proxy? sub-protocol
  25. build-port send-and-check create-request line continue-post
  26. tunnel-actions tunnel-success response-code forward proxyauth
  27. ][
  28. ; RAMBO #4039: moved QUERYING to locals
  29. ; also now QUERY will initialize port/locals
  30. unless port/locals [port/locals: make object! [list: copy [] headers: none querying: no]]
  31. generic-proxy?: all [port/proxy/type = 'generic not none? port/proxy/host]
  32.  
  33. build-port: func [] [
  34. sub-protocol: either port/scheme = 'https ['ssl] ['tcp]
  35. open-proto/sub-protocol/generic port sub-protocol
  36. port/url: rejoin [lowercase to-string port/scheme "://" port/host either port/port-id <> 80 [join #":" port/port-id] [copy ""] slash]
  37. if found? port/path [append port/url port/path]
  38. if found? port/target [append port/url port/target]
  39. if sub-protocol = 'ssl [
  40. if generic-proxy? [
  41. HTTP-Get-Header: make object! [
  42. Host: join port/host any [all [port/port-id (port/port-id <> 80) join #":" port/port-id] #]
  43. ]
  44. user: get in port/proxy 'user
  45. pass: get in port/proxy 'pass
  46. if string? :user [
  47. HTTP-Get-Header: make HTTP-Get-Header [
  48. Proxy-Authorization: join "Basic " enbase join user [#":" pass]
  49. ]
  50. ]
  51. http-packet: reform ["CONNECT" HTTP-Get-Header/Host "HTTP/1.1^/"]
  52. append http-packet net-utils/export HTTP-Get-Header
  53. append http-packet "^/"
  54. net-utils/net-log http-packet
  55. insert port/sub-port http-packet
  56. continue-post/tunnel
  57. ]
  58. system/words/set-modes port/sub-port [secure: true]
  59. ]
  60. ]
  61.  
  62. ; smarter query
  63. http-command: either port/locals/querying ["HEAD"] ["GET"]
  64. create-request: func [/local target user pass u data ] [
  65. HTTP-Get-Header: make object! [
  66. Accept: "*/*"
  67. Connection: "close"
  68. User-Agent: get in get in system/schemes port/scheme 'user-agent
  69. Host: join port/host any [all [port/port-id (port/port-id <> 80) join #":" port/port-id] #]
  70. ]
  71.  
  72. if all [block? port/state/custom post-data: select port/state/custom 'header block? post-data] [
  73. HTTP-Get-Header: make HTTP-Get-Header post-data
  74. ]
  75.  
  76. HTTP-Header: make object! [
  77. Date: Server: Last-Modified: Accept-Ranges: Content-Encoding: Content-Type:
  78. Content-Length: Location: Expires: Referer: Connection: Authorization: none
  79. ]
  80.  
  81. http-version: "HTTP/1.0^/"
  82. all [port/user port/pass HTTP-Get-Header: make HTTP-Get-Header [Authorization: join "Basic " enbase join port/user [#":" port/pass]]]
  83. user: get in port/proxy 'user
  84. pass: get in port/proxy 'pass
  85. if all [generic-proxy? string? :user] [
  86. HTTP-Get-Header: make HTTP-Get-Header [
  87. Proxy-Authorization: join "Basic " enbase join user [#":" pass]
  88. ]
  89. ]
  90. ; range request
  91. if port/state/index > 0 [
  92. http-version: "HTTP/1.1^/"
  93. HTTP-Get-Header: make HTTP-Get-Header [
  94. Range: rejoin ["bytes=" port/state/index "-"]
  95. ]
  96. ]
  97. target: next mold to-file join (join "/" either found? port/path [port/path] [""]) either found? port/target [port/target] [""]
  98.  
  99. post-data: none
  100.  
  101. comment { ; original code
  102. if all [block? port/state/custom post-data: find port/state/custom 'post post-data/2] [
  103. http-command: "POST"
  104. HTTP-Get-Header: make HTTP-Get-Header append [
  105. Referer: either find port/url #"?" [head clear find copy port/url #"?"] [port/url]
  106. Content-Type: "application/x-www-form-urlencoded"
  107. Content-Length: length? post-data/2
  108. ] either block? post-data/3 [post-data/3] [[]]
  109. post-data: post-data/2
  110. ]
  111. }
  112. ; start Graham's changes
  113. either all [block? port/state/custom post-data: find port/state/custom 'post post-data/2] [
  114. http-command: "POST"
  115. HTTP-Get-Header: make HTTP-Get-Header append [
  116. Referer: either find port/url #"?" [head clear find copy port/url #"?"] [port/url]
  117. Content-Type: "application/x-www-form-urlencoded"
  118. Content-Length: length? post-data/2
  119. ] either block? post-data/3 [post-data/3] [[]]
  120. post-data: post-data/2
  121. ][
  122. either all [
  123. block? port/state/custom
  124. any [
  125. post-data: find port/state/custom to-word http-command: "GET"
  126. post-data: find port/state/custom to-word http-command: "HEAD"
  127. ]
  128. post-data/2
  129. ] [
  130. HTTP-Get-Header: make HTTP-Get-Header append [
  131. Referer: either find port/url #"?" [head clear find copy port/url #"?"] [port/url]
  132. ] either block? post-data/3 [post-data/3] [[]]
  133. post-data: none
  134. ][
  135. either all [block? port/state/custom post-data: find port/state/custom 'put post-data/2] [
  136. http-command: "PUT"
  137. data: either file? post-data/2 [
  138. system/words/read/binary post-data/2
  139. ][
  140. post-data/2
  141. ]
  142. HTTP-Get-Header: make HTTP-Get-Header append [
  143. Content-Type: "application/octet-stream"
  144. Content-Length: length? data
  145. ] either block? post-data/3 [post-data/3] [[]]
  146. post-data: data
  147. ][
  148. either all [block? port/state/custom post-data: find port/state/custom 'soap post-data/2] [
  149. http-command: "POST"
  150. data: either file? post-data/2 [
  151. system/words/read/binary post-data/2
  152. ][
  153. post-data/2
  154. ]
  155. HTTP-Get-Header: make HTTP-Get-Header append [
  156. Content-Type: {text/xml; charset="utf-8"}
  157. Content-Length: length? data
  158. ] either block? post-data/3 [post-data/3] [[]]
  159. post-data: data
  160. ][
  161. if all [block? port/state/custom post-data: find port/state/custom 'delete post-data/2] [
  162. http-command: "DELETE"
  163. HTTP-Get-Header: make HTTP-Get-Header append [
  164. Referer: either find port/url #"?" [head clear find copy port/url #"?"] [port/url]
  165. ] either block? post-data/3 [post-data/3] [[]]
  166. post-data: none
  167. ]
  168. ]
  169. ]
  170. ]
  171. ]
  172. ; end changes from Graham
  173.  
  174. http-packet: reform [http-command either generic-proxy? [port/url] [target] http-version]
  175. append http-packet net-utils/export HTTP-Get-Header
  176. ; append http-packet "^/"
  177. ; if post-data [append http-packet post-data]
  178. ]
  179.  
  180. send-and-check: func [] [
  181. net-utils/net-log http-packet
  182.  
  183. ; Sterling, why was this changed from insert to write-io ? It causes HTTP to be sent
  184. ; without cr and breaks things.
  185. ; write-io port/sub-port http-packet length? http-packet
  186. insert port/sub-port http-packet
  187. if post-data [
  188. write-io port/sub-port post-data length? post-data
  189. ]
  190. continue-post
  191. ]
  192.  
  193. continue-post: func [/tunnel /local digit space] [
  194. response-line: system/words/pick port/sub-port 1
  195. net-utils/net-log response-line
  196. either none? response-line [do error][
  197. ; fixes #3494: should accept an HTTP/0.9 simple response.
  198. digit: charset "1234567890"
  199. space: charset " ^-"
  200. either parse/all response-line [
  201. ; relaxing rule a bit
  202. ;"HTTP/" digit "." digit some space copy response-code 3 digit some space to end
  203. "HTTP/" digit "." digit some space copy response-code 3 digit to end
  204. ] [
  205. ; valid status line
  206. response-code: to integer! response-code
  207. result: select either tunnel [tunnel-actions] [response-actions] response-code
  208. either none? result [do error] [do get result]
  209. ] [
  210. ; could not parse status line, assuming HTTP/0.9
  211. port/status: 'file
  212. ]
  213. ]
  214. ]
  215.  
  216. tunnel-actions: [
  217. 200 tunnel-success ; Tunnel established
  218. ]
  219.  
  220. response-actions: [
  221. 100 continue-post ; HTTP/1.1 continue with posting data
  222. 200 success ; standard valid response
  223. 201 success ; post command successful - new url included
  224. 204 success ; no new content (maybe use :true here?)
  225. 206 success ; read partial content
  226. 300 forward ; multiple choices of locations in the body - maybe preferred in Location:
  227. 301 forward ; moved permanently - Location: hold new loc
  228. 302 forward ; moved temporarily - Location: hold new loc
  229. 304 success ; not modified since the If-Modified-Since header date
  230. 307 forward ; temporary redirect
  231. 407 proxyauth ; requires proxy authorization
  232. ]
  233.  
  234. tunnel-success: [
  235. while [ ( line: pick port/sub-port 1 ) <> "" ] [net-utils/net-log line]
  236. ]
  237.  
  238. success: [
  239. headers: make string! 500
  240. while [ ( line: pick port/sub-port 1 ) <> "" ] [append headers join line "^/"] ; remove the headers
  241. port/locals/headers: headers: Parse-Header HTTP-Header headers
  242. port/size: 0
  243. if port/locals/querying [if headers/Content-Length [port/size: load headers/Content-Length]]
  244. if error? try [port/date: parse-header-date headers/Last-Modified] [port/date: none]
  245. port/status: 'file
  246. ]
  247.  
  248. error: [
  249. system/words/close port/sub-port
  250. net-error reform ["Error. Target url:" port/url "could not be retrieved. Server response:" response-line]
  251. ]
  252.  
  253. forward: [
  254. page: copy ""
  255. while [ ( str: pick port/sub-port 1 ) <> "" ][ append page reduce [str newline] ]
  256. headers: Parse-Header HTTP-Header page
  257. insert port/locals/list port/url
  258. either found? headers/Location [
  259. either any [find/match headers/Location "http://" find/match headers/Location "https://"] [ ; new whole url to go to
  260. port/path: port/target: port/port-id: none
  261. net-utils/URL-Parser/parse-url/set-scheme port to-url port/url: headers/Location
  262. if not port/port-id: any [port/port-id all [in system/schemes port/scheme get in get in system/schemes port/scheme 'port-id]] [
  263. net-error reform ["HTTP forwarding error: Scheme" port/scheme "for URL" port/url "not supported in this REBOL."]
  264. ]
  265. ] [
  266. either (first headers/Location) = slash [port/path: none remove headers/Location] [either port/path [insert port/path "/"] [port/path: copy "/"]]
  267. port/target: headers/Location
  268. port/url: rejoin [lowercase to-string port/scheme "://" port/host either port/path [port/path] [""] either port/target [port/target] [""]]
  269. ]
  270. if find/case port/locals/list port/url [net-error reform ["Error. Target url:" port/url "could not be retrieved. Circular forwarding detected"]]
  271. system/words/close port/sub-port
  272. build-port
  273. create-request
  274. send-and-check
  275. ] [
  276. do error
  277. ]
  278. ]
  279.  
  280. proxyauth: [
  281. system/words/close port/sub-port
  282. either all [ generic-proxy? (not string? get in port/proxy 'user) ] [
  283. port/proxy/user: system/schemes/http/proxy/user: port/proxy/user
  284. port/proxy/pass: system/schemes/http/proxy/pass: port/proxy/pass
  285. if not error? try [result: get in system/schemes 'https] [
  286. result/proxy/user: port/proxy/user
  287. result/proxy/pass: port/proxy/pass
  288. ]
  289. ] [
  290. net-error reform ["Error. Target url:" port/url "could not be retrieved: Proxy authentication denied"]
  291. ]
  292. build-port
  293. create-request
  294. send-and-check
  295. ]
  296. build-port
  297. create-request
  298. send-and-check
  299. ]
  300.  
  301. query: func [port] [
  302. if not port/locals [
  303. ; RAMBO #4039: query mode is local to port now
  304. port/locals: make object! [list: copy [] headers: none querying: yes]
  305. open port
  306. ; port was kept open after query
  307. ; attempt for extra safety
  308. ; also note, local close on purpose
  309. attempt [close port]
  310. ; RAMBO #3718 - superceded by fix for #4039
  311. ;querying: false
  312. ]
  313. none
  314. ]
  315.  
  316. close: func [port] [system/words/close port/sub-port]
  317.  
  318. net-utils/net-install HTTP self 80
  319. system/schemes/http: make system/schemes/http [user-agent: reform ["REBOL" system/product system/version]]
  320. ]

Report this snippet  

You need to login to post a comment.