File Coverage

blib/lib/ClearPress/authenticator/db.pm

Criterion	Covered	Total	%
statement	51	60	85.0
branch	13	22	59.0
condition	6	6	100.0
subroutine	11	11	100.0
pod	5	5	100.0
total	86	104	82.6

# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
# vim:ts=8:sw=2:et:sta:sts=2
#########
# Author: rmp
#
package ClearPress::authenticator::db;
use strict;
use warnings;
use base qw(ClearPress::authenticator Class::Accessor);
use Readonly;
use Carp;
use English qw(-no_match_vars);

our $VERSION = q[476.4.2];

__PACKAGE__->mk_accessors(qw(dbh));

our $SUPPORTED_CIPHERS = {
			  mysql   => sub { my ($self, $str) = @_; $self->dyn_use('Crypt::MySQL'); return Crypt::MySQL::password($str); },
			  mysql41 => sub { my ($self, $str) = @_; $self->dyn_use('Crypt::MySQL'); return Crypt::MySQL::password41($str); },
			  sha1    => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA');  return Digest::SHA::sha1_hex($str); },
			  sha128  => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA');  return Digest::SHA::sha128_hex($str); },
			  sha256  => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA');  return Digest::SHA::sha256_hex($str); },
			  sha384  => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA');  return Digest::SHA::sha384_hex($str); },
			  sha512  => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA');  return Digest::SHA::sha512_hex($str); },
			  md5     => sub { my ($self, $str) = @_; $self->dyn_use('Digest::MD5');  return Digest::MD5::md5_hex($str); },
			 };
Readonly::Scalar our $DEFAULT_TABLE          => 'user';
Readonly::Scalar our $DEFAULT_USERNAME_FIELD => 'username';
Readonly::Scalar our $DEFAULT_PASSWORD_FIELD => 'pass';
Readonly::Scalar our $DEFAULT_CIPHER         => 'sha1';

sub table {
  my ($self, $v) = @_;

  if($v) {
    $self->{table} = $v;
  }

  if($self->{table}) {
    return $self->{table};
  }

  return $DEFAULT_TABLE;
}

sub username_field {
  my ($self, $v) = @_;

  if($v) {
    $self->{username_field} = $v;
  }

  if($self->{username_field}) {
    return $self->{username_field};
  }

  return $DEFAULT_USERNAME_FIELD;
}

sub password_field {
  my ($self, $v) = @_;

  if($v) {
    $self->{password_field} = $v;
  }

  if($self->{password_field}) {
    return $self->{password_field};
  }

  return $DEFAULT_PASSWORD_FIELD;
}

sub cipher {
  my ($self, $v) = @_;

  if($v) {
    $self->{cipher} = $v;
  }

  if($self->{cipher}) {
    return $self->{cipher};
  }

  return $DEFAULT_CIPHER;
}

sub authen_credentials {
  my ($self, $ref) = @_;

  if(!$ref ||
     !$ref->{username} ||
     !$ref->{password} ) {
    return;
  }

  my $dbh     = $self->dbh();
  my $table   = $self->table;
  my $user_f  = $self->username_field;
  my $pass_f  = $self->password_field;
  my $c_type  = $self->cipher;
  my $cipher  = $SUPPORTED_CIPHERS->{$c_type};

  if(!$cipher) {
    croak qq[Unsupported cipher: $c_type];
  }

  my $digest  = $cipher->($self, $ref->{password});
  my $query   = qq[SELECT $user_f FROM $table WHERE $user_f=? AND $pass_f=?];
  my $results = $dbh->selectall_arrayref($query, {}, $ref->{username}, $digest);

  if(!scalar @{$results}) {
    return;
  }

  return $ref;
}

1;
__END__