lib/Catalyst/Plugin/Authentication/Credential/TypeKey.pm

   1 package Catalyst::Plugin::Authentication::Credential::TypeKey;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Authen::TypeKey;
   7 use File::Spec;
   8 use Catalyst::Utils ();
   9 use NEXT;
  10 use UNIVERSAL::require;
  11 use Scalar::Util ();
  12
  13 our $VERSION = '0.3';
  14
  15 sub setup {
  16     my $c = shift;
  17
  18     my $config = $c->config->{authentication}{typekey} ||= {};
  19
  20     $config->{typekey_object} ||= do {
  21         ( $config->{user_class} ||=
  22               "Catalyst::Plugin::Authentication::User::Hash" )->require;
  23
  24         $config->{key_cache} ||=
  25           File::Spec->catfile( Catalyst::Utils::class2tempdir( $c, 1 ),
  26             'regkeys.txt' );
  27
  28         my $typekey = Authen::TypeKey->new;
  29
  30         for ( grep { exists $config->{$_} }
  31             qw/expires key_cache key_url token version skip_expiry_check/ )
  32         {
  33             $typekey->$_( $config->{$_} );
  34         }
  35
  36         $typekey;
  37     };
  38
  39     $c->NEXT::setup(@_);
  40 }
  41
  42 sub authenticate_typekey {
  43     my ( $c, @p ) = @_;
  44
  45     my ( $user, $p );
  46     if ( @p == 1 ) {
  47         if ( Scalar::Util::blessed( $p[0] ) ) {
  48             $user = $p[0];
  49             Catalyst::Exception->throw(
  50                     "Attempted to authenticate user object, but "
  51                   . "user doesnt't support 'typekey_credentials'" )
  52               unless $user->supports(qw/typekey_credentials/);
  53             $p = $user->typekey_credentials;
  54         }
  55         else {
  56             $p = $p[0];
  57         }
  58     }
  59     else {
  60         $p = @p ? {@p} : undef;
  61     }
  62
  63     my $config = $c->config->{authentication}{typekey};
  64
  65     my $typekey = $p && delete( $p->{typekey_object} )
  66       || $config->{typekey_object};
  67
  68     $p ||= $c->req;
  69
  70     if ( my $res = $typekey->verify($p) ) {
  71         $c->log->debug("Successfully authenticated user '$res->{name}'.")
  72           if $c->debug;
  73
  74         if ( !$user and my $store = $config->{auth_store} ) {
  75             $store = $c->get_auth_store($store) unless ref $store;
  76             $user = $store->get_user( $res->{name}, $p, $res );
  77         }
  78
  79         if ( !$user ) {
  80             my $user_class = $config->{user_class};
  81             $user = $user_class->new($res);
  82         }
  83
  84         $c->set_authenticated($user);
  85
  86         return 1;
  87     }
  88     else {
  89         $c->log->debug(
  90             sprintf "Failed to authenticate user '%s'. Reason: '%s'",
  91             $p->{name} || $p->param("name"),
  92             $typekey->errstr
  93           )
  94           if $c->debug;
  95
  96         return;
  97     }
  98 }
  99
 100 1;
 101
 102 __END__
 103
 104 =head1 NAME
 105
 106 Catalyst::Plugin::Authentication::Credential::TypeKey - TypeKey Authentication
 107 for Catalyst.
 108
 109 =head1 SYNOPSIS
 110
 111     use Catalyst qw/Authentication::Credential::TypeKey/;
 112
 113     MyApp->config->{authentication}{typekey} = {
 114         token => 'xxxxxxxxxxxxxxxxxxxx',
 115     };
 116
 117     sub foo : Local {
 118                 my ( $self, $c ) = @_;
 119
 120                 if ( $c->authenticate_typekey ) {
 121
 122                 # you can also specify the params manually: $c->authenticate_typekey(
 123                 #       name => $name,
 124                 #       email => $email,
 125                 #       ...
 126                 #)
 127
 128                         # successful autentication
 129
 130                         $c->user; # this is set
 131                 }
 132         }
 133
 134
 135         sub auto : Private {
 136                 my ( $self, $c ) = @_;
 137
 138                 $c->authenticate_typekey; # uses $c->req
 139
 140                 return 1;
 141         }
 142
 143 =head1 DESCRIPTION
 144
 145 This module integrates L<Authen::TypeKey> with
 146 L<Catalyst::Plugin::Authentication>.
 147
 148 =head1 METHODS
 149
 150 =head3 authenticate_typekey %parameters
 151
 152 =head3 authenticate_typekey
 153
 154 =head3 EXTENDED METHODS
 155
 156 =head3 setup
 157
 158 Fills the config with defaults.
 159
 160 =head1 CONFIGURATION
 161
 162 C<<$c->config->{autentication}{typekey}>> is a hash with these fields (all can
 163 be left out):
 164
 165 =over 4
 166
 167 =item typekey_object
 168
 169 If this field does not exist an L<Authen::TypeKey> object will be created based
 170 on the other param and put here.
 171
 172 =item expires
 173
 174 =item key_url
 175
 176 =item token
 177
 178 =item version
 179
 180 See L<Authen::TypeKey> for all of these. If they aren't specified
 181 L<Authen::TypeKey>'s defaults will be used.
 182
 183 =item key_cache
 184
 185 Also see L<Authen::TypeKey>.
 186
 187 Defaults to C<regkeys.txt> under L<Catalyst::Utils/class2tempdir>.
 188
 189 =item auth_store
 190
 191 A store (or store name) to retrieve the user from.
 192
 193 When a user is successfully authenticated it will call this:
 194
 195         $store->get_user( $name, $parameters, $result_of_verify );
 196
 197 Where C<$parameters> is a the hash reference passed to
 198 L<Authen::TypeKey/verify>, and C<$result_of_verify> is the value returned by
 199 L<Authen::TypeKey/verify>.
 200
 201 If this is unset, L<Catalyst::Plugin::Authentication/default_auth_store> will
 202 be used instead.
 203
 204 =item user_class
 205
 206 If C<auth_store> or the default store returns nothing from get_user, this class
 207 will be used to instantiate an object by calling C<new> on the class with the
 208 return value from L<Authen::TypeKey/verify>.
 209
 210 =back
 211
 212 =head1 SEE ALSO
 213
 214 L<Authen::TypeKey>, L<Catalyst>, L<Catalyst::Plugin::Authentication>.
 215
 216 =head1 AUTHOR
 217
 218 Christian Hansen
 219
 220 Yuval Kogman, C<nothingmuch@woobling.org>
 221
 222 =head1 LICENSE
 223
 224 This library is free software . You can redistribute it and/or modify it under
 225 the same terms as perl itself.
 226
 227 =cut