From 73105cc043b425ce92ee283cb65a60fa4579bd05 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 16 Jun 2008 03:46:54 -0500 Subject: [PATCH] Debugging furnace.auth refactoring --- extra/furnace/auth/auth.factor | 4 +++- .../auth/features/edit-profile/edit-profile.factor | 2 +- .../auth/features/edit-profile/edit-profile.xml | 2 +- extra/furnace/auth/login/login.factor | 12 ++++++------ extra/furnace/auth/login/login.xml | 4 ++-- extra/furnace/furnace.factor | 2 +- extra/webapps/blogs/blogs-common.xml | 8 ++++---- extra/webapps/pastebin/pastebin-common.xml | 8 ++++---- extra/webapps/planet/planet-common.xml | 8 ++++---- extra/webapps/todo/todo.xml | 6 +++--- extra/webapps/user-admin/user-admin.xml | 6 +++--- extra/webapps/wiki/wiki-common.xml | 8 ++++---- 12 files changed, 36 insertions(+), 34 deletions(-) diff --git a/extra/furnace/auth/auth.factor b/extra/furnace/auth/auth.factor index d10ba48ce5..9bb7ea105e 100755 --- a/extra/furnace/auth/auth.factor +++ b/extra/furnace/auth/auth.factor @@ -17,6 +17,8 @@ IN: furnace.auth SYMBOL: logged-in-user +: logged-in? ( -- ? ) logged-in-user get >boolean ; + GENERIC: init-user-profile ( responder -- ) M: object init-user-profile drop ; @@ -114,7 +116,7 @@ TUPLE: protected < filter-responder description capabilities ; : check-capabilities ( responder user/f -- ? ) { { [ dup not ] [ 2drop f ] } - { [ dup deleted>> ] [ 2drop f ] } + { [ dup deleted>> 1 = ] [ 2drop f ] } [ [ capabilities>> ] bi@ subset? ] } cond ; diff --git a/extra/furnace/auth/features/edit-profile/edit-profile.factor b/extra/furnace/auth/features/edit-profile/edit-profile.factor index 4edb4ac364..e03fca99a5 100644 --- a/extra/furnace/auth/features/edit-profile/edit-profile.factor +++ b/extra/furnace/auth/features/edit-profile/edit-profile.factor @@ -64,4 +64,4 @@ IN: furnace.auth.features.edit-profile "edit-profile" add-responder ; : allow-edit-profile? ( -- ? ) - realm get get responders>> "edit-profile" swap key? ; + realm get responders>> "edit-profile" swap key? ; diff --git a/extra/furnace/auth/features/edit-profile/edit-profile.xml b/extra/furnace/auth/features/edit-profile/edit-profile.xml index 6beaf5de6d..011cc2bdf8 100644 --- a/extra/furnace/auth/features/edit-profile/edit-profile.xml +++ b/extra/furnace/auth/features/edit-profile/edit-profile.xml @@ -4,7 +4,7 @@ Edit Profile - + diff --git a/extra/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor index 1f81c488cc..6a59c01c63 100755 --- a/extra/furnace/auth/login/login.factor +++ b/extra/furnace/auth/login/login.factor @@ -13,13 +13,16 @@ IN: furnace.auth.login TUPLE: login-realm < realm ; +M: login-realm logged-in-username + drop session get uid>> ; + : set-uid ( username -- ) session get [ (>>uid) ] [ (session-changed) ] bi ; : successful-login ( user -- response ) username>> set-uid URL" $realm" end-aside ; -: logout ( -- ) f set-uid ; +: logout ( -- ) f set-uid URL" $realm" end-aside ; SYMBOL: description SYMBOL: capabilities @@ -53,17 +56,14 @@ SYMBOL: capabilities : ( -- action ) - [ logout URL" $login-realm" end-aside ] >>submit ; + [ logout ] >>submit ; M: login-realm login-required* drop begin-aside protected get description>> description set protected get capabilities>> capabilities set - URL" $login/login" flashed-variables ; - -M: login-realm logged-in-username - drop session get uid>> ; + URL" $realm/login" flashed-variables ; : ( responder name -- auth ) login-realm new-realm diff --git a/extra/furnace/auth/login/login.xml b/extra/furnace/auth/login/login.xml index a7ac92bf44..81f9520e76 100644 --- a/extra/furnace/auth/login/login.xml +++ b/extra/furnace/auth/login/login.xml @@ -43,11 +43,11 @@

- + Register | - + Recover Password

diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index e9d1b29da8..6b47bc681b 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -31,7 +31,7 @@ IN: furnace : base-path ( string -- pair ) dup responder-nesting get - [ second class word-name = ] with find nip + [ second class superclasses [ word-name = ] with contains? ] with find nip [ first ] [ "No such responder: " swap append throw ] ?if ; : resolve-base-path ( string -- string' ) diff --git a/extra/webapps/blogs/blogs-common.xml b/extra/webapps/blogs/blogs-common.xml index 965f059abd..e809c0e7f5 100644 --- a/extra/webapps/blogs/blogs-common.xml +++ b/extra/webapps/blogs/blogs-common.xml @@ -12,13 +12,13 @@ | My Posts | New Post - + - - | Edit Profile + + | Edit Profile - | Logout + | Logout diff --git a/extra/webapps/pastebin/pastebin-common.xml b/extra/webapps/pastebin/pastebin-common.xml index 47f7666b22..b95f3f7b64 100644 --- a/extra/webapps/pastebin/pastebin-common.xml +++ b/extra/webapps/pastebin/pastebin-common.xml @@ -11,13 +11,13 @@ Pastes | New Paste - + - - | Edit Profile + + | Edit Profile - | Logout + | Logout diff --git a/extra/webapps/planet/planet-common.xml b/extra/webapps/planet/planet-common.xml index 34ee73da67..6c0affd17f 100644 --- a/extra/webapps/planet/planet-common.xml +++ b/extra/webapps/planet/planet-common.xml @@ -9,12 +9,12 @@ | Atom Feed | Admin - - - | Edit Profile + + + | Edit Profile - | Logout + | Logout diff --git a/extra/webapps/todo/todo.xml b/extra/webapps/todo/todo.xml index e087fbfcfc..f7500cdad2 100644 --- a/extra/webapps/todo/todo.xml +++ b/extra/webapps/todo/todo.xml @@ -8,11 +8,11 @@ List Items | Add Item - - | Edit Profile + + | Edit Profile - | Logout + | Logout

diff --git a/extra/webapps/user-admin/user-admin.xml b/extra/webapps/user-admin/user-admin.xml index 9cb9ef0a0a..2141fdc1d9 100644 --- a/extra/webapps/user-admin/user-admin.xml +++ b/extra/webapps/user-admin/user-admin.xml @@ -6,11 +6,11 @@ List Users | Add User - - | Edit Profile + + | Edit Profile - | Logout + | Logout

diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml index 1d08d3832d..0abd36a7cd 100644 --- a/extra/webapps/wiki/wiki-common.xml +++ b/extra/webapps/wiki/wiki-common.xml @@ -14,13 +14,13 @@ | All Articles | Recent Changes - + - - | Edit Profile + + | Edit Profile - | Logout + | Logout