diff --git a/extra/http/server/auth/auth.factor b/extra/http/server/auth/auth.factor
new file mode 100755
index 0000000000..a53905bce1
--- /dev/null
+++ b/extra/http/server/auth/auth.factor
@@ -0,0 +1,25 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: http.server.auth
+USING: new-slots accessors http.server.auth.providers.null
+http.server.auth.strategies.null ;
+
+TUPLE: authentication responder provider strategy ;
+
+: <authentication> ( responder -- authentication )
+ null-auth-provider null-auth-strategy
+ authentication construct-boa ;
+
+SYMBOL: current-user-id
+SYMBOL: auth-provider
+SYMBOL: auth-strategy
+
+M: authentication call-responder ( request path responder -- response )
+ dup provider>> auth-provider set
+ dup strategy>> auth-strategy set
+ pick auth-provider get logged-in? dup current-user-id set
+ [
+ responder>> call-responder
+ ] [
+ 2drop auth-provider get require-login
+ ] if* ;
diff --git a/extra/http/server/auth/basic/basic.factor b/extra/http/server/auth/basic/basic.factor
new file mode 100755
index 0000000000..2ea74febba
--- /dev/null
+++ b/extra/http/server/auth/basic/basic.factor
@@ -0,0 +1,41 @@
+! Copyright (c) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors new-slots quotations assocs kernel splitting
+base64 html.elements io combinators http.server
+http.server.auth.providers http.server.auth.providers.null
+http sequences ;
+IN: http.server.auth.basic
+
+TUPLE: basic-auth responder realm provider ;
+
+C: <basic-auth> basic-auth
+
+: authorization-ok? ( provider header -- ? )
+ #! Given the realm and the 'Authorization' header,
+ #! authenticate the user.
+ dup [
+ " " split1 swap "Basic" = [
+ base64> ":" split1 spin check-login
+ ] [
+ 2drop f
+ ] if
+ ] [
+ 2drop f
+ ] if ;
+
+: <401> ( realm -- response )
+ 401 "Unauthorized" <trivial-response>
+ "Basic realm=\"" rot "\"" 3append
+ "WWW-Authenticate" set-header
+ [
+ <html> <body>
+ "Username or Password is invalid" write
+ </body> </html>
+ ] >>body ;
+
+: logged-in? ( request responder -- ? )
+ provider>> swap "authorization" header authorization-ok? ;
+
+M: basic-auth call-responder ( request path responder -- response )
+ pick over logged-in?
+ [ responder>> call-responder ] [ 2nip realm>> <401> ] if ;
diff --git a/extra/http/server/auth/login/login.factor b/extra/http/server/auth/login/login.factor
new file mode 100755
index 0000000000..e2f9a3608a
--- /dev/null
+++ b/extra/http/server/auth/login/login.factor
@@ -0,0 +1,69 @@
+! Copyright (c) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors new-slots quotations assocs kernel splitting
+base64 html.elements io combinators http.server
+http.server.auth.providers http.server.actions
+http.server.sessions http.server.templating.fhtml http sequences
+io.files namespaces ;
+IN: http.server.auth.login
+
+TUPLE: login-auth responder provider ;
+
+C: (login-auth) login-auth
+
+SYMBOL: logged-in?
+SYMBOL: provider
+SYMBOL: post-login-url
+
+: login-page ( -- response )
+ "text/html" <content> [
+ "extra/http/server/auth/login/login.fhtml"
+ resource-path run-template-file
+ ] >>body ;
+
+: <login-action>
+ <action>
+ [ login-page ] >>get
+
+ {
+ { "name" [ ] }
+ { "password" [ ] }
+ } >>post-params
+ [
+ "password" get
+ "name" get
+ provider sget check-login [
+ t logged-in? sset
+ post-login-url sget <permanent-redirect>
+ ] [
+ login-page
+ ] if
+ ] >>post ;
+
+: <logout-action>
+ <action>
+ [
+ f logged-in? sset
+ request get "login" <permanent-redirect>
+ ] >>post ;
+
+M: login-auth call-responder ( request path responder -- response )
+ logged-in? sget
+ [ responder>> call-responder ] [
+ pick method>> "GET" = [
+ nip
+ provider>> provider sset
+ dup request-url post-login-url sset
+ "login" f session-link <permanent-redirect>
+ ] [
+ 3drop <400>
+ ] if
+ ] if ;
+
+: <login-auth> ( responder provider -- auth )
+ (login-auth)
+ <dispatcher>
+ swap >>default
+ <login-action> "login" add-responder
+ <logout-action> "logout" add-responder
+ <cookie-sessions> ;
diff --git a/extra/http/server/auth/login/login.fhtml b/extra/http/server/auth/login/login.fhtml
new file mode 100755
index 0000000000..9bb1438588
--- /dev/null
+++ b/extra/http/server/auth/login/login.fhtml
@@ -0,0 +1,25 @@
+<html>
+<body>
+<h1>Login required</h1>
+
+<form method="POST" action="login">
+<table>
+
+<tr>
+<td>User name:</td>
+<td><input name="name" /></td>
+</tr>
+
+<tr>
+<td>Password:</td>
+<td><input type="password" name="password" /></td>
+</tr>
+
+</table>
+
+<input type="submit" value="Log in" />
+
+</form>
+
+</body>
+</html>
diff --git a/extra/http/server/auth/providers/assoc/assoc-tests.factor b/extra/http/server/auth/providers/assoc/assoc-tests.factor
new file mode 100755
index 0000000000..3270fe06e3
--- /dev/null
+++ b/extra/http/server/auth/providers/assoc/assoc-tests.factor
@@ -0,0 +1,18 @@
+IN: http.server.auth.providers.assoc.tests
+USING: http.server.auth.providers
+http.server.auth.providers.assoc tools.test
+namespaces ;
+
+<assoc-auth-provider> "provider" set
+
+"slava" "provider" get new-user
+
+[ "slava" "provider" get new-user ] [ user-exists? ] must-fail-with
+
+[ f ] [ "fdasf" "slava" "provider" get check-login ] unit-test
+
+[ "xx" "blah" "provider" get set-password ] [ no-such-user? ] must-fail-with
+
+"fdasf" "slava" "provider" get set-password
+
+[ t ] [ "fdasf" "slava" "provider" get check-login ] unit-test
diff --git a/extra/http/server/auth/providers/assoc/assoc.factor b/extra/http/server/auth/providers/assoc/assoc.factor
new file mode 100755
index 0000000000..d57be622c7
--- /dev/null
+++ b/extra/http/server/auth/providers/assoc/assoc.factor
@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: http.server.auth.providers.assoc
+USING: new-slots accessors assocs kernel
+http.server.auth.providers ;
+
+TUPLE: assoc-auth-provider assoc ;
+
+: <assoc-auth-provider> ( -- provider )
+ H{ } clone assoc-auth-provider construct-boa ;
+
+M: assoc-auth-provider check-login
+ assoc>> at = ;
+
+M: assoc-auth-provider new-user
+ assoc>>
+ 2dup key? [ drop user-exists ] when
+ t -rot set-at ;
+
+M: assoc-auth-provider set-password
+ assoc>>
+ 2dup key? [ drop no-such-user ] unless
+ set-at ;
diff --git a/extra/http/server/auth/providers/db/db-tests.factor b/extra/http/server/auth/providers/db/db-tests.factor
new file mode 100755
index 0000000000..384e094f39
--- /dev/null
+++ b/extra/http/server/auth/providers/db/db-tests.factor
@@ -0,0 +1,24 @@
+IN: http.server.auth.providers.db.tests
+USING: http.server.auth.providers
+http.server.auth.providers.db tools.test
+namespaces db db.sqlite db.tuples continuations ;
+
+db-auth-provider "provider" set
+
+"auth-test.db" sqlite-db [
+
+ [ user drop-table ] ignore-errors
+ [ user create-table ] ignore-errors
+
+ "slava" "provider" get new-user
+
+ [ "slava" "provider" get new-user ] [ user-exists? ] must-fail-with
+
+ [ f ] [ "fdasf" "slava" "provider" get check-login ] unit-test
+
+ [ "xx" "blah" "provider" get set-password ] [ no-such-user? ] must-fail-with
+
+ "fdasf" "slava" "provider" get set-password
+
+ [ t ] [ "fdasf" "slava" "provider" get check-login ] unit-test
+] with-db
diff --git a/extra/http/server/auth/providers/db/db.factor b/extra/http/server/auth/providers/db/db.factor
new file mode 100755
index 0000000000..9583122875
--- /dev/null
+++ b/extra/http/server/auth/providers/db/db.factor
@@ -0,0 +1,53 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: db db.tuples db.types new-slots accessors
+http.server.auth.providers kernel ;
+IN: http.server.auth.providers.db
+
+TUPLE: user name password ;
+
+: <user> user construct-empty ;
+
+user "USERS"
+{
+ { "name" "NAME" { VARCHAR 256 } +assigned-id+ }
+ { "password" "PASSWORD" { VARCHAR 256 } +not-null+ }
+} define-persistent
+
+: init-users-table ( -- )
+ user create-table ;
+
+TUPLE: db-auth-provider ;
+
+: db-auth-provider T{ db-auth-provider } ;
+
+M: db-auth-provider check-login
+ drop
+ <user>
+ swap >>name
+ swap >>password
+ select-tuple >boolean ;
+
+M: db-auth-provider new-user
+ drop
+ [
+ <user>
+ swap >>name
+
+ dup select-tuple [ name>> user-exists ] when
+
+ "unassigned" >>password
+
+ insert-tuple
+ ] with-transaction ;
+
+M: db-auth-provider set-password
+ drop
+ [
+ <user>
+ swap >>name
+
+ dup select-tuple [ ] [ no-such-user ] ?if
+
+ swap >>password update-tuple
+ ] with-transaction ;
diff --git a/extra/http/server/auth/providers/null/null.factor b/extra/http/server/auth/providers/null/null.factor
new file mode 100755
index 0000000000..702111972e
--- /dev/null
+++ b/extra/http/server/auth/providers/null/null.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: http.server.auth.providers kernel ;
+IN: http.server.auth.providers.null
+
+TUPLE: null-auth-provider ;
+
+: null-auth-provider T{ null-auth-provider } ;
+
+M: null-auth-provider check-login 3drop f ;
+
+M: null-auth-provider new-user 3drop f ;
+
+M: null-auth-provider set-password 3drop f ;
diff --git a/extra/http/server/auth/providers/providers.factor b/extra/http/server/auth/providers/providers.factor
new file mode 100755
index 0000000000..1e0fd33a67
--- /dev/null
+++ b/extra/http/server/auth/providers/providers.factor
@@ -0,0 +1,18 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel ;
+IN: http.server.auth.providers
+
+GENERIC: check-login ( password user provider -- ? )
+
+GENERIC: new-user ( user provider -- )
+
+GENERIC: set-password ( password user provider -- )
+
+TUPLE: user-exists name ;
+
+: user-exists ( name -- * ) \ user-exists construct-boa throw ;
+
+TUPLE: no-such-user name ;
+
+: no-such-user ( name -- * ) \ no-such-user construct-boa throw ;
diff --git a/extra/http/server/sessions/sessions-tests.factor b/extra/http/server/sessions/sessions-tests.factor
index 4c21ba3c8d..d771737c73 100755
--- a/extra/http/server/sessions/sessions-tests.factor
+++ b/extra/http/server/sessions/sessions-tests.factor
@@ -4,6 +4,12 @@ kernel accessors ;
: with-session \ session swap with-variable ; inline
+TUPLE: foo ;
+
+C: <foo> foo
+
+M: foo init-session drop 0 "x" sset ;
+
"1234" f <session> [
[ ] [ 3 "x" sset ] unit-test
@@ -18,8 +24,7 @@ kernel accessors ;
[ t ] [ f <cookie-sessions> cookie-sessions? ] unit-test
[ ] [
- f <url-sessions>
- [ 0 "x" sset ] >>init
+ <foo> <url-sessions>
"manager" set
] unit-test
diff --git a/extra/http/server/sessions/sessions.factor b/extra/http/server/sessions/sessions.factor
index 2977e5938d..d7fed6bb64 100755
--- a/extra/http/server/sessions/sessions.factor
+++ b/extra/http/server/sessions/sessions.factor
@@ -11,6 +11,8 @@ IN: http.server.sessions
GENERIC: init-session ( responder -- )
+M: dispatcher init-session drop ;
+
TUPLE: session-manager responder sessions ;
: <session-manager> ( responder class -- responder' )
diff --git a/extra/http/server/templating/fhtml/fhtml.factor b/extra/http/server/templating/fhtml/fhtml.factor
index 37f4b85c51..e5770affc5 100755
--- a/extra/http/server/templating/fhtml/fhtml.factor
+++ b/extra/http/server/templating/fhtml/fhtml.factor
@@ -9,7 +9,7 @@ assocs ;
IN: http.server.templating.fhtml
-: templating-vocab ( -- vocab-name ) "http.server.templating" ;
+: templating-vocab ( -- vocab-name ) "http.server.templating.fhtml" ;
! See apps/http-server/test/ or libs/furnace/ for template usage
! examples