1 ! Copyright (c) 2007 Chris Double.
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
3 USING: accessors kernel splitting base64 namespaces make strings
\r
4 http http.server.responses furnace.auth ;
\r
5 IN: furnace.auth.basic
\r
7 TUPLE: basic-auth-realm < realm ;
\r
9 : <basic-auth-realm> ( responder name -- realm )
\r
10 basic-auth-realm new-realm ;
\r
12 : parse-basic-auth ( header -- username/f password/f )
\r
14 " " split1 swap "Basic" = [
\r
15 base64> >string ":" split1
\r
19 : <401> ( realm -- response )
\r
20 401 "Invalid username or password" <trivial-response>
\r
21 [ "Basic realm=\"" % swap % "\"" % ] "" make "WWW-Authenticate" set-header ;
\r
23 M: basic-auth-realm login-required* ( description capabilities realm -- response )
\r
26 M: basic-auth-realm logged-in-username ( realm -- uid )
\r
28 request get "authorization" header parse-basic-auth
\r
29 dup [ over check-login swap and ] [ 2drop f ] if ;
\r
31 M: basic-auth-realm init-realm drop ;
\r