steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More referrer fixes

db4
Slava Pestov 2008-09-22 17:15:59 -05:00
parent 977dd43d46
commit 18a44674f2
4 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/furnace/furnace-tests.factor
View File

@ -1,7 +1,7 @@
IN: furnace.tests IN: furnace.tests
USING: http.server.dispatchers http.server.responses USING: http http.server.dispatchers http.server.responses
http.server furnace tools.test kernel namespaces accessors http.server furnace tools.test kernel namespaces accessors
io.streams.string ; io.streams.string urls ;
TUPLE: funny-dispatcher < dispatcher ; TUPLE: funny-dispatcher < dispatcher ;
: <funny-dispatcher> funny-dispatcher new-dispatcher ; : <funny-dispatcher> funny-dispatcher new-dispatcher ;
@ -33,3 +33,9 @@ M: base-path-check-responder call-responder*
[ "<input type='hidden' name='foo' value='&amp;&amp;&amp;'/>" ] [ "<input type='hidden' name='foo' value='&amp;&amp;&amp;'/>" ]
[ [ "&&&" "foo" hidden-form-field ] with-string-writer ] [ [ "&&&" "foo" hidden-form-field ] with-string-writer ]
unit-test unit-test
[ f ] [ <request> request [ referrer ] with-variable ] unit-test
[ t ] [ URL" http://foo" dup url [ same-host? ] with-variable ] unit-test
[ f ] [ f URL" http://foo" url [ same-host? ] with-variable ] unit-test

8
basis/furnace/furnace.factor
View File

@ -89,17 +89,19 @@ M: object modify-form drop ;
] } ] }
} case ; } case ;
: referrer ( -- referrer ) : referrer ( -- referrer/f )
#! Typo is intentional, its in the HTTP spec! #! Typo is intentional, its in the HTTP spec!
"referer" request get header>> at "referer" request get header>> at
>url ensure-port [ remap-port ] change-port ; dup [ >url ensure-port [ remap-port ] change-port ] when ;
: user-agent ( -- user-agent ) : user-agent ( -- user-agent )
"user-agent" request get header>> at "" or ; "user-agent" request get header>> at "" or ;
: same-host? ( url -- ? ) : same-host? ( url -- ? )
dup [
url get url get
[ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ; [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ =
] when ;
: cookie-client-state ( key request -- value/f ) : cookie-client-state ( key request -- value/f )
swap get-cookie dup [ value>> ] when ; swap get-cookie dup [ value>> ] when ;

2
basis/furnace/referrer/referrer.factor
View File

@ -14,4 +14,4 @@ M: referrer-check call-responder*
[ 2drop 403 "Bad referrer" <trivial-response> ] if ; [ 2drop 403 "Bad referrer" <trivial-response> ] if ;
: <check-form-submissions> ( responder -- responder' ) : <check-form-submissions> ( responder -- responder' )
[ same-host? post-request? not or ] <referrer-check> ; [ post-request? [ same-host? ] [ drop f ] if ] <referrer-check> ;

4
basis/urls/urls.factor
View File

@ -212,15 +212,13 @@ PRIVATE>
[ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi [ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi
secure-protocol? [ <secure> ] when ; secure-protocol? [ <secure> ] when ;
ERROR: no-protocol-found protocol ;
: protocol-port ( protocol -- port ) : protocol-port ( protocol -- port )
{ {
{ "http" [ 80 ] } { "http" [ 80 ] }
{ "https" [ 443 ] } { "https" [ 443 ] }
{ "feed" [ 80 ] } { "feed" [ 80 ] }
{ "ftp" [ 21 ] } { "ftp" [ 21 ] }
[ no-protocol-found ] [ drop f ]
} case ; } case ;
: ensure-port ( url -- url' ) : ensure-port ( url -- url' )