1 package SL::Auth::LDAP;
 
   3 use English '-no_match_vars';
 
   5 use Scalar::Util qw(weaken);
 
   6 use SL::Auth::Constants qw(:all);
 
  11   $main::lxdebug->enter_sub();
 
  13   if (!defined eval "require Net::LDAP;") {
 
  14     die 'The module "Net::LDAP" is not installed.';
 
  20   $self->{auth} = shift;
 
  25   $main::lxdebug->leave_sub();
 
  32   $self->{ldap}     = undef;
 
  33   $self->{dn_cache} = { };
 
  37   $main::lxdebug->enter_sub();
 
  40   my $cfg  = $self->{auth}->{LDAP_config};
 
  43     $main::lxdebug->leave_sub();
 
  48   my $port      = $cfg->{port} || 389;
 
  49   $self->{ldap} = Net::LDAP->new($cfg->{host}, 'port' => $port);
 
  52     $main::form->error($main::locale->text('The LDAP server "#1:#2" is unreachable. Please check config/kivitendo.conf.', $cfg->{host}, $port));
 
  56     my $mesg = $self->{ldap}->start_tls('verify' => 'none');
 
  57     if ($mesg->is_error()) {
 
  58       $main::form->error($main::locale->text('The connection to the LDAP server cannot be encrypted (SSL/TLS startup failure). Please check config/kivitendo.conf.'));
 
  62   if ($cfg->{bind_dn}) {
 
  63     my $mesg = $self->{ldap}->bind($cfg->{bind_dn}, 'password' => $cfg->{bind_password});
 
  64     if ($mesg->is_error()) {
 
  65       $main::form->error($main::locale->text('Binding to the LDAP server as "#1" failed. Please check config/kivitendo.conf.', $cfg->{bind_dn}));
 
  69   $main::lxdebug->leave_sub();
 
  75   $main::lxdebug->enter_sub();
 
  82   $cfg    =  $self->{auth}->{LDAP_config};
 
  84   $filter =  "$cfg->{filter}";
 
  88   $login  =~ s|\\|\\\\|g;
 
  89   $login  =~ s|\(|\\\(|g;
 
  90   $login  =~ s|\)|\\\)|g;
 
  91   $login  =~ s|\*|\\\*|g;
 
  92   $login  =~ s|\x00|\\00|g;
 
  94   if ($filter =~ m|<\%login\%>|) {
 
  95     substr($filter, $LAST_MATCH_START[0], $LAST_MATCH_END[0] - $LAST_MATCH_START[0]) = $login;
 
  98     if ((substr($filter, 0, 1) ne '(') || (substr($filter, -1, 1) ne ')')) {
 
  99       $filter = "($filter)";
 
 102     $filter = "(&${filter}($cfg->{attribute}=${login}))";
 
 105     $filter = "$cfg->{attribute}=${login}";
 
 109   $main::lxdebug->leave_sub();
 
 115   $main::lxdebug->enter_sub();
 
 121   $self->{dn_cache} ||= { };
 
 123   if ($self->{dn_cache}->{$login}) {
 
 124     $main::lxdebug->leave_sub();
 
 125     return $self->{dn_cache}->{$login};
 
 128   my $cfg    = $self->{auth}->{LDAP_config};
 
 130   my $filter = $self->_get_filter($login);
 
 132   my $mesg   = $ldap->search('base' => $cfg->{base_dn}, 'scope' => 'sub', 'filter' => $filter);
 
 134   if ($mesg->is_error() || (0 == $mesg->count())) {
 
 135     $main::lxdebug->leave_sub();
 
 139   my $entry                   = $mesg->entry(0);
 
 140   $self->{dn_cache}->{$login} = $entry->dn();
 
 142   $main::lxdebug->leave_sub();
 
 144   return $self->{dn_cache}->{$login};
 
 148   $main::lxdebug->enter_sub();
 
 152   my $password   = shift;
 
 153   my $is_crypted = shift;
 
 156     $main::lxdebug->leave_sub();
 
 160   my $ldap = $self->_connect();
 
 163     $main::lxdebug->leave_sub();
 
 167   my $dn = $self->_get_user_dn($ldap, $login);
 
 169   $main::lxdebug->message(LXDebug->DEBUG2(), "LDAP authenticate: dn $dn");
 
 172     $main::lxdebug->leave_sub();
 
 176   my $mesg = $ldap->bind($dn, 'password' => $password);
 
 178   $main::lxdebug->message(LXDebug->DEBUG2(), "LDAP authenticate: bind mesg " . $mesg->error());
 
 180   $main::lxdebug->leave_sub();
 
 182   return $mesg->is_error() ? ERR_PASSWORD : OK;
 
 185 sub can_change_password {
 
 189 sub requires_cleartext_password {
 
 193 sub change_password {
 
 198   $main::lxdebug->enter_sub();
 
 200   my $form   = $main::form;
 
 201   my $locale = $main::locale;
 
 204   my $cfg  = $self->{auth}->{LDAP_config};
 
 207     $form->error($locale->text('config/kivitendo.conf: Key "authentication/ldap" is missing.'));
 
 210   if (!$cfg->{host} || !$cfg->{attribute} || !$cfg->{base_dn}) {
 
 211     $form->error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/ldap". Required parameters are "host", "attribute" and "base_dn".'));
 
 214   $main::lxdebug->leave_sub();