This program replaces the HTTP protocol scheme with a better implementation that supports HTTP/1.1 and chunked encoding.
In REBOL, a scheme is a set of definitions and functions that handle the operations of a kind of port. This scheme handles HTTP ports, allowing access to resources served via HTTP. Version 1.1 of the HTTP protocol is supported (although some features are not yet implemented at this point).
The scheme is defined by using the Root-Protocol object and the net-install function from net-utils.
〈Overview〉 ≡
make Root-Protocol [
〈Port handler functions〉
net-utils/net-install HTTP self 80
net-utils/net-install HTTPS self 443
]
〈Support functions〉
〈Port handler functions〉 ≡
open: func [port] [
〈The open handler〉
]
query: func [port] [
〈The query handler〉
]
close: func [port] [
〈The close handler〉
]
read: func [port data /local result desired chunk-size] [
〈The read handler〉
]
The port/locals object keeps track of data relative to the request and the response.
The method, headers and content can be specified using the /custom refinement (which sets port/state/custom). (Otherwise, a GET request is done by default.)
In the block passed to /custom you can specify the HTTP method (as a word!) for the request (GET by default, or if there is some content the default is POST), any additional headers (as a block!, gets evaluated to an object) and the content for the request (any-string!); the default Content-Type if not specified is "application/x-www-form-urlencoded". See parse-custom-data for more details.
〈The open handler〉 ≡
port/locals: context [
method: 'GET
headers: []
content: none
response-line: none
response-parsed: none
response-headers: none
chunked?: no
chunked-buffer: none
]
parse-custom-data port
open-sub-port port
do-request port
parse-response port
port/size: any [attempt [to integer! port/locals/response-headers/Content-Length] 0]
port/date: attempt [parse-header-date port/locals/response-headers/Last-Modified]
port/status: 'file
〈The query handler〉 ≡
if not port/locals [
port/state/custom: [HEAD]
; these are the local open and close functions
open port
attempt [close port]
]
reduce [
port/locals/response-parsed
port/size
port/locals/response-headers/content-type
]
〈The close handler〉 ≡
close-sub-port port
This is a low level handler that is called by the REBOL buffer layer (which takes care of converting line terminators, and so on).
〈The read handler〉 ≡
either port/locals/chunked? [
〈Handle chunked transfer encoding〉
] [
read-io port/sub-port data port/state/num
]
〈Handle chunked transfer encoding〉 ≡
desired: port/state/num
if port/locals/chunked-buffer [
desired: min desired length? port/locals/chunked-buffer
insert/part tail data port/locals/chunked-buffer desired
remove/part port/locals/chunked-buffer desired
if empty? port/locals/chunked-buffer [port/locals/chunked-buffer: none]
return desired
]
chunk-size: pick port/sub-port 1
parse/all chunk-size [some hexdigit | (net-error [access protocol "Invalid chunked encoding"])]
chunk-size: to integer! to issue! chunk-size
either chunk-size = 0 [
; ignore trailer for now
while ["" <> pick port/sub-port 1] []
0
] [
result: read-io port/sub-port data min desired chunk-size
chunk-size: chunk-size - result
if chunk-size > 0 [port/locals/chunked-buffer: make binary! chunk-size + 10]
while [chunk-size > 0] [
chunk-size: chunk-size - read-io port/sub-port port/locals/chunked-buffer chunk-size
]
result
]
open-sub-port takes care of opening the TCP (or SSL) connection to the HTTP server.
〈Support functions〉 ≡
open-sub-port: func [port /local sub-protocol secure?] [
sub-protocol: either port/scheme = 'https [secure?: yes ['ssl]] [['tcp]]
port/sub-port: open/lines compose [
scheme: (sub-protocol)
host: port/host
port-id: port/port-id
]
port/sub-port/timeout: port/timeout
if secure? [set-modes port/sub-port [secure: true]]
]
close-sub-port: func [port] [
close port/sub-port
]
The do-request function makes the HTTP request to the server.
〈Support functions〉 +≡
do-request: func [
"Perform an HTTP request"
port [port!]
/local headers target
] [
headers: make context [
Accept: "*/*"
Accept-Charset: "utf-8"
Host: either port/port-id <> either port/scheme = 'https [443] [80] [
rejoin [form port/host #":" port/port-id]
] [
form port/host
]
User-Agent: "REBOL"
Connection: "close"
] port/locals/headers
if port/locals/content [
headers: make headers [
Content-Length: form length? port/locals/content
]
]
headers: third headers
target: copy %/
if port/path [append target port/path]
if port/target [append target port/target]
insert port/sub-port rejoin [
uppercase form port/locals/method #" "
; needs better escaping!!
next mold target
" HTTP/1.1"
]
foreach [word string] headers [
insert port/sub-port rejoin [mold word #" " string]
]
insert port/sub-port ""
if port/locals/content [
write-io port/sub-port port/locals/content length? port/locals/content
]
]
The parse-custom-data function parses the block passed to the /custom refinement and extracts the request method, request headers and request content. The values in the port object are set accordingly so that they can be used later on by the do-request function.
〈Support functions〉 +≡
parse-custom-data: func [port /local method headers content] [
if block? port/state/custom [
parse port/state/custom [
opt [set method word!]
opt [set headers block!]
opt [set content any-string!]
]
if content [
unless method [method: 'POST]
either headers [
unless find headers [Content-Type:] [
append headers [Content-Type: "application/x-www-form-urlencoded"]
]
] [
headers: [Content-Type: "application/x-www-form-urlencoded"]
]
]
if method [port/locals/method: method]
if headers [port/locals/headers: headers]
if content [port/locals/content: content]
]
]
parse-response waits for the server response, and parses it.
〈Support functions〉 +≡
parse-response: func [port /local line header] [
port/locals/response-line: pick port/sub-port 1
parse/all port/locals/response-line [
"HTTP/1." [#"0" | #"1"] some #" " [
#"1" (port/locals/response-parsed: 'info)
|
#"2" [
["04" | "05"] (port/locals/response-parsed: 'no-content)
|
(port/locals/response-parsed: 'ok)
]
|
#"3" [
"03" (port/locals/response-parsed: 'see-other)
|
"04" (port/locals/response-parsed: 'not-modified)
|
"05" (port/locals/response-parsed: 'use-proxy)
|
(port/locals/response-parsed: 'redirect)
]
|
#"4" [
"01" (port/locals/response-parsed: 'unauthorized)
|
"07" (port/locals/response-parsed: 'proxy-auth)
|
(port/locals/response-parsed: 'client-error)
]
|
#"5" (port/locals/response-parsed: 'server-error)
]
|
(port/locals/response-parsed: 'version-not-supported)
]
port/locals/response-headers: copy []
while ["" <> line: pick port/sub-port 1] [
parse/all line [
; continuation of previous header line
some space-char line: (append last port/locals/response-headers line)
|
copy header name #":" any space-char copy line to end (
append port/locals/response-headers reduce [
to set-word! header line
]
)
]
]
port/locals/response-headers: construct/with port/locals/response-headers http-response-headers
switch port/locals/response-parsed [
ok [
if port/locals/response-headers/transfer-encoding = "chunked" [
port/locals/chunked?: yes
]
]
redirect see-other [
net-error reduce ['access 'protocol "Redirects not supported yet"]
]
unauthorized client-error server-error proxy-auth use-proxy proxy-auth [
net-error reduce ['access 'protocol port/locals/response-line]
]
info [
; we just ignore the informational response, and try to parse the following response
parse-response port
]
version-not-supported [
net-error reduce ['access 'protocol "HTTP version not supported"]
]
]
]
http-response-headers: context [
Content-Type:
Content-Length:
Transfer-Encoding:
Last-Modified: none
]
parse-header-date: func [date] [
parse/all date [
opt [["Mon" | "Tue" | "Wed" | "Thu" | "Fri" | "Sat" | "Sun"] #","]
any space-char date:
]
to date! date
]