view release on metacpan or  search on metacpan

lib/Apache/AuthTicket/Base.pm  view on Meta::CPAN

package Apache::AuthTicket::Base;
$Apache::AuthTicket::Base::VERSION = '0.94';
# ABSTRACT: Common methods for all Apache::AuthTicket versions.

use strict;
use base qw(Class::Accessor::Fast);
use DBI;
use SQL::Abstract;
use MRO::Compat;
use Digest::MD5;
use MIME::Base64 ();
use Storable ();
use ModPerl::VersionUtil;

use constant DEBUGGING => 0;

__PACKAGE__->mk_accessors(qw(request _secret_version _dbh _sql));

# configuration items
# PerlSetVar FooTicketDB  dbi:Pg:dbname=template1
# PerlSetVar FooDBUser     test
# PerlSetVar FooDBPassword  test
# PerlSetVar FooTicketTable tickets:ticket_hash
# PerlSetVar FooUserTable   users:usrname:passwd
# PerlSetVar FooPasswordStyle cleartext
# PerlSetVar FooSecretTable   ticketsecrets:sec_data:sec_version

our %DEFAULTS = (
    TicketExpires         => 15,
    TicketIdleTimeout     => 0,
    TicketLogoutURI       => '/',
    TicketDB              => 'dbi:Pg:dbname=template1',
    TicketDBUser          => 'test',
    TicketDBPassword      => 'test',
    TicketTable           => 'tickets:ticket_hash',
    TicketUserTable       => 'users:usrname:passwd',
    TicketPasswordStyle   => 'cleartext',
    TicketSecretTable     => 'ticketsecrets:sec_data:sec_version',
    TicketLoginHandler    => '/login',
    TicketCheckIP         => 1,
    TicketCheckBrowser    => 0
);

# configured items get dumped in here
our %CONFIG = ();

sub configure {
    my ($class, $auth_name, $conf) = @_;

    $class->push_handler(PerlChildInitHandler => sub {
        for (keys %$conf) {
            die "bad configuration parameter $_" unless defined $DEFAULTS{$_};
            $CONFIG{$auth_name}{$_} = $conf->{$_};
        }
    });
}

# check credentials and return a session key if valid
# return undef if invalid
sub authen_cred {
    my ($class, $r, $user, $pass) = @_;

    my $self = $class->new($r);

    if ($self->check_credentials($user, $pass)) {
        return $self->make_ticket($user);
    }
    else {
        return undef;
    }
}

# check a session key, return user id
# return undef if its not valid.
sub authen_ses_key {
    my ($class, $r, $session_key) = @_;

    my $self = $class->new($r);

    if (my $ticket = $self->parse_ticket($session_key)) {
        return $$ticket{user};
    }
    else {
        return undef;
    }
}

sub _error_reason {
    my ($self, $reason) = @_;

lib/Apache/AuthTicket/Base.pm  view on Meta::CPAN

    return MIME::Base64::encode( Storable::nfreeze($hashref), '' );
}

sub unserialize_ticket {
    my ($self, $data) = @_;

    return Storable::thaw( MIME::Base64::decode($data) );
}

sub new_ticket_for {
    my ($self, $user_name) = @_;

    my $now     = time;
    my $expires = $now + $self->get_config('TicketExpires') * 60;

    return {
        version => $self->secret_version,
        time    => $now,
        user    => $user_name,
        expires => $expires
    };
}

sub delete_ticket {
    my ($self, $r) = @_;

    my $key = $self->key($r);
    warn "delete_ticket: key $key" if DEBUGGING;

    my ($hash) = split '--', $key or return;

    $self->delete_hash($hash);
}

########## SERVER SIDE HASH MANAGEMENT METHODS

sub _update_ticket_timestamp {
    my ($self, $hash) = @_;

    my $time = $self->request->request_time;
    my $dbh = $self->dbh;

    my ($table, $tick_field, $ts_field) = $self->ticket_table;

    my ($query, @bind) = $self->sql->update($table,
        {$ts_field   => $time},
        {$tick_field => $hash});

    eval {
        my $sth = $dbh->do($query, undef, @bind);
        $dbh->commit unless $dbh->{AutoCommit};
    };
    if ($@) {
        $dbh->rollback;
        die $@;
    }
}

# boolean _ticket_idle_timeout(String hash, Hashref ticket)
#
# return true if the ticket table timestamp is older than the IdleTimeout
# value.
sub _ticket_idle_timeout {
    my ($self, $hash, $ticket) = @_;

    my $idle = $self->get_config('TicketIdleTimeout') * 60;
    return 0 unless $idle;       # if not timeout set, its still valid.

    my $db_time = $self->{DBTicketTimeStamp};
    my $time = $self->request->request_time;
    if (DEBUGGING) {
        warn "Last activity: ", ($time - $db_time), " secs ago\n";
        warn "Fail if thats > ", ($idle), "\n";
    }

    if ( ($time - $db_time)  > $idle ) {
        # its timed out
        return 1;
    }
    else {
        return 0;
    }
}

sub save_hash {
    my ($self, $hash) = @_;

    my ($table, $tick_field, $ts_field) = $self->ticket_table;

    my ($query, @bind) = $self->sql->insert($table, {
        $tick_field => $hash,
        $ts_field   => $self->request->request_time });

    my $dbh = $self->dbh;

    eval {
        my $sth = $dbh->do($query, undef, @bind);
        $dbh->commit unless $dbh->{AutoCommit};
    };
    if ($@) {
        $dbh->rollback;
        die $@;
    }
}

sub delete_hash {
    my ($self, $hash) = @_;

    my ($table, $tick_field) = $self->ticket_table;

    my ($query, @bind) = $self->sql->delete($table, { $tick_field => $hash });

    my $dbh = $self->dbh;

    eval {
        my $sth = $dbh->do($query, undef, @bind);
        $dbh->commit unless $dbh->{AutoCommit} || 0;
    };
    if ($@) {
        $dbh->rollback;
        die $@;
    }
}

sub is_hash_valid {
    my ($self, $hash) = @_;