TypeKey credential checker for C::P::Authentication

[catagits/Catalyst-Authentication-Credential-HTTP-Proxy.git] / lib / Catalyst / Plugin / Authentication / Credential / TypeKey.pm

package Catalyst::Plugin::Authentication::Credential::TypeKey;

use strict;
use warnings;

use Authen::TypeKey;
use Carp ();
use File::Spec;
use Catalyst::Utils ();
use NEXT;
use UNIVERSAL::require;

our $VERSION = '0.1';

sub setup {
    my $c = shift;

    my $config = $c->config->{authentication}{typekey} ||= {};

    $config->{typekey_object} ||= do {
        $config->{user_class} ||=
          "Catalyst::Plugin::Authentication::User::Hash";

        $config->{key_cache} ||=
          File::Spec->catfile( Catalyst::Utils::class2tempdir( $c, 1 ),
            'regkeys.txt' );

        my $typekey = Authen::TypeKey->new;

        for (qw/expires key_cache key_url token version/) {
            $typekey->$_( $config->{$_} || next );
        }

        $typekey;
    };

    $c->NEXT::setup(@_);
}

sub authenticate_typekey {
    my ( $c, %parameters ) = @_;

    my $config = $c->config->{authentication}{typekey};

    my $typekey = delete( $parameters{typekey_object} )
      || $config->{typekey_object};

    my @fields = qw/email name nick ts sig/;

    foreach my $field (@fields) {
        $parameters{$field} ||= $c->req->param($field) || return;
    }

    if ( $typekey->verify( \%parameters ) ) {
        $c->log->debug("Successfully authenticated user '$parameters{name}'.")
          if $c->debug;

        my $user;

        if ( my $store = $config->{auth_store} ) {
            $store = $c->get_auth_store($store) unless ref $store;
            $user = $store->get_user( \%parameters );
        }
        else {
            my $user_class = $config->{user_class};
            $user_class->require or die $@;
            $user = $user_class->new( \%parameters );
        }

        $c->set_authenticated($user);

        return 1;
    }
    else {
        $c->log->debug(
            sprintf "Failed to authenticate user '%s'. Reason: '%s'",
            $parameters{name}, $typekey->errstr )
          if $c->debug;

        return;
    }
}

1;

__END__

=head1 NAME

Catalyst::Plugin::Authentication::Credential::TypeKey - TypeKey Authentication
for Catalyst.

=head1 SYNOPSIS

    use Catalyst qw[Authentication::Credential::TypeKey];

    MyApp->config->{authenticate}->{typekey} = {
        token => 'xxxxxxxxxxxxxxxxxxxx'
    };

    sub foo : Local {
		my ( $self, $c ) = @_;

		if ( $c->authenticate_typekey( name => $name, email => $email, ... ) ) {
			# successful autentication

			$c->user; # blah
		}
	}


	sub auto : Private {
		my ( $self, $c ) = @_;

		$c->authenticate_typekey; # uses $c->req->params

		return 1;
	}

=head1 DESCRIPTION

This module integrates L<Authen::TypeKey> with
L<Catalyst::Plugin::Authentication>.

=head1 METHODS

=item authenticate_typekey %parameters

=item authenticate_typekey

=item EXTENDED METHODS

=item setup

Fills the config with defaults.

=head1 CONFIGURATION

C<<$c->config->{autentication}{typekey}>> is a hash with these fields (all can
be left out):

=over 4

=item typekey_object

If this field does not exist an L<Authen::TypeKey> object will be created based
on the other param and put here.

=item expires

=item key_url

=item token

=item version

See L<Authen::TypeKey> for all of these. If they aren't specified
L<Authen::TypeKey>'s defaults will be used.

=item key_cache

Also see L<Authen::TypeKey>.

Defaults to C<regkeys.txt> under L<Catalyst::Utils/class2tempdir>.

=item auth_store

A store (or store name) to retrieve the user from.

When a user is successfully authenticated it will call this:

	$store->get_user( $parameters );

Where C<$parameters> is a the hash reference passed to L<Authen::TypeKey/verify>.

=item user_class

If C<auth_store> is not set it will use this class to instantiate an object,
calling C<new> on the class with the same C<$parameters> hash ref.

=back

=head1 SEE ALSO

L<Authen::TypeKey>, L<Catalyst>, L<Catalyst::Plugin::Authentication>.

=head1 AUTHOR

Christian Hansen

Yuval Kogman, C<nothingmuch@woobling.org>

=head1 LICENSE

This library is free software . You can redistribute it and/or modify it under
the same terms as perl itself.

=cut