From a2fa1369b04c867720ffcd360fa0c3016a225560 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 14 Jun 2008 04:00:57 -0500
Subject: [PATCH] Furnace fixes

---
 extra/furnace/actions/actions.factor   | 2 +-
 extra/furnace/furnace.factor           | 3 ++-
 extra/furnace/sessions/sessions.factor | 8 ++++++--
 3 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/extra/furnace/actions/actions.factor b/extra/furnace/actions/actions.factor
index 2b3144fd27..9cc1880cc3 100755
--- a/extra/furnace/actions/actions.factor
+++ b/extra/furnace/actions/actions.factor
@@ -76,7 +76,7 @@ TUPLE: action rest authorize init display validate submit ;
 
 : handle-post ( action -- response )
     '[
-        form-nesting-key params get at " " split
+        form-nesting-key params get at " " split harvest
         [ , (handle-post) ]
         [ swap '[ , , nest-values ] ] reduce
         call
diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index 2645146fbf..a51841d4ad 100644
--- 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 ab971d24d0..4be7403e39 100755
--- 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>