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::Auth::Password;
  10 use SL::DBUtils;
  11
  12 sub new {
  13   $main::lxdebug->enter_sub();
  14
  15   my $type = shift;
  16   my $self = {};
  17
  18   $self->{auth} = shift;
  19   weaken $self->{auth};
  20
  21   bless $self, $type;
  22
  23   $main::lxdebug->leave_sub();
  24
  25   return $self;
  26 }
  27
  28 sub reset {
  29   # nothing to do here
  30 }
  31
  32 sub authenticate {
  33   $main::lxdebug->enter_sub();
  34
  35   my $self       = shift;
  36   my $login      = shift;
  37   my $password   = shift;
  38
  39   my $stored_password = $self->{auth}->get_stored_password($login);
  40
  41   my ($algorithm, $algorithm2);
  42
  43   # Empty password hashes in the database mean just that -- empty
  44   # passwords. Hash it for easier comparison.
  45   $stored_password               = SL::Auth::Password->hash(password => $stored_password) unless $stored_password;
  46   ($algorithm, $stored_password) = SL::Auth::Password->parse($stored_password);
  47   ($algorithm2, $password)       = SL::Auth::Password->parse(SL::Auth::Password->hash(password => $password, algorithm => $algorithm, login => $login));
  48
  49   $main::lxdebug->leave_sub();
  50
  51   return $password eq $stored_password ? OK : ERR_PASSWORD;
  52 }
  53
  54 sub can_change_password {
  55   return 1;
  56 }
  57
  58 sub requires_cleartext_password {
  59   return 0;
  60 }
  61
  62 sub change_password {
  63   $main::lxdebug->enter_sub();
  64
  65   my $self       = shift;
  66   my $login      = shift;
  67   my $password   = shift;
  68   my $is_crypted = shift;
  69
  70   my $dbh        = $self->{auth}->dbconnect();
  71
  72   if (!$dbh) {
  73     $main::lxdebug->leave_sub();
  74     return ERR_BACKEND;
  75   }
  76
  77   $password = SL::Auth::Password->hash(login => $login, password => $password) unless $is_crypted;
  78
  79   do_query($main::form, $dbh, qq|UPDATE auth."user" SET password = ? WHERE login = ?|, $password, $login);
  80
  81   $dbh->commit();
  82
  83   $main::lxdebug->leave_sub();
  84
  85   return 1;
  86 }
  87
  88 sub verify_config {
  89   return 1;
  90 }
  91
  92 1;