Skip to content

Commit

Permalink
FEAT: added support for HTTP redirection
Browse files Browse the repository at this point in the history
fixes: metaeducation/rebol-issues#631 (partially as example from the issue is now redirecting to HTTPS)
  • Loading branch information
Oldes committed May 21, 2018
1 parent 3b89ed9 commit 38df5c9
Showing 1 changed file with 74 additions and 23 deletions.
97 changes: 74 additions & 23 deletions src/mezz/prot-http.r
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,8 @@ idate-to-date: function [date [string!]] [
]
;@@==================================================

;@@ just simple trace function
;@@net-log: :print

sync-op: func [port body /local state] [
unless port/state [open port port/state/close?: yes]
Expand All @@ -60,14 +62,26 @@ sync-op: func [port body /local state] [
;The timeout should be triggered only when the response from other side exceeds the timeout value.
;--Richard
while [not find [ready close] state/state][
;@@net-log ["########### sync-op.." state/state]
unless port? wait [state/connection port/spec/timeout] [http-error "Timeout"]
if state/state = 'reading-data [read state/connection]
;@@net-log ["########### sync-op wakeup" state/state]
switch state/state [
reading-data [
read state/connection
]
redirect [
do-redirect port port/state/info/headers/location
state: port/state
state/awake: :read-sync-awake
]
]
]
body: copy port
if state/close? [close port]
body
]
read-sync-awake: func [event [event!] /local error] [
;@@net-log ["[HTTP read-sync-awake]" event/type]
switch/default event/type [
connect ready [
do-request event/port
Expand All @@ -79,6 +93,13 @@ read-sync-awake: func [event [event!] /local error] [
close [
true
]
custom [
if event/offset/x = 300 [
event/port/state/state: 'redirect
return true
]
false
]
error [
error: event/port/state/error
event/port/state/error: none
Expand All @@ -94,6 +115,11 @@ http-awake: func [event /local port http-port state awake res] [
state: http-port/state
if any-function? :http-port/awake [state/awake: :http-port/awake]
awake: :state/awake

;@@net-log ["[HTTP http-awake]" event/type]

;?? awake

switch/default event/type [
read [
awake make event! [type: 'read port: http-port]
Expand Down Expand Up @@ -200,9 +226,10 @@ do-request: func [
port/state/state: 'doing-request
info/headers: info/response-line: info/response-parsed: port/data:
info/size: info/date: info/name: none
write port/state/connection
make-http-request spec/method to file! any [spec/path %/]
spec/headers spec/content

;@@net-log ["[HTTP do-request]" spec/method spec/host spec/path]

write port/state/connection make-http-request spec/method to file! any [spec/path %/] spec/headers spec/content
]
parse-write-dialect: func [port block /local spec] [
spec: port/spec
Expand All @@ -218,6 +245,9 @@ check-response: func [port /local conn res headers d1 d2 line info state awake s
line: info/response-line
awake: :state/awake
spec: port/spec

;@@net-log ["[HTTP check-response]" info/response-parsed]

if all [
not headers
d1: find conn/data crlfbin
Expand Down Expand Up @@ -267,6 +297,9 @@ check-response: func [port /local conn res headers d1 d2 line info state awake s
| (info/response-parsed: 'version-not-supported)
]
]
;?? info/response-parsed
;?? spec/method

switch/all info/response-parsed [
ok [
either spec/method = 'head [
Expand All @@ -290,9 +323,13 @@ check-response: func [port /local conn res headers d1 d2 line info state awake s
unless open? port [
;NOTE some servers(e.g. yahoo.com) don't supply content-data in the redirect header so the state/state can be left in 'reading-data after check-data call
;I think it is better to check if port has been closed here and set the state so redirect sequence can happen. --Richard
state/state: 'ready
state/state: 'redirect ;ready
]
]
;?? res
;?? headers
;?? state/state

if all [not res state/state = 'ready] [
either all [
any [
Expand All @@ -304,7 +341,7 @@ check-response: func [port /local conn res headers d1 d2 line info state awake s
]
in headers 'Location
] [
res: do-redirect port headers/location
return awake make event! [type: 'custom port: port code: 300]
] [
state/error: make-http-error "Redirect requires manual intervention"
res: awake make event! [type: 'error port: port]
Expand Down Expand Up @@ -379,30 +416,34 @@ do-redirect: func [port [port!] new-uri [url! string! file!] /local spec state]
]
]
new-uri: construct/with new-uri port/scheme/spec
new-uri/ref: to url! ajoin [new-uri/scheme "://" new-uri/host new-uri/path]
new-uri/method: spec/method

;@@net-log ["[HTTP do-redirect] new-uri:" mold new-uri]
;?? port

unless find [http https] new-uri/scheme [
state/error: make-http-error {Redirect to a protocol different from HTTP or HTTPS not supported}
return state/awake make event! [type: 'error port: port]
]
either all [
new-uri/host = spec/host
new-uri/port-id = spec/port-id
] [
spec/path: new-uri/path
;we need to reset tcp connection here before doing a redirect
close port/state/connection
open port/state/connection
do-request port
false
] [
state/error: make-http-error "Redirect to other host - requires custom handling"
state/awake make event! [type: 'error port: port]
]

;we need to reset tcp connection here before doing a redirect
clear spec/headers
port/data: none
close port/state/connection

port/spec: spec: new-uri
port/state: none
open port
]
check-data: func [port /local headers res data out chunk-size mk1 mk2 trailer state conn] [
state: port/state
headers: state/info/headers
conn: state/connection
res: false

;@@net-log ["[HTTP check-data] bytes:" length? conn/data]

case [
headers/transfer-encoding = "chunked" [
data: conn/data
Expand Down Expand Up @@ -449,7 +490,7 @@ check-data: func [port /local headers res data out chunk-size mk1 mk2 trailer st
port/data: conn/data
either headers/content-length <= length? port/data [
state/state: 'ready
conn/data: make binary! 32000
conn/data: make binary! 32000 ;@@ Oldes: why not just none?
res: state/awake make event! [type: 'custom port: port code: 0]
] [
;Awake from the WAIT loop to prevent timeout when reading big data. --Richard
Expand Down Expand Up @@ -489,6 +530,7 @@ sys/make-scheme [
read: func [
port [port!]
] [
;@@net-log "[HTTP read]"
either any-function? :port/awake [
unless open? port [cause-error 'Access 'not-open port/spec/ref]
if port/state/state <> 'ready [http-error "Port not ready"]
Expand All @@ -503,8 +545,11 @@ sys/make-scheme [
port [port!]
value
] [
;@@net-log "[HTTP write]"
;?? port
unless any [block? :value binary? :value any-string? :value] [value: form :value]
unless block? value [value: reduce [[Content-Type: "application/x-www-form-urlencoded; charset=utf-8"] value]]

either any-function? :port/awake [
unless open? port [cause-error 'Access 'not-open port/spec/ref]
if port/state/state <> 'ready [http-error "Port not ready"]
Expand All @@ -520,6 +565,7 @@ sys/make-scheme [
port [port!]
/local conn
] [
;@@net-log ["[HTTP open]" port/state]
if port/state [return port]
if none? port/spec/host [http-error "Missing host address"]
port/state: context [
Expand All @@ -534,10 +580,13 @@ sys/make-scheme [
scheme: (to lit-word! either port/spec/scheme = 'http ['tcp]['tls])
host: port/spec/host
port-id: port/spec/port-id
ref: rejoin [tcp:// host ":" port-id]
ref: rejoin [to url! scheme "://" host #":" port-id]
]
;?? conn
conn/awake: :http-awake
conn/locals: port
;@@net-log ["[HTTP opne]" conn/spec/scheme conn/spec/host]
;?? conn
open conn
port
]
Expand All @@ -549,6 +598,7 @@ sys/make-scheme [
close: func [
port [port!]
] [
;@@net-log "[HTTP close]"
if port/state [
close port/state/connection
port/state/connection/awake: none
Expand Down Expand Up @@ -577,8 +627,9 @@ sys/make-scheme [
state: port/state
close port
]
;?? state
if none? state [return none]
either state/info/response-parsed = 'ok [
either find [ok redirect] state/info/response-parsed [
state/info
][ none ]
]
Expand Down

1 comment on commit 38df5c9

@Oldes
Copy link
Owner Author

@Oldes Oldes commented on 38df5c9 May 21, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This fix is required: fed3fb3

Please sign in to comment.