SL/Auth/DB.pm

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