Add referrer check responder, harden sessions against cross-site scripting

db4
Slava Pestov 2008-06-13 22:05:41 -05:00
parent a687b58226
commit 935d7d4321
12 changed files with 76 additions and 27 deletions

View File

@ -53,7 +53,7 @@ TUPLE: action rest authorize init display validate submit ;
] with-exit-continuation ;
: validation-failed ( -- * )
request get method>> "POST" = [ f ] [ <400> ] if exit-with ;
post-request? [ f ] [ <400> ] if exit-with ;
: (handle-post) ( action -- response )
'[
@ -70,12 +70,9 @@ TUPLE: action rest authorize init display validate submit ;
: revalidate-url-key "__u" ;
: check-url ( url -- ? )
request get url>>
[ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ;
: revalidate-url ( -- url/f )
revalidate-url-key param dup [ >url dup check-url swap and ] when ;
revalidate-url-key param
dup [ >url [ same-host? ] keep and ] when ;
: handle-post ( action -- response )
'[

View File

@ -5,12 +5,19 @@ furnace.cache
furnace.asides
furnace.flash
furnace.sessions
furnace.referrer
furnace.db
furnace.auth.providers ;
IN: furnace.alloy
: <alloy> ( responder db params -- responder' )
[ <asides> <flash-scopes> <sessions> ] 2dip <db-persistence> ;
'[
<asides>
<flash-scopes>
<sessions>
, , <db-persistence>
<check-form-submissions>
] call ;
: state-classes { session flash-scope aside } ; inline

View File

@ -51,7 +51,7 @@ ERROR: end-aside-in-get-error ;
dup [ dup session>> session get id>> = [ drop f ] unless ] when ;
: end-aside* ( url id -- response )
request get method>> "POST" = [ end-aside-in-get-error ] unless
post-request? [ end-aside-in-get-error ] unless
aside get-state [
dup method>> {
{ "GET" [ url>> <redirect> ] }

View File

@ -84,6 +84,17 @@ M: object modify-form drop ;
] }
} case ;
: referrer ( -- referrer )
#! Typo is intentional, its in the HTTP spec!
"referer" request get header>> at >url ;
: user-agent ( -- user-agent )
"user-agent" request get header>> at "" or ;
: same-host? ( url -- ? )
request get url>>
[ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ;
SYMBOL: exit-continuation
: exit-with ( value -- )

View File

@ -0,0 +1,16 @@
USING: accessors kernel
http.server http.server.filters http.server.responses
furnace ;
IN: furnace.referrer
TUPLE: referrer-check < filter-responder quot ;
C: <referrer-check> referrer-check
M: referrer-check call-responder*
referrer over quot>> call
[ call-next-method ]
[ 2drop 403 "Bad referrer" <trivial-response> ] if ;
: <check-form-submissions> ( responder -- responder' )
[ same-host? post-request? not or ] <referrer-check> ;

View File

@ -2,14 +2,14 @@
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math.intervals math.parser namespaces
random accessors quotations hashtables sequences continuations
fry calendar combinators destructors alarms
fry calendar combinators destructors alarms io.server
db db.tuples db.types
http http.server http.server.dispatchers http.server.filters
html.elements
furnace furnace.cache ;
IN: furnace.sessions
TUPLE: session < server-state uid namespace changed? ;
TUPLE: session < server-state uid namespace user-agent client changed? ;
: <session> ( id -- session )
session new-server-state ;
@ -18,6 +18,8 @@ session "SESSIONS"
{
{ "uid" "UID" { VARCHAR 255 } }
{ "namespace" "NAMESPACE" FACTOR-BLOB +not-null+ }
{ "user-agent" "USER_AGENT" TEXT +not-null+ }
{ "client" "CLIENT" TEXT +not-null+ }
} define-persistent
: get-session ( id -- session )
@ -31,10 +33,11 @@ M: dispatcher init-session* default>> init-session* ;
M: filter-responder init-session* responder>> init-session* ;
TUPLE: sessions < filter-responder timeout domain ;
TUPLE: sessions < server-state-manager domain verify? ;
: <sessions> ( responder -- responder' )
sessions new-server-state-manager ;
sessions new-server-state-manager
t >>verify? ;
: (session-changed) ( session -- )
t >>changed? drop ;
@ -66,9 +69,13 @@ TUPLE: sessions < filter-responder timeout domain ;
: touch-session ( session -- )
sessions get touch-state ;
: remote-host ( -- string ) remote-address get host>> ;
: empty-session ( -- session )
f <session>
H{ } clone >>namespace
remote-host >>client
user-agent >>user-agent
dup touch-session ;
: begin-session ( -- session )
@ -107,8 +114,18 @@ M: session-saver dispose
{ "POST" [ post-session-id ] }
} case ;
: verify-session ( session -- session )
sessions get verify?>> [
dup [
dup
[ client>> remote-host = ]
[ user-agent>> user-agent = ]
bi and [ drop f ] unless
] when
] when ;
: request-session ( -- session/f )
request-session-id get-session ;
request-session-id get-session verify-session ;
: <session-cookie> ( id -- cookie )
session-id-key <cookie>

View File

@ -269,7 +269,7 @@ SYMBOL: a
! Test flash scope
[ "xyz" ] [
H{ { "a" "xyz" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union
"http://localhost:1237/" <post-request> "cookies" get >>cookies B http-request nip test-a
"http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a
] unit-test
[ 4 ] [ a get-global ] unit-test

View File

@ -5,8 +5,6 @@ combinators arrays io.launcher io http.server.static http.server
http accessors sequences strings math.parser fry urls ;
IN: http.server.cgi
: post? ( -- ? ) request get method>> "POST" = ;
: cgi-variables ( script-path -- assoc )
#! This needs some work.
[
@ -34,7 +32,7 @@ IN: http.server.cgi
request get "user-agent" header "HTTP_USER_AGENT" set
request get "accept" header "HTTP_ACCEPT" set
post? [
post-request? [
request get post-data>> raw>>
[ "CONTENT_TYPE" set ]
[ length number>string "CONTENT_LENGTH" set ]
@ -53,7 +51,7 @@ IN: http.server.cgi
"CGI output follows" >>message
swap '[
, output-stream get swap <cgi-process> <process-stream> [
post? [ request get post-data>> raw>> write flush ] when
post-request? [ request get post-data>> raw>> write flush ] when
input-stream get swap (stream-copy)
] with-stream
] >>body ;

View File

@ -20,6 +20,8 @@ html.elements
html.streams ;
IN: http.server
: post-request? ( -- ? ) request get method>> "POST" = ;
SYMBOL: responder-nesting
SYMBOL: main-responder

View File

@ -135,6 +135,8 @@ PRIVATE>
GENERIC: >url ( obj -- url )
M: f >url drop <url> ;
M: url >url ;
M: string >url

View File

@ -61,9 +61,7 @@ TUPLE: factor-website < dispatcher ;
: init-factor-website ( -- )
"factorcode.org" 25 <inet> smtp-server set-global
"todo@factorcode.org" lost-password-from set-global
init-factor-db
<factor-website> main-responder set-global ;
: start-factor-website ( -- )

View File

@ -39,8 +39,6 @@ TUPLE: article title revision ;
article "ARTICLES" {
{ "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
! { "AUTHOR" INTEGER +not-null+ } ! uid
! { "PROTECTED" BOOLEAN +not-null+ }
{ "revision" "REVISION" INTEGER +not-null+ } ! revision id
} define-persistent
@ -111,14 +109,17 @@ M: revision feed-entry-url id>> revision-url ;
{ wiki "view" } >>template ;
: amend-article ( revision article -- )
swap id>> >>revision update-tuple ;
: add-article ( revision -- )
[ title>> ] [ id>> ] bi article boa insert-tuple ;
: add-revision ( revision -- )
[ insert-tuple ]
[
dup title>> <article> select-tuple [
swap id>> >>revision update-tuple
] [
[ title>> ] [ id>> ] bi article boa insert-tuple
] if*
dup title>> <article> select-tuple
[ amend-article ] [ add-article ] if*
] bi ;
: <edit-article-action> ( -- action )