Furnace fixes

diff --git a/extra/furnace/actions/actions.factor b/extra/furnace/actions/actions.factor
index 2b3144fd27457b41b118f2c4f234df68117b5cb6..9cc1880cc32fd9435b3a92cb9e05dd15a85d9d7d 100755 (executable)
--- a/extra/furnace/actions/actions.factor
+++ b/extra/furnace/actions/actions.factor
@@ -76,7 +76,7 @@ TUPLE: action rest authorize init display validate submit ;
 \r
 : handle-post ( action -- response )\r
     '[\r
-        form-nesting-key params get at " " split\r
+        form-nesting-key params get at " " split harvest\r
         [ , (handle-post) ]\r
         [ swap '[ , , nest-values ] ] reduce\r
         call\r

diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index 2645146fbf242f6d9da53428c5f6a0f50fcc7816..a51841d4ad8098e3385860e98483b173fa5705b1 100644 (file)
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@@ -109,7 +109,8 @@ SYMBOL: exit-continuation
     [ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
 
 : 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* ;
 
 : a-url ( tag -- url )

diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor
index ab971d24d0a78a6c6b8b1944b1cfe7a8bcaf2204..4be7403e39ac690f4336b6dc6a49b1d8de839fcc 100755 (executable)
--- a/extra/furnace/sessions/sessions.factor
+++ b/extra/furnace/sessions/sessions.factor
@@ -2,7 +2,7 @@
 ! 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 io.server
+fry calendar combinators combinators.lib destructors alarms io.server
 db db.tuples db.types
 http http.server http.server.dispatchers http.server.filters
 html.elements
@@ -69,7 +69,11 @@ TUPLE: sessions < server-state-manager domain verify? ;
 : touch-session ( session -- )
     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 )
     f <session>