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

Furnace fixes

db4
Slava Pestov 2008-06-14 04:00:57 -05:00
parent 9516d78154
commit a2fa1369b0
3 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/furnace/actions/actions.factor
View File

@ -76,7 +76,7 @@ TUPLE: action rest authorize init display validate submit ;
: handle-post ( action -- response ) : handle-post ( action -- response )
'[ '[
form-nesting-key params get at " " split form-nesting-key params get at " " split harvest
[ , (handle-post) ] [ , (handle-post) ]
[ swap '[ , , nest-values ] ] reduce [ swap '[ , , nest-values ] ] reduce
call call

3
extra/furnace/furnace.factor
View File

@ -109,7 +109,8 @@ SYMBOL: exit-continuation
[ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ; [ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
: a-url-path ( tag -- string ) : a-url-path ( tag -- string )
[ "href" required-attr ] [ "rest" optional-attr value ] bi [ "href" required-attr ]
[ "rest" optional-attr dup [ value ] when ] bi
[ [ "/" ?tail drop "/" ] dip present 3append ] when* ; [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
: a-url ( tag -- url ) : a-url ( tag -- url )

8
extra/furnace/sessions/sessions.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math.intervals math.parser namespaces USING: assocs kernel math.intervals math.parser namespaces
random accessors quotations hashtables sequences continuations random accessors quotations hashtables sequences continuations
fry calendar combinators destructors alarms io.server fry calendar combinators combinators.lib destructors alarms io.server
db db.tuples db.types db db.tuples db.types
http http.server http.server.dispatchers http.server.filters http http.server http.server.dispatchers http.server.filters
html.elements html.elements
@ -69,7 +69,11 @@ TUPLE: sessions < server-state-manager domain verify? ;
: touch-session ( session -- ) : touch-session ( session -- )
sessions get touch-state ; sessions get touch-state ;
: remote-host ( -- string ) remote-address get host>> ; : remote-host ( -- string )
{
[ request get "x-forwarded-for" header ]
[ remote-address get host>> ]
} 0|| ;
: empty-session ( -- session ) : empty-session ( -- session )
f <session> f <session>