Apache-AuthTicket

 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) = @_;

    $self->request->subprocess_env(AuthTicketReason => $reason);

    return;
}


sub parse_ticket {
    my ($self, $key) = @_;

    my $r = $self->request;

    my ($hash, $data) = split '--', $key
        or return $self->_error_reason('malformed_ticket');

    my ($secret, $version);
    unless ($self->is_hash_valid($hash)) {
        return $self->_error_reason('invalid_hash');
    }

    my $ticket = $self->unserialize_ticket($data)
        or return $self->_error_reason('malformed_ticket');

    unless ($r->request_time < $$ticket{expires}) {
        return $self->_error_reason('expired_ticket');
    }

    unless (($secret, $version) = $self->fetch_secret($$ticket{version})) {
        # can't get server secret
        return $self->_error_reason('missing_secret');
    }

    if ($self->_ticket_idle_timeout($hash, $ticket)) {
        # user has exceeded idle-timeout
        $self->delete_hash($hash);
        return $self->_error_reason('idle_timeout');

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

        q{</tr>},
        q{</table>},
        q{<input type="submit" value="Log In">},
        q{<p>},
        q{</form>},
        q{<EM>Note: </EM>},
        q{Set your browser to accept cookies in order for login to succeed.},
        q{You will be asked to log in again after some period of time.},
        q{</body></html>}
    );

    return $self->apache_const('OK');
}

sub logout ($$) {
    my ($class, $r) = @_;

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

    $self->delete_ticket($r);
    $self->next::method($r); # AuthCookie logout

    $r->headers_out->add(Location => $self->get_config('TicketLogoutURI'));

    return $class->apache_const('REDIRECT');
}

##################### END STATIC METHODS ###########################3
sub new {
    my ($class, $r) = @_;

    return $class->SUPER::new({request => $r});
}

sub dbh {
    my $self = shift;

    unless (defined $self->_dbh) {
        $self->_dbh($self->dbi_connect);
    }

    $self->_dbh;
}

sub dbi_connect {
    my $self = shift;

    my $r         = $self->request;
    my $auth_name = $r->auth_name;

    my ($db, $user, $pass) = map {
        $self->get_config($_)
    } qw/TicketDB TicketDBUser TicketDBPassword/;

    my $dbh = DBI->connect_cached($db, $user, $pass)
        or die "DBI Connect failure: ", DBI->errstr, "\n";

    return $dbh;
}

sub check_credentials {
    my ($self, $user, $password) = @_;

    my ($table, $user_field, $pass_field) = $self->user_table;

    my ($stmt, @bind) =
        $self->sql->select($table, $pass_field, {$user_field => $user});

    my ($db_pass) = eval {
        $self->dbh->selectrow_array($stmt, undef, @bind);
    };
    if ($@) {
        $self->dbh->rollback;
        return 0;
    }

    unless (defined $db_pass) {
        # user not in database
        return 0;
    }

    my $style = $self->get_config('TicketPasswordStyle');

    if ($self->compare_password($style, $password, $db_pass)) {
        return 1;
    }
    else {
        return 0;
    }
}

sub fetch_secret {
    my ($self, $version) = @_;

    my $dbh = $self->dbh;

    my ($secret_table, $secret_field, $secret_version_field) = $self->secret_table;

    # generate SQL
    my @fields = ($secret_field, $secret_version_field);
    my %where = ( $secret_version_field => $version ) if defined $version;
    my $order = " $secret_version_field DESC LIMIT 1 ";
    my ($stmt, @bind) = $self->sql->select($secret_table, \@fields, \%where, $order);

    return eval {
        $dbh->selectrow_array($stmt, undef, @bind);
    };
    if ($@) {
        $dbh->rollback;
        die $@;
    }
}

sub secret_version {
    my $self = shift;

    unless (defined $self->_secret_version) {
        $self->_secret_version( ($self->fetch_secret)[1] );
    }

    return $self->_secret_version;

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

=item *

invalid_hash

Ticket hash is not found in the database

=item *

expired_ticket

Ticket has expired

=item *

missing_secret

Secret that signed this ticket was not found

=item *

idle_timeout

Ticket idle timeout exceeded

=item *

tampered_hash

Ticket has been tampered with.  The checksum does not match the checksum in the
ticket

=back

=head2 sql

Get the C<SQL::Abstract> object.

=head2 get_config

 my $value = $self->get_config($name)

Get a configuration value, or its default value if the setting is not
configured.

=head2 make_login_screen

 my $result = $self->make_login_screen($r, $action, $destination)

Print out the login screen html, and return an Apache status code.

=head2 dbh

Get the database handle

=head2 dbi_connect

 my $dbh = $self->dbi_connect

Returns a new connection to the database

=head2 check_credentials

 my $ok = $self->check_credentials($username, $password)

Return C<true> if the credentials are valid

=head2 fetch_secret

 my ($value, $version) = $self->fetch_secret;
 my ($value) = $self->fetch_secret($version)

Return the secret and version of the secret.  if the C<version> argument is
present, return that specific version of the secret instead of the most recent
one.

=head2 secret_version

Returns the version of the current (most-recent) secret

=head2 make_ticket

 my $string = $self->make_ticket($username)

Creates a ticket string for the given username

=head2 serialize_ticket

 my $data = $self->serialize_ticket($hashref)

Encode the hashref in a format suitable for sending in a HTTP cookie

=head2 unserialize_ticket

 my $hashref = $self->unserialize_ticket($data)

Decode cookie data into hashref.  This is the opposite of serialize_ticket()

=head2 new_ticket_for

 my $hashref = $self->new_ticket_for($username)

Creates new ticket hashref for the given username.  You could overload this to
append extra fields to the ticket.

=head2 delete_ticket

 $self->delete_ticket($r)

Invalidates the ticket by expiring the cookie and deletes the hash from the database

=head2 save_hash

 $self->save_hash($hash)

save the hash value/checksum in the database

=head2 delete_hash

 $self->delete_hash($hash)

Remove the given hash from the database.

=head2 is_hash_valid

 my $ok = $self->is_hash_valid($hash)