package Egg::Model::Auth::Plugin::Keep;
#
# Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
#
# $Id: Keep.pm 347 2008-06-14 18:57:53Z lushe $
#
use strict;
use warnings;
use Carp qw/ croak /;
use Crypt::CBC;
use Digest::SHA1 qw/ sha1_hex /;
our $VERSION= '0.06';
my @Items= qw/ __api_name ___user ___input_password /;
sub _setup {
my($class, $e)= @_;
my $c= $class->config->{plugin_keep}
|| die q{I want setup 'plugin_keep'.};
$c->{check_sum} ||= 'd08bdd7994fb7af48c70138d6a77a6b2010c8998';
length($c->{check_sum}) < 20 and die q{'check_sum' is too short.};
$c->{delimiter} ||= ' : ';
$c->{param_name} ||= '__auto_login';
my $cookie= $c->{cookie} ||= {};
$cookie->{name} ||= 'keep';
$cookie->{path} ||= '/';
$cookie->{expires} ||= '+7d';
my $cbc= $c->{crypt} || die q{I want setup 'plugin_keep' of 'crypt'.};
$cbc->{cipher} || die q{I want setup 'crypt' of 'cipher'.};
$cbc->{key} || die q{I want setup 'crypt' of 'key'.};
$cbc->{iv} ||= '$KJh#(}q';
$cbc->{padding} ||= 'standard';
$cbc->{prepend_iv} = 0 unless exists($cbc->{prepend_iv});
$cbc->{regenerate_key}= 1 unless exists($cbc->{regenerate_key});
$class->next::method($e);
}
sub __keep_cbc {
$_[0]->{_crypt_keep_cbc}
||= Crypt::CBC->new($_[0]->config->{plugin_keep}{crypt});
}
sub is_login {
my $self= shift;
if (my $session= $self->get_session) { return $self->next::method($session) }
my $c= $self->config->{plugin_keep};
my $crypt= $self->e->request->cookie_value($c->{cookie}{name}) || return do {
$self->e->debug_out(__PACKAGE__. ' - Cookie data is empty.');
$self->next::method(1);
};
my $plain= $self->__keep_cbc->decrypt_hex($crypt) || return do {
$self->e->debug_out(__PACKAGE__. ' - Data cannot be decrypt.');
$self->next::method(1);
};
my %data;
(my $checksum, @data{@Items})= split $c->{delimiter}, $plain;
($data{__api_name} and $self->api_list->{$data{__api_name}}) || return do {
$self->e->debug_out(__PACKAGE__. ' - There is no corresponding API.');
$self->next::method(1);
};
my $api= $self->api($data{__api_name});
$api->valid_id($data{___user}) || return do {
$self->e->debug_out(__PACKAGE__. ' - The user name is bad.');
$self->next::method(1);
};
$api->valid_password($data{___input_password}) || return do {
$self->e->debug_out(__PACKAGE__. ' - The password is bad.');
$self->next::method(1);
};
$checksum eq sha1_hex($c->{check_sum}. $data{___input_password}) || return do {
$self->e->debug_out(__PACKAGE__. ' - The checksum is bad.');
$self->next::method(1);
};
$data{___start_interval}= time- ($self->config->{interval}+ 60);
$self->next::method(\%data);
}
sub remove_bind_id {
my($self)= @_;
my $name= $self->config->{plugin_keep}{cookie}{name} || 'aa';
$self->e->request->cookie_more( $name => 'deny' );
$self->e->response->cookies->{$name}= { value=> "", expires=> '-1d' };
$self->e->debug_out(__PACKAGE__. ' - Cookie was removed.');
$self->next::method;
}
sub __setup_data {
my $self= shift;
return $self->next::method(@_) if $_[0];
my $data= $self->next::method(@_);
my($e, $c)= ($self->e, $self->config->{plugin_keep});
return $data unless $e->request->params->{$c->{param_name}};
my $checksum= sha1_hex($c->{check_sum}. $data->{___input_password});
my $plain = join $c->{delimiter}, ($checksum, @{$data}{@Items});
my %cookie= %{$c->{cookie}};
$e->response->cookies->{$cookie{name}}=
{ %cookie, value=> $self->__keep_cbc->encrypt_hex($plain) };
$data;
}
1;
__END__
=head1 NAME
Egg::Model::Auth::Plugin::Keep - The attestation is maintained by Cookie.
=head1 SYNOPSIS
package MyApp::Model::Auth::MyAuth;
..........
__PACKAGE__->config(
check_sum => 'abcdefghijklmnopqrstu',
delimiter => ' : ',
param_name => '__auto_login',
cookie => {
...........
},
crypt => {
...........
},
);
__PACKAGE__->setup_plugin(qw/ Keep /);
__PACKAGE__->setup_session('SessionKit');
=head1 DESCRIPTION
The attestation session to which the code that can be decoded to Cookie is set
and the session cut is revived. As a result, the attestation is maintained to
perpetuity.
'plugin_keep' is set to the configuration to use it, and 'Keep' is included in
the list of 'setup_session' method.
__PACKAGE__->setup_plugin(qw/ Keep /);
It and the session component are needed.
__PACKAGE__->setup_session( FileCache => qw/ Bind::Cookie / );
When 'login_check' is called, Cookie for the perpetuity attestation is set if
the input parameter concerning 'The next automatic log in' is effective.
Attestation information is acquired from Cookie if the attestation session doesn't
exist when 'is_login' is called and the attestation session is revived at the
following.
It is necessary to note it very when using it to preserve attestation
information in Cookie.
=head1 CONDIFGURATION
The following items are set and used in 'plugin_keep'.
=head3 check_sum
Character string of 20-40 suitable digit to generate checksum.
=head3 delimiter
Each attestation data delimiter.
Default is ' : '.
=head3 param_name
Name of the form data for flag to do perpetuity attestation effectively.
Default is '__auto_login'.
=head3 cookie
The content is a parameter to pass it to 'cookie' method of L<Egg::Response>.
name ..... Name of Cookie. Default is 'aa'.
expires ..... Validity term of Cookie for perpetuity attestation. Default is '+7D'.
=head3 crypt
The content is an option to pass to L<Crypt::CBC>.
=head1 METHODS
=head2 is_login
If the attestation session exists and doesn't exist, attestation information is
acquired from Cookie, and the attestation session is revived.
And, processing is passed to 'is_login' of L<Egg::Model::Auth::Base>.
=head2 remove_bind_id
=head2 reset
Cookie for the perpetuity attestation is annulled.
And, processing is passed to 'reset' of L<Egg::Model::Auth::Base>.
=head1 SEE ALSO
L<Egg::Release>,
L<Egg::Model::Auth>,
L<Egg::Model::Auth::Base>,
L<Egg::Response>,
L<Crypt::CBC>,
L<Digest::SHA1>,
=head1 AUTHOR
Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.
=cut