basis/furnace/auth/basic/basic.factor

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