SL/Auth/DB.pm

   1 package SL::Auth::DB;
   2
   3 use strict;
   4
   5 use Carp;
   6 use Scalar::Util qw(weaken);
   7
   8 use SL::Auth::Constants qw(:all);
   9 use SL::DBUtils;
  10
  11 sub new {
  12   $main::lxdebug->enter_sub();
  13
  14   my $type = shift;
  15   my $self = {};
  16
  17   $self->{auth} = shift;
  18   weaken $self->{auth};
  19
  20   bless $self, $type;
  21
  22   $main::lxdebug->leave_sub();
  23
  24   return $self;
  25 }
  26
  27 sub authenticate {
  28   $main::lxdebug->enter_sub();
  29
  30   my $self       = shift;
  31   my $login      = shift;
  32   my $password   = shift;
  33
  34   my $dbh        = $self->{auth}->dbconnect();
  35
  36   if (!$dbh) {
  37     $main::lxdebug->leave_sub();
  38     return ERR_BACKEND;
  39   }
  40
  41   my $query             = qq|SELECT password FROM auth."user" WHERE login = ?|;
  42   my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
  43
  44   my ($algorithm, $algorithm2);
  45
  46   # Empty password hashes in the database mean just that -- empty
  47   # passwords. Hash it for easier comparison.
  48   $stored_password               = $self->hash_password(password => $stored_password) unless $stored_password;
  49   ($algorithm, $stored_password) = $self->parse_password_entry($stored_password);
  50   ($algorithm2, $password)       = $self->parse_password_entry($self->hash_password(password => $password, algorithm => $algorithm, login => $login));
  51
  52   $main::lxdebug->leave_sub();
  53
  54   return $password eq $stored_password ? OK : ERR_PASSWORD;
  55 }
  56
  57 sub can_change_password {
  58   return 1;
  59 }
  60
  61 sub change_password {
  62   $main::lxdebug->enter_sub();
  63
  64   my $self       = shift;
  65   my $login      = shift;
  66   my $password   = shift;
  67   my $is_crypted = shift;
  68
  69   my $dbh        = $self->{auth}->dbconnect();
  70
  71   if (!$dbh) {
  72     $main::lxdebug->leave_sub();
  73     return ERR_BACKEND;
  74   }
  75
  76   $password = $self->hash_password(password => $password) unless $is_crypted;
  77
  78   do_query($main::form, $dbh, qq|UPDATE auth."user" SET password = ? WHERE login = ?|, $password, $login);
  79
  80   $dbh->commit();
  81
  82   $main::lxdebug->leave_sub();
  83
  84   return 1;
  85 }
  86
  87 sub verify_config {
  88   return 1;
  89 }
  90
  91 sub hash_password {
  92   my ($self, %params) = @_;
  93
  94   if (!$params{algorithm}) {
  95     $params{algorithm}          = 'SHA1';
  96     $params{fallback_algorithm} = 'MD5';
  97   }
  98
  99   if ($params{algorithm} eq 'SHA1') {
 100     if (eval { require Digest::SHA1; 1 }) {
 101       return '{SHA1}' . Digest::SHA1::sha1_hex($params{password});
 102
 103     } elsif ($params{fallback_algorithm}) {
 104       return $self->hash_password(%params, algorithm => $params{fallback_algorithm});
 105
 106     } else {
 107       die 'Digest::SHA1 not available';
 108     }
 109
 110   } elsif ($params{algorithm} eq 'MD5') {
 111     require Digest::MD5;
 112     return '{MD5}' . Digest::MD5::md5_hex($params{password});
 113
 114   } elsif ($params{algorithm} eq 'CRYPT') {
 115     return '{CRYPT}' . crypt($params{password}, substr($params{login}, 0, 2));
 116
 117   } else {
 118     croak 'Unsupported hash algorithm ' . $params{algorithm};
 119   }
 120 }
 121
 122 sub parse_password_entry {
 123   my ($self, $password) = @_;
 124
 125   return ($1, $2) if $password =~ m/^\{ ([^\}]+) \} (.+)/x;
 126   return ('CRYPT', $password);
 127 }
 128
 129 1;