lib/Catalyst/Plugin/Authentication.pm

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Plugin::Authentication;
   4
   5 use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
   6
   7 BEGIN {
   8     __PACKAGE__->mk_accessors(qw/_user/);
   9     __PACKAGE__->mk_classdata($_) for qw/_auth_stores _auth_store_names/;
  10 }
  11
  12 use strict;
  13 use warnings;
  14
  15 use Tie::RefHash;
  16 use Class::Inspector;
  17
  18 #BEGIN {
  19 #       require constant;
  20 #       constant->import(have_want => eval { require Want });
  21 #}
  22
  23 our $VERSION = "0.02";
  24
  25 sub set_authenticated {
  26     my ( $c, $user ) = @_;
  27
  28     $c->user($user);
  29     $c->request->{user} = $user;    # compatibility kludge
  30
  31     if (    $c->isa("Catalyst::Plugin::Session")
  32         and $c->config->{authentication}{use_session}
  33         and $user->supports("session") )
  34     {
  35         $c->save_user_in_session($user);
  36     }
  37
  38     $c->NEXT::set_authenticated($user);
  39 }
  40
  41 sub user {
  42     my $c = shift;
  43
  44     if (@_) {
  45         return $c->_user(@_);
  46     }
  47
  48     my $user = $c->_user;
  49
  50     if ( $user and !Scalar::Util::blessed($user) ) {
  51 #               return 1 if have_want() && Want::want("BOOL");
  52         return $c->auth_restore_user($user);
  53     }
  54
  55     return $user;
  56 }
  57
  58 sub save_user_in_session {
  59     my ( $c, $user ) = @_;
  60
  61     my $store = $user->store || ref $user;
  62     $c->session->{__user_store} = $c->get_auth_store_name($store) || $store;
  63     $c->session->{__user} = $user->for_session;
  64 }
  65
  66 sub logout {
  67     my $c = shift;
  68
  69     $c->user(undef);
  70
  71     if (    $c->isa("Catalyst::Plugin::Session")
  72         and $c->config->{authentication}{use_session} )
  73     {
  74         delete @{ $c->session }{qw/__user __user_store/};
  75     }
  76 }
  77
  78 sub get_user {
  79     my ( $c, $uid ) = @_;
  80
  81     if ( my $store = $c->default_auth_store ) {
  82         return $store->get_user($uid);
  83     }
  84     else {
  85         Catalyst::Exception->throw(
  86                 "The user id $uid was passed to an authentication "
  87               . "plugin, but no default store was specified" );
  88     }
  89 }
  90
  91 sub prepare {
  92     my $c = shift->NEXT::prepare(@_);
  93
  94     if ( $c->isa("Catalyst::Plugin::Session")
  95         and !$c->user )
  96     {
  97         if ( $c->sessionid and my $frozen_user = $c->session->{__user} ) {
  98             $c->_user($frozen_user);
  99         }
 100     }
 101
 102     return $c;
 103 }
 104
 105 sub auth_restore_user {
 106     my ( $c, $frozen_user, $store_name ) = @_;
 107
 108     return
 109       unless $c->isa("Catalyst::Plugin::Session")
 110       and $c->config->{authentication}{use_session}
 111       and $c->sessionid;
 112
 113     $store_name  ||= $c->session->{__user_store};
 114     $frozen_user ||= $c->session->{__user};
 115
 116     my $store = $c->get_auth_store($store_name);
 117     $c->_user( my $user = $store->from_session( $c, $frozen_user ) );
 118
 119     return $user;
 120
 121 }
 122
 123 sub setup {
 124     my $c = shift;
 125
 126     my $cfg = $c->config->{authentication} || {};
 127
 128     %$cfg = (
 129         use_session => 1,
 130         %$cfg,
 131     );
 132
 133     $c->register_auth_stores(
 134         default => $cfg->{store},
 135         %{ $cfg->{stores} || {} },
 136     );
 137
 138     $c->NEXT::setup(@_);
 139 }
 140
 141 sub get_auth_store {
 142     my ( $self, $name ) = @_;
 143     $self->auth_stores->{$name} || ( Class::Inspector->loaded($name) && $name );
 144 }
 145
 146 sub get_auth_store_name {
 147     my ( $self, $store ) = @_;
 148     $self->auth_store_names->{$store};
 149 }
 150
 151 sub register_auth_stores {
 152     my ( $self, %new ) = @_;
 153
 154     foreach my $name ( keys %new ) {
 155         my $store = $new{$name} or next;
 156         $self->auth_stores->{$name}       = $store;
 157         $self->auth_store_names->{$store} = $name;
 158     }
 159 }
 160
 161 sub auth_stores {
 162     my $self = shift;
 163     $self->_auth_stores(@_) || $self->_auth_stores( {} );
 164 }
 165
 166 sub auth_store_names {
 167     my $self = shift;
 168
 169     $self->_auth_store_names || do {
 170         tie my %hash, 'Tie::RefHash';
 171         $self->_auth_store_names( \%hash );
 172       }
 173 }
 174
 175 sub default_auth_store {
 176     my $self = shift;
 177
 178     if ( my $new = shift ) {
 179         $self->register_auth_stores( default => $new );
 180     }
 181
 182     $self->get_auth_store("default");
 183 }
 184
 185 __PACKAGE__;
 186
 187 __END__
 188
 189 =pod
 190
 191 =head1 NAME
 192
 193 Catalyst::Plugin::Authentication - Infrastructure plugin for the Catalyst
 194 authentication framework.
 195
 196 =head1 SYNOPSIS
 197
 198         use Catalyst qw/
 199                 Authentication
 200                 Authentication::Store::Foo
 201                 Authentication::Credential::Password
 202         /;
 203
 204 =head1 DESCRIPTION
 205
 206 The authentication plugin is used by the various authentication and
 207 authorization plugins in catalyst.
 208
 209 It defines the notion of a logged in user, and provides integration with the
 210 L<Catalyst::Plugin::Session> plugin,
 211
 212 =head1 METHODS
 213
 214 =over 4
 215
 216 =item user
 217
 218 Returns the currently logged user or undef if there is none.
 219
 220 =item logout
 221
 222 Delete the currently logged in user from C<user> and the session.
 223
 224 =item get_user $uid
 225
 226 Delegate C<get_user> to the default store.
 227
 228 =back
 229
 230 =head1 METHODS FOR STORE MANAGEMENT
 231
 232 =item default_auth_store
 233
 234 Return the store whose name is 'default'.
 235
 236 This is set to C<<$c->config->{authentication}{store}>> if that value exists,
 237 or by using a Store plugin:
 238
 239         use Catalyst qw/Authentication Authentication::Store::Minimal/;
 240
 241 Sets the default store to
 242 L<Catalyst::Plugin::Authentication::Store::Minimal::Backend>.
 243
 244
 245 =item get_auth_store $name
 246
 247 Return the store whose name is $name.
 248
 249 =item get_auth_store_name $store
 250
 251 Return the name of the store $store.
 252
 253 =item auth_stores
 254
 255 A hash keyed by name, with the stores registered in the app.
 256
 257 =item auth_store_names
 258
 259 A ref-hash keyed by store, which contains the names of the stores.
 260
 261 =item register_auth_stores %stores_by_name
 262
 263 Register stores into the application.
 264
 265 =head1 INTERNAL METHODS
 266
 267 =over 4
 268
 269 =item set_authenticated $user
 270
 271 Marks a user as authenticated. Should be called from a
 272 C<Catalyst::Plugin::Authentication::Credential> plugin after successful
 273 authentication.
 274
 275 This involves setting C<user> and the internal data in C<session> if
 276 L<Catalyst::Plugin::Session> is loaded.
 277
 278 =item auth_restore_user $user
 279
 280 Used to restore a user from the session, by C<user> only when it's actually
 281 needed.
 282
 283 =item save_user_in_session $user
 284
 285 Used to save the user in a session.
 286
 287 =item prepare
 288
 289 Revives a user from the session object if there is one.
 290
 291 =item setup
 292
 293 Sets the default configuration parameters.
 294
 295 =item
 296
 297 =back
 298
 299 =head1 CONFIGURATION
 300
 301 =over 4
 302
 303 =item use_session
 304
 305 Whether or not to store the user's logged in state in the session, if the
 306 application is also using the L<Catalyst::Plugin::Authentication> plugin.
 307
 308 =back
 309
 310 =head1 SEE ALSO
 311
 312 L<Catalyst::Plugin::Authentication::Credential::Password>,
 313 L<Catalyst::Plugin::Authentication::Store::Minimal>,
 314 L<Catalyst::Plugin::Authorization::ACL>,
 315 L<Catalyst::Plugin::Authorization::Roles>.
 316
 317 =head1 AUTHOR
 318
 319 Yuval Kogman, C<nothingmuch@woobling.org>
 320
 321 =head1 COPYRIGHT & LICNESE
 322
 323         Copyright (c) 2005 the aforementioned authors. All rights
 324         reserved. This program is free software; you can redistribute
 325         it and/or modify it under the same terms as Perl itself.
 326
 327 =cut
 328