[REBOL] Re: Cookies and Redirected URLs
From: rotenca:telvia:it at: 7-Sep-2003 21:37
AFAIK you must rewrite or change the http handler.
This is a very fast patch example to use like a starting point. Try it: i did
not test it. Pay attention to email lines break.
Search the response-actions block to see the little changes. Perhaps you do
not need to patch the 300 return code.
You must redirect manually.
rebol []
system/schemes/HTTP/handler/open: func [
port "the port to open"
/local http-packet http-command response-actions success error
response-line
target headers http-version post-data result generic-proxy? sub-protocol
build-port send-and-check create-request
] bind [
port/locals: make object! [list: copy [] headers: none]
generic-proxy?: all [port/proxy/type = 'generic not none? port/proxy/host]
build-port: func [] [
sub-protocol: either port/scheme = 'https ['ssl] ['tcp]
open-proto/sub-protocol/generic port sub-protocol
port/url: rejoin [lowercase to-string port/scheme "://" port/host
either port/port-id <> 80 [join #":" port/port-id] [copy ""] slash]
if found? port/path [append port/url port/path]
if found? port/target [append port/url port/target]
if sub-protocol = 'ssl [
if generic-proxy? [
HTTP-Get-Header: make object! [
Host: join port/host any [all [port/port-id (port/port-id
<> 80) join #":" port/port-id] #]
]
user: get in port/proxy 'user
pass: get in port/proxy 'pass
if string? :user [
HTTP-Get-Header: make HTTP-Get-Header [
Proxy-Authorization: join "Basic " enbase join user
[#":" pass]
]
]
http-packet: reform ["CONNECT" HTTP-Get-Header/Host
HTTP/1.1^/
]
append http-packet net-utils/export HTTP-Get-Header
append http-packet "^/"
net-utils/net-log http-packet
insert port/sub-port http-packet
continue-post/tunnel
]
system/words/set-modes port/sub-port [secure: true]
]
]
http-command: "GET"
create-request: func [/local target user pass u] [
HTTP-Get-Header: make object! [
Accept: "*/*"
Connection: "close"
User-Agent: get in get in system/schemes port/scheme 'user-agent
Host: join port/host any [all [port/port-id (port/port-id <> 80)
join #":" port/port-id] #]
]
if all [block? port/state/custom post-data: select port/state/custom
'header block? post-data] [
HTTP-Get-Header: make HTTP-Get-Header post-data
]
HTTP-Header: make object! [
Date: Server: Last-Modified: Accept-Ranges: Content-Encoding:
Content-Type:
Content-Length: Location: Expires: Referer: Connection:
Authorization: none
]
http-version: "HTTP/1.0^/"
all [port/user port/pass HTTP-Get-Header: make HTTP-Get-Header
[Authorization: join "Basic " enbase join port/user [#":" port/pass]]]
user: get in port/proxy 'user
pass: get in port/proxy 'pass
if all [generic-proxy? string? :user] [
HTTP-Get-Header: make HTTP-Get-Header [
Proxy-Authorization: join "Basic " enbase join user [#":"
pass]
]
]
if port/state/index > 0 [
http-version: "HTTP/1.1^/"
HTTP-Get-Header: make HTTP-Get-Header [
Range: rejoin ["bytes=" port/state/index "-"]
]
]
target: next mold to-file join (join "/" either found? port/path
[port/path] [""]) either found? port/target [port/target] [""]
post-data: none
if all [block? port/state/custom post-data: find port/state/custom
'post post-data/2] [
http-command: "POST"
HTTP-Get-Header: make HTTP-Get-Header append [
Referer: either find port/url #"?" [head clear find copy
port/url #"?"] [port/url]
Content-Type: "application/x-www-form-urlencoded"
Content-Length: length? post-data/2
] either block? post-data/3 [post-data/3] [[]]
post-data: post-data/2
]
http-packet: reform [http-command either generic-proxy? [port/url]
[target] http-version]
append http-packet net-utils/export HTTP-Get-Header
]
send-and-check: func [] [
net-utils/net-log http-packet
insert port/sub-port http-packet
if post-data [write-io port/sub-port post-data length? post-data]
continue-post
]
continue-post: func [/tunnel] [
response-line: system/words/pick port/sub-port 1
net-utils/net-log response-line
either none? response-line [do error] [
either none? result: select either tunnel [tunnel-actions]
[response-actions]
response-code: to-integer second parse response-line none [
do error] [
do get result]
]
]
tunnel-actions: [
200 tunnel-success
]
response-actions: [
100 continue-post
200 success
201 success
204 success
206 success
300 success ;forward ;patched -Romano
301 success ;forward ;patched -Romano
302 success ;forward ;patched -Romano
304 success
407 proxyauth
]
tunnel-success: [
while [(line: pick port/sub-port 1) <> ""] [net-log line]
]
success: [
headers: make string! 500
while [(line: pick port/sub-port 1) <> ""] [append headers join line
^/
]
port/locals/headers: headers: Parse-Header HTTP-Header headers
port/size: 0
if querying [if headers/Content-Length [port/size: load
headers/Content-Length]]
if error? try [port/date: parse-header-date headers/Last-Modified]
[port/date: none]
port/status: 'file
]
error: [
system/words/close port/sub-port
net-error reform ["Error. Target url:" port/url "could not be
retrieved. Server response:" response-line]
]
forward: [
page: copy ""
while [(str: pick port/sub-port 1) <> ""] [append page reduce [str
newline]]
headers: Parse-Header HTTP-Header page
insert port/locals/list port/url
either found? headers/Location [
either any [find/match headers/Location "http://" find/match
headers/Location "https://"] [
port/path: port/target: port/port-id: none
net-utils/URL-Parser/parse-url/set-scheme port to-url
port/url: headers/Location
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]] [
net-error reform ["HTTP forwarding error: Scheme"
port/scheme "for URL" port/url "not supported in this REBOL."]
]
] [
either (first headers/Location) = slash [port/path: none
remove headers/Location] [either port/path [insert port/path "/"] [port/path:
copy "/"]]
port/target: headers/Location
port/url: rejoin [lowercase to-string port/scheme "://"
port/host either port/path [port/path] [""] either port/target [port/target]
[""]]
]
if find/case port/locals/list port/url [net-error reform ["Error.
Target url:" port/url {could not be retrieved. Circular forwarding
detected}]]
system/words/close port/sub-port
build-port
create-request
send-and-check
] [
do error]
]
proxyauth: [
system/words/close port/sub-port
either all [generic-proxy? (not string? get in port/proxy 'user)] [
port/proxy/user: system/schemes/http/proxy/user: port/proxy/user
port/proxy/pass: system/schemes/http/proxy/pass: port/proxy/pass
if not error? try [result: get in system/schemes 'https] [
result/proxy/user: port/proxy/user
result/proxy/pass: port/proxy/pass
]
] [
net-error reform ["Error. Target url:" port/url {could not be
retrieved: Proxy authentication denied}]
]
build-port
create-request
send-and-check
]
build-port
create-request
send-and-check
] in system/schemes/HTTP/handler 'open
---
Ciao
Romano
