[OpenBIOS] r529 - ofw/inetv6
svn at openbios.org
svn at openbios.org
Mon Aug 6 20:37:01 CEST 2007
Author: lwalter
Date: 2007-08-06 20:37:01 +0200 (Mon, 06 Aug 2007)
New Revision: 529
Modified:
ofw/inetv6/http.fth
Log:
Support redirect and http-proxy
Modified: ofw/inetv6/http.fth
===================================================================
--- ofw/inetv6/http.fth 2007-08-06 18:26:17 UTC (rev 528)
+++ ofw/inetv6/http.fth 2007-08-06 18:37:01 UTC (rev 529)
@@ -5,6 +5,42 @@
false instance value debug?
+h# 100 instance buffer: url
+0 instance value /url
+h# 80 instance buffer: proxy
+0 instance value /proxy
+
+-1 value result-code
+0 value image-size
+
+\ proxy should have the value of
+\ 1. environment variable, http-proxy, if not null$
+\ 2. otherwise, devalias http-proxy, if not null$
+\ 3. Location: URL$ for status code 305
+
+: set-proxy ( $ -- )
+ \ strip "http://" or "http:\\"
+ over " http:" comp 0= if
+ 7 /string
+ else
+ over " HTTP:" comp 0= if 7 /string then
+ then
+
+ dup to /proxy proxy swap move
+;
+: init-proxy ( -- )
+ 0 to /proxy
+ " http-proxy" $getenv 0= if
+ ?dup if
+ set-proxy
+ exit
+ else
+ drop
+ then
+ then
+ " http-proxy" not-alias? 0= if set-proxy then
+;
+
d# 255 instance buffer: pathbuf
: fix-delims ( $ -- $' )
pathbuf pack count ( $' )
@@ -117,21 +153,17 @@
: decode-url ( url$ -- send$ prefix$ port# server$ )
fix-delims ( url$' )
- " http-proxy" not-alias? if ( url$ )
+ /proxy 0= if
url-parse null$ ( filename$ server$ prefix$ )
- bootnet-debug if ." HTTP Server " 2over type cr then
- else ( url$ proxy$ )
- dup 0= if ( url$ proxy$ )
- 2drop url-parse null$ ( filename$ server$ prefix$ )
- bootnet-debug if ." HTTP Proxy server " 2over type cr then
- else ( url$ proxy$ )
- " http:" ( url$ proxy$ prefix$ )
- then ( url$ proxy$ prefix$ )
+ bootnet-debug if ." HTTP: Server is: " 2over type cr then
+ else ( url$ )
+ proxy /proxy ( url$ proxy$ )
+ bootnet-debug if ." HTTP: Proxy is: " 2dup type cr then
+ " http:" ( url$ proxy$ prefix$ )
then ( send$ server$ prefix$ )
2swap parse-port ( send$ prefix$ port# server$ )
;
-0 value image-size
--1 value result-code
+
vocabulary http-tags
: parse-line ( adr len -- )
@@ -193,7 +225,7 @@
: get-number ( adr len -- n ) push-decimal $number pop-base throw ;
: version-bad? ( $ -- flag )
- 2dup " HTTP/1.0" $= if 2drop false exit then ( $ )
+ 2dup " HTTP/1.0" $= if 2drop false exit then ( $ )
2dup " HTTP/1.1" $= if
2drop false
else
@@ -203,6 +235,11 @@
true
then
;
+: result-code-supported? ( # -- supported? )
+ dup to result-code >r ( # )
+ r@ d# 200 = r@ d# 301 d# 303 between or
+ r@ d# 305 = or r> d# 307 = or
+;
: dump-response ( -- )
begin get-line dup while type cr repeat
;
@@ -212,15 +249,10 @@
abort" HTTP: Bad version line" ( rem$ )
skipwhite scanwhite ( rem$ head$ )
get-number ( rem$ # )
- \ XXX should handle 3xx redirects
- dup d# 200 <> if ( rem$ # )
+ dup result-code-supported? not if ( rem$ # )
bootnet-debug if ( rem$ # )
- dup d# 302 = if
- ." HTTP: Response: " .d type cr ( )
- dump-response
- else
- ." HTTP: Bad response: " .d type cr ( )
- then
+ ." HTTP: Bad response: " .d type cr ( )
+ dump-response
then ( | rem$ # )
abort ( )
else 3drop then ( )
@@ -242,6 +274,7 @@
\ Content-type: text/html
\ Content-length: 10696
\ Last-modified: Thu, 11 Feb 1999 01:08:12 GMT
+\ Location: http://www.w3.org/TheProject.html
: content-length ( $ -- ) \ [<white>] length
skipwhite scanwhite ( tail$ head$ )
@@ -249,6 +282,19 @@
get-number ( size )
to image-size
;
+: location ( $ -- ) \ [<white>] url$
+ skipwhite scanwhite ( tail$ head$ )
+ 2swap 2drop ( head$ )
+ ascii : left-parse-string 2drop ( head$' )
+ result-code d# 305 = if
+ set-proxy
+ else
+ dup to /url ( head$ )
+ url swap move ( )
+ null$ set-proxy
+ bootnet-debug if ." HTTP: Location: " url /url type cr then
+ then
+;
previous definitions
@@ -259,7 +305,7 @@
check-status-line
begin get-line dup while parse-header-line repeat 2drop
;
-: mount ( $url -- error? )
+: (mount) ( $url -- error? )
decode-url ( send$ prefix$ port# server$ )
2dup set-server ( send$ prefix$ port# server$ )
@@ -284,9 +330,18 @@
['] check-header catch
;
+: mount ( url$ -- error? )
+ dup to /url 2dup url swap move
+ begin (mount) 0= if result-code d# 200 <> else false then while
+ " disconnect" $call-parent
+ url /url
+ repeat
+ result-code d# 200 <>
+;
: open ( -- )
my-args dup if
+ init-proxy
bootnet-debug if
2dup ." HTTP: URL is: " type cr
then
More information about the OpenBIOS
mailing list