Login authentication is now stored outside of the session, allowing multiple independ...

diff --git a/extra/furnace/alloy/alloy.factor b/extra/furnace/alloy/alloy.factor
index 14ffbaba9d0939d1f83d0519dd4ad59230255604..28c34e6715c44782fc1a0c2c6313e6618f35f750 100644 (file)
--- a/extra/furnace/alloy/alloy.factor
+++ b/extra/furnace/alloy/alloy.factor
@@ -7,7 +7,8 @@ furnace.flash
 furnace.sessions
 furnace.referrer
 furnace.db
-furnace.auth.providers ;
+furnace.auth.providers
+furnace.auth.login.permits ;
 IN: furnace.alloy
 
 : <alloy> ( responder db params -- responder' )
@@ -19,7 +20,7 @@ IN: furnace.alloy
         <check-form-submissions>
     ] call ;
 
-: state-classes { session flash-scope aside } ; inline
+: state-classes { session flash-scope aside permit } ; inline
 
 : init-furnace-tables ( -- )
     state-classes ensure-tables

diff --git a/extra/furnace/auth/auth-tests.factor b/extra/furnace/auth/auth-tests.factor
new file mode 100644 (file)
index 0000000..220a8cd
--- /dev/null
+++ b/extra/furnace/auth/auth-tests.factor
@@ -0,0 +1,6 @@
+USING: furnace.auth tools.test ;
+IN: furnace.auth.tests
+
+\ logged-in-username must-infer
+\ <protected> must-infer
+\ new-realm must-infer

diff --git a/extra/furnace/auth/auth.factor b/extra/furnace/auth/auth.factor
index 9bb7ea105e84813fce95de5bb0db73a27a97accc..d9f517aaf4f2871735bf1a9759a74335aa9153e1 100755 (executable)
--- a/extra/furnace/auth/auth.factor
+++ b/extra/furnace/auth/auth.factor
@@ -82,15 +82,12 @@ M: user-saver dispose
 : save-user-after ( user -- )\r
     <user-saver> &dispose drop ;\r
 \r
-: init-user ( realm -- )\r
-    logged-in-username [\r
-        users get-user\r
-        [ logged-in-user set ] [ save-user-after ] bi\r
-    ] when* ;\r
+: init-user ( user -- )\r
+    [ [ logged-in-user set ] [ save-user-after ] bi ] when* ;\r
 \r
 M: realm call-responder* ( path responder -- response )\r
     dup realm set\r
-    dup init-user\r
+    dup logged-in-username dup [ users get-user ] when init-user\r
     call-next-method ;\r
 \r
 : encode-password ( string salt -- bytes )\r

diff --git a/extra/furnace/auth/basic/basic.factor b/extra/furnace/auth/basic/basic.factor
index ae9cbb82c1f3dcfaf9132376b767d3e9dcc504f6..e478f70dcca7fdf2a90450d0b9f470dd6ecbf743 100755 (executable)
--- a/extra/furnace/auth/basic/basic.factor
+++ b/extra/furnace/auth/basic/basic.factor
@@ -1,17 +1,18 @@
 ! Copyright (c) 2007 Chris Double.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors kernel splitting base64 namespaces\r
+USING: accessors kernel splitting base64 namespaces strings\r
 http http.server.responses furnace.auth ;\r
 IN: furnace.auth.basic\r
 \r
 TUPLE: basic-auth-realm < realm ;\r
 \r
-C: <basic-auth-realm> basic-auth-realm\r
+: <basic-auth-realm> ( responder name -- realm )\r
+    basic-auth-realm new-realm ;\r
 \r
 : parse-basic-auth ( header -- username/f password/f )\r
     dup [\r
         " " split1 swap "Basic" = [\r
-            base64> ":" split1\r
+            base64> >string ":" split1\r
         ] [ drop f f ] if\r
     ] [ drop f f ] if ;\r
 \r
@@ -23,5 +24,6 @@ M: basic-auth-realm login-required* ( realm -- response )
     name>> <401> ;\r
 \r
 M: basic-auth-realm logged-in-username ( realm -- uid )\r
+    drop\r
     request get "authorization" header parse-basic-auth\r
-    dup [ over realm get check-login swap and ] [ 2drop f ] if ;\r
+    dup [ over check-login swap and ] [ 2drop f ] if ;\r

diff --git a/extra/furnace/auth/features/registration/registration.factor b/extra/furnace/auth/features/registration/registration.factor
index 3deead486943489f11e8e019b9f025178a208c9e..2bc7688b10f69e00df08e30269f466be702b4a23 100644 (file)
--- a/extra/furnace/auth/features/registration/registration.factor
+++ b/extra/furnace/auth/features/registration/registration.factor
@@ -7,7 +7,7 @@ IN: furnace.auth.features.registration
 
 : <register-action> ( -- action )
     <page-action>
-        { realm "register" } >>template
+        { realm "features/registration/register" } >>template
 
         [
             {

diff --git a/extra/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor
index 6a59c01c630712a26f95d370b9ea148964e4a17c..e2b208de3a4c627691b96a248790b0b4108899fc 100755 (executable)
--- a/extra/furnace/auth/login/login.factor
+++ b/extra/furnace/auth/login/login.factor
@@ -1,28 +1,57 @@
 ! Copyright (c) 2008 Slava Pestov\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel accessors namespaces validators urls\r
-html.forms\r
-http.server.dispatchers\r
+USING: kernel accessors namespaces sequences math.parser\r
+calendar validators urls html.forms\r
+http http.server http.server.dispatchers\r
+furnace\r
 furnace.auth\r
 furnace.flash\r
 furnace.asides\r
 furnace.actions\r
 furnace.sessions\r
-furnace.utilities ;\r
+furnace.utilities\r
+furnace.auth.login.permits ;\r
 IN: furnace.auth.login\r
 \r
-TUPLE: login-realm < realm ;\r
+SYMBOL: permit-id\r
+\r
+: permit-id-key ( realm -- string )\r
+    [ >hex 2 CHAR: 0 pad-left ] { } map-as concat\r
+    "__p_" prepend ;\r
+\r
+: client-permit-id ( realm -- id/f )\r
+    permit-id-key client-state dup [ string>number ] when ;\r
+\r
+TUPLE: login-realm < realm timeout domain ;\r
+\r
+M: login-realm call-responder*\r
+    [ name>> client-permit-id permit-id set ]\r
+    [ call-next-method ]\r
+    bi ;\r
 \r
 M: login-realm logged-in-username\r
-    drop session get uid>> ;\r
+    drop permit-id get dup [ get-permit-uid ] when ;\r
+\r
+M: login-realm modify-form ( responder -- )\r
+    drop permit-id get realm get name>> permit-id-key hidden-form-field ;\r
+\r
+: <permit-cookie> ( -- cookie )\r
+    permit-id get realm get name>> permit-id-key <cookie>\r
+        "$login-realm" resolve-base-path >>path\r
+        realm get timeout>> from-now >>expires\r
+        realm get domain>> >>domain ;\r
 \r
-: set-uid ( username -- )\r
-    session get [ (>>uid) ] [ (session-changed) ] bi ;\r
+: put-permit-cookie ( response -- response' )\r
+    <permit-cookie> put-cookie ;\r
 \r
 : successful-login ( user -- response )\r
-    username>> set-uid URL" $realm" end-aside ;\r
+    [ username>> make-permit permit-id set ] [ init-user ] bi\r
+    URL" $realm" end-aside\r
+    put-permit-cookie ;\r
 \r
-: logout ( -- ) f set-uid URL" $realm" end-aside ;\r
+: logout ( -- )\r
+    permit-id get [ delete-permit ] when*\r
+    URL" $realm" end-aside ;\r
 \r
 SYMBOL: description\r
 SYMBOL: capabilities\r
@@ -56,7 +85,9 @@ SYMBOL: capabilities
 \r
 : <logout-action> ( -- action )\r
     <action>\r
-        [ logout ] >>submit ;\r
+        [ logout ] >>submit\r
+    <protected>\r
+        "logout" >>description ;\r
 \r
 M: login-realm login-required*\r
     drop\r
@@ -68,4 +99,5 @@ M: login-realm login-required*
 : <login-realm> ( responder name -- auth )\r
     login-realm new-realm\r
         <login-action> <auth-boilerplate> "login" add-responder\r
-        <logout-action> "logout" add-responder ;\r
+        <logout-action> "logout" add-responder\r
+        20 minutes >>timeout ;\r

diff --git a/extra/furnace/auth/login/permits/permits.factor b/extra/furnace/auth/login/permits/permits.factor
new file mode 100644 (file)
index 0000000..49cf98e
--- /dev/null
+++ b/extra/furnace/auth/login/permits/permits.factor
@@ -0,0 +1,30 @@
+USING: accessors namespaces combinators.lib kernel
+db.tuples db.types
+furnace.auth furnace.sessions furnace.cache ;
+IN: furnace.auth.login.permits
+
+TUPLE: permit < server-state session uid ;
+
+permit "PERMITS" {
+    { "session" "SESSION" BIG-INTEGER +not-null+ }
+    { "uid" "UID" { VARCHAR 255 } +not-null+ }
+} define-persistent
+
+: touch-permit ( permit -- )
+    realm get touch-state ;
+
+: get-permit-uid ( id -- uid )
+    permit get-state {
+        [ ]
+        [ session>> session get id>> = ]
+        [ [ touch-permit ] [ uid>> ] bi ]
+    } 1&& ;
+
+: make-permit ( uid -- id )
+    permit new
+        swap >>uid
+        session get id>> >>session
+    [ touch-permit ] [ insert-tuple ] [ id>> ] tri ;
+                                                                    
+: delete-permit ( id -- )
+    permit new-server-state delete-tuples ;

diff --git a/extra/furnace/auth/providers/assoc/assoc-tests.factor b/extra/furnace/auth/providers/assoc/assoc-tests.factor
index 8f9eeaa7a5ddf2a8678f1e5cf37871d46c6a2fe0..8fe1dd4dd4c5d678ea7e1c640f7a030e34fd4307 100755 (executable)
--- a/extra/furnace/auth/providers/assoc/assoc-tests.factor
+++ b/extra/furnace/auth/providers/assoc/assoc-tests.factor
@@ -1,11 +1,11 @@
 IN: furnace.auth.providers.assoc.tests\r
-USING: furnace.actions furnace.auth.providers \r
+USING: furnace.actions furnace.auth furnace.auth.providers \r
 furnace.auth.providers.assoc furnace.auth.login\r
 tools.test namespaces accessors kernel ;\r
 \r
-<action> <login>\r
+<action> "Test" <login-realm>\r
     <users-in-memory> >>users\r
-login set\r
+realm set\r
 \r
 [ t ] [\r
     "slava" <user>\r

diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index 6b47bc681b0a82c1139a5668c67be05af68a89d4..521f8a3bc1cb47a857905f7ec38ca758509fb3b6 100644 (file)
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@@ -96,6 +96,19 @@ M: object modify-form drop ;
     request get url>>
     [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ;
 
+: cookie-client-state ( key request -- value/f )
+    swap get-cookie dup [ value>> ] when ;
+
+: post-client-state ( key request -- value/f )
+    request-params at ;
+
+: client-state ( key -- value/f )
+    request get dup method>> {
+        { "GET" [ cookie-client-state ] }
+        { "HEAD" [ cookie-client-state ] }
+        { "POST" [ post-client-state ] }
+    } case ;
+
 SYMBOL: exit-continuation
 
 : exit-with ( value -- )

diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor
index fe8053fc9cee2384b68ba9779861ba3afaeda3c0..bb0a844269c1b5108351df08db57134209b4b069 100755 (executable)
--- a/extra/furnace/sessions/sessions.factor
+++ b/extra/furnace/sessions/sessions.factor
@@ -98,20 +98,6 @@ M: session-saver dispose
 
 : session-id-key "__s" ;
 
-: cookie-session-id ( request -- id/f )
-    session-id-key get-cookie
-    dup [ value>> string>number ] when ;
-
-: post-session-id ( request -- id/f )
-    session-id-key swap request-params at string>number ;
-
-: request-session-id ( -- id/f )
-    request get dup method>> {
-        { "GET" [ cookie-session-id ] }
-        { "HEAD" [ cookie-session-id ] }
-        { "POST" [ post-session-id ] }
-    } case ;
-
 : verify-session ( session -- session )
     sessions get verify?>> [
         dup [
@@ -123,16 +109,18 @@ M: session-saver dispose
     ] when ;
 
 : request-session ( -- session/f )
-    request-session-id get-session verify-session ;
+    session-id-key
+    client-state dup [ string>number ] when
+    get-session verify-session ;
 
-: <session-cookie> ( id -- cookie )
-    session-id-key <cookie>
+: <session-cookie> ( -- cookie )
+    session get id>> session-id-key <cookie>
         "$sessions" resolve-base-path >>path
         sessions get timeout>> from-now >>expires
         sessions get domain>> >>domain ;
 
 : put-session-cookie ( response -- response' )
-    session get id>> number>string <session-cookie> put-cookie ;
+    <session-cookie> put-cookie ;
 
 M: sessions modify-form ( responder -- )
     drop session get id>> session-id-key hidden-form-field ;

diff --git a/extra/http/http.factor b/extra/http/http.factor
index d2a0b0f922e60778baa45210e7d4eb3da20f5a97..025e2c8441c12278a04c5c138aa3bc9141f701a2 100755 (executable)
--- a/extra/http/http.factor
+++ b/extra/http/http.factor
@@ -99,23 +99,29 @@ TUPLE: cookie name value path domain expires max-age http-only ;
         drop
     ] { } make ;
 
+: check-cookie-string ( string -- string' )
+    dup "=;'\"" intersect empty?
+    [ "Bad cookie name or value" throw ] unless ;
+
 : (unparse-cookie) ( key value -- )
     {
         { f [ drop ] }
-        { t [ , ] }
+        { t [ check-cookie-string , ] }
         [
             {
                 { [ dup timestamp? ] [ timestamp>cookie-string ] }
                 { [ dup duration? ] [ dt>seconds number>string ] }
+                { [ dup real? ] [ number>string ] }
                 [ ]
             } cond
-            "=" swap 3append ,
+            check-cookie-string "=" swap check-cookie-string 3append ,
         ]
     } case ;
 
 : unparse-cookie ( cookie -- strings )
     [
-        dup name>> >lower over value>> (unparse-cookie)
+        dup name>> check-cookie-string >lower
+        over value>> (unparse-cookie)
         "path" over path>> (unparse-cookie)
         "domain" over domain>> (unparse-cookie)
         "expires" over expires>> (unparse-cookie)

diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor
index 9d76c82e4a4dee9c22c4a0bfb6a1094c8b57475b..83fcf6f4a937a18b0f89a13d301201a68ed15878 100755 (executable)
--- a/extra/http/server/static/static.factor
+++ b/extra/http/server/static/static.factor
@@ -82,7 +82,7 @@ TUPLE: file-responder root hook special allow-listings ;
     "index.html" append-path dup exists? [ drop f ] unless ;\r
 \r
 : serve-directory ( filename -- response )\r
-    request get path>> "/" tail? [\r
+    request get url>> path>> "/" tail? [\r
         dup\r
         find-index [ serve-file ] [ list-directory ] ?if\r
     ] [\r

diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 34bad6db18b25656343bfee0b38aef4e1445630a..13c445b0a8e4433fca59dd38210b55bcb5bd4b23 100644 (file)
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -284,6 +284,11 @@ M: revision feed-entry-url id>> revision-url ;
     <boilerplate>
         { wiki "page-common" } >>template ;
 
+: init-sidebar ( -- )
+    "Sidebar" latest-revision [
+        "sidebar" [ from-object ] nest-form
+    ] when* ;
+
 : <wiki> ( -- dispatcher )
     wiki new-dispatcher
         <main-article-action> <article-boilerplate> "" add-responder
@@ -301,5 +306,5 @@ M: revision feed-entry-url id>> revision-url ;
         <list-changes-feed-action> "changes.atom" add-responder
         <delete-action> "delete" add-responder
     <boilerplate>
-        [ "sidebar" [ "Sidebar" latest-revision from-object ] nest-form ] >>init
+        [ init-sidebar ] >>init
         { wiki "wiki-common" } >>template ;