projects / kivitendo-erp.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
WebshopApi: falsche sql update Abhängigkeit
[kivitendo-erp.git] / SL / Auth.pm
diff --git a/SL/Auth.pm b/SL/Auth.pm
index d361a3d..116d5de 100644 (file)
--- a/SL/Auth.pm
+++ b/SL/Auth.pm
@@ -7,6 +7,7 @@ use IO::File;
 use Time::HiRes qw(gettimeofday);
 use List::MoreUtils qw(uniq);
 use YAML;
 use Time::HiRes qw(gettimeofday);
 use List::MoreUtils qw(uniq);
 use YAML;
+use Regexp::IPv6 qw($IPv6_re);
 
 use SL::Auth::ColumnInformation;
 use SL::Auth::Constants qw(:all);
 
 use SL::Auth::ColumnInformation;
 use SL::Auth::Constants qw(:all);
@@ -19,27 +20,29 @@ use SL::SessionFile;
 use SL::User;
 use SL::DBConnect;
 use SL::DBUpgrade2;
 use SL::User;
 use SL::DBConnect;
 use SL::DBUpgrade2;
-use SL::DBUtils;
+use SL::DBUtils qw(do_query do_statement prepare_execute_query prepare_query selectall_array_query selectrow_query);
 
 use strict;
 
 
 use strict;
 
-sub new {
-  $main::lxdebug->enter_sub();
+use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
+use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
 
 
-  my $type = shift;
-  my $self = {};
+use Rose::Object::MakeMethods::Generic (
+  scalar => [ qw(client) ],
+);
 
 
-  bless $self, $type;
 
 
-  $self->_read_auth_config();
-  $self->reset;
+sub new {
+  my ($type, %params) = @_;
+  my $self            = bless {}, $type;
 
 
-  $main::lxdebug->leave_sub();
+  $self->_read_auth_config(%params);
+  $self->init;
 
   return $self;
 }
 
 
   return $self;
 }
 
-sub reset {
+sub init {
   my ($self, %params) = @_;
 
   $self->{SESSION}            = { };
   my ($self, %params) = @_;
 
   $self->{SESSION}            = { };
@@ -47,33 +50,48 @@ sub reset {
   $self->{RIGHTS}             = { };
   $self->{unique_counter}     = 0;
   $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
   $self->{RIGHTS}             = { };
   $self->{unique_counter}     = 0;
   $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
-  $self->{authenticator}->reset;
 }
 
 }
 
-sub get_user_dbh {
-  my ($self, $login, %params) = @_;
-  my $may_fail = delete $params{may_fail};
-
-  my %user = $self->read_user($login);
-  my $dbh  = SL::DBConnect->connect(
-    $user{dbconnect},
-    $user{dbuser},
-    $user{dbpasswd},
-    {
-      pg_enable_utf8 => $::locale->is_utf8,
-      AutoCommit     => 0
-    }
-  );
+sub reset {
+  my ($self, %params) = @_;
 
 
-  if (!$may_fail && !$dbh) {
-    $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
+  $self->{SESSION}        = { };
+  $self->{FULL_RIGHTS}    = { };
+  $self->{RIGHTS}         = { };
+  $self->{unique_counter} = 0;
+
+  if ($self->is_db_connected) {
+    # reset is called during request shutdown already. In case of a
+    # completely new auth DB this would fail and generate an error
+    # message even if the user is currently trying to create said auth
+    # DB. Therefore only fetch the column information if a connection
+    # has been established.
+    $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
+    $self->{column_information}->_fetch;
+  } else {
+    delete $self->{column_information};
   }
 
   }
 
-  if ($user{dboptions} && $dbh) {
-    $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
-  }
+  $self->{authenticator}->reset;
 
 
-  return $dbh;
+  $self->client(undef);
+}
+
+sub set_client {
+  my ($self, $id_or_name) = @_;
+
+  $self->client(undef);
+
+  return undef unless $id_or_name;
+
+  my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
+  my $dbh    = $self->dbconnect;
+
+  return undef unless $dbh;
+
+  $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
+
+  return $self->client;
 }
 
 sub DESTROY {
 }
 
 sub DESTROY {
@@ -93,17 +111,25 @@ sub mini_error {
   } else {
     print STDERR "Error: @msg\n";
   }
   } else {
     print STDERR "Error: @msg\n";
   }
-  ::end_of_request();
+  $::dispatcher->end_request;
 }
 
 sub _read_auth_config {
 }
 
 sub _read_auth_config {
-  $main::lxdebug->enter_sub();
-
-  my $self = shift;
+  my ($self, %params) = @_;
 
   map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
 
   map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
-  $self->{DB_config}   = $::lx_office_conf{'authentication/database'};
-  $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
+
+  # Prevent password leakage to log files when dumping Auth instances.
+  $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
+
+  if ($params{unit_tests_database}) {
+    $self->{DB_config}   = $::lx_office_conf{'testing/database'};
+    $self->{module}      = 'DB';
+
+  } else {
+    $self->{DB_config}   = $::lx_office_conf{'authentication/database'};
+    $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
+  }
 
   if ($self->{module} eq 'DB') {
     $self->{authenticator} = SL::Auth::DB->new($self);
 
   if ($self->{module} eq 'DB') {
     $self->{authenticator} = SL::Auth::DB->new($self);
@@ -114,74 +140,89 @@ sub _read_auth_config {
 
   if (!$self->{authenticator}) {
     my $locale = Locale->new('en');
 
   if (!$self->{authenticator}) {
     my $locale = Locale->new('en');
-    $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
+    $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
   }
 
   my $cfg = $self->{DB_config};
 
   if (!$cfg) {
     my $locale = Locale->new('en');
   }
 
   my $cfg = $self->{DB_config};
 
   if (!$cfg) {
     my $locale = Locale->new('en');
-    $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
+    $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
   }
 
   if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
     my $locale = Locale->new('en');
   }
 
   if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
     my $locale = Locale->new('en');
-    $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
+    $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
   }
 
   $self->{authenticator}->verify_config();
 
   $self->{session_timeout} *= 1;
   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
   }
 
   $self->{authenticator}->verify_config();
 
   $self->{session_timeout} *= 1;
   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
+}
+
+sub has_access_to_client {
+  my ($self, $login) = @_;
+
+  return 0 if !$self->client || !$self->client->{id};
+
+  my $sql = <<SQL;
+    SELECT cu.client_id
+    FROM auth.clients_users cu
+    LEFT JOIN auth."user" u ON (cu.user_id = u.id)
+    WHERE (u.login      = ?)
+      AND (cu.client_id = ?)
+SQL
 
 
-  $main::lxdebug->leave_sub();
+  my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
+  return $has_access;
 }
 
 sub authenticate_root {
 }
 
 sub authenticate_root {
-  $main::lxdebug->enter_sub();
-
   my ($self, $password) = @_;
 
   my ($self, $password) = @_;
 
-  $password             = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
-  my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password});
+  my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
+  if (defined $session_root_auth && $session_root_auth == OK) {
+    return OK;
+  }
 
 
-  $main::lxdebug->leave_sub();
+  if (!defined $password) {
+    return ERR_PASSWORD;
+  }
+
+  my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
+  $password             = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
+
+  my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
+  $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
 
 
-  return OK if $password eq $admin_password;
-  sleep 5;
-  return ERR_PASSWORD;
+  return $result;
 }
 
 sub authenticate {
 }
 
 sub authenticate {
-  $main::lxdebug->enter_sub();
-
   my ($self, $login, $password) = @_;
 
   my ($self, $login, $password) = @_;
 
-  $main::lxdebug->leave_sub();
-
-  my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
-  return OK if $result eq OK;
-  sleep 5;
-  return $result;
-}
+  if (!$self->client || !$self->has_access_to_client($login)) {
+    return ERR_PASSWORD;
+  }
 
 
-sub store_credentials_in_session {
-  my ($self, %params) = @_;
+  my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
+  if (defined $session_auth && $session_auth == OK) {
+    return OK;
+  }
 
 
-  if (!$self->{authenticator}->requires_cleartext_password) {
-    $params{password} = SL::Auth::Password->hash_if_unhashed(login             => $params{login},
-                                                             password          => $params{password},
-                                                             look_up_algorithm => 1,
-                                                             auth              => $self);
+  if (!defined $password) {
+    return ERR_PASSWORD;
   }
 
   }
 
-  $self->set_session_value(login => $params{login}, password => $params{password});
+  my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
+  $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
+  return $result;
 }
 
 }
 
-sub store_root_credentials_in_session {
-  my ($self, $rpw) = @_;
-
-  $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
+sub punish_wrong_login {
+  my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
+  sleep $failed_login_penalty if $failed_login_penalty;
 }
 
 sub get_stored_password {
 }
 
 sub get_stored_password {
@@ -198,13 +239,10 @@ sub get_stored_password {
 }
 
 sub dbconnect {
 }
 
 sub dbconnect {
-  $main::lxdebug->enter_sub(2);
-
   my $self     = shift;
   my $may_fail = shift;
 
   if ($self->{dbh}) {
   my $self     = shift;
   my $may_fail = shift;
 
   if ($self->{dbh}) {
-    $main::lxdebug->leave_sub(2);
     return $self->{dbh};
   }
 
     return $self->{dbh};
   }
 
@@ -217,60 +255,50 @@ sub dbconnect {
 
   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 
 
   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 
-  $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
+  $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
 
   if (!$may_fail && !$self->{dbh}) {
 
   if (!$may_fail && !$self->{dbh}) {
+    delete $self->{dbh};
     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
   }
 
     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
   }
 
-  $main::lxdebug->leave_sub(2);
-
   return $self->{dbh};
 }
 
 sub dbdisconnect {
   return $self->{dbh};
 }
 
 sub dbdisconnect {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
 
   if ($self->{dbh}) {
     $self->{dbh}->disconnect();
     delete $self->{dbh};
   }
   my $self = shift;
 
   if ($self->{dbh}) {
     $self->{dbh}->disconnect();
     delete $self->{dbh};
   }
+}
 
 
-  $main::lxdebug->leave_sub();
+sub is_db_connected {
+  my ($self) = @_;
+  return !!$self->{dbh};
 }
 
 sub check_tables {
 }
 
 sub check_tables {
-  $main::lxdebug->enter_sub();
+  my ($self, $dbh)    = @_;
 
 
-  my $self    = shift;
-
-  my $dbh     = $self->dbconnect();
+  $dbh   ||= $self->dbconnect();
   my $query   = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
 
   my ($count) = $dbh->selectrow_array($query);
 
   my $query   = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
 
   my ($count) = $dbh->selectrow_array($query);
 
-  $main::lxdebug->leave_sub();
-
   return $count > 0;
 }
 
 sub check_database {
   return $count > 0;
 }
 
 sub check_database {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
 
   my $dbh  = $self->dbconnect(1);
 
   my $self = shift;
 
   my $dbh  = $self->dbconnect(1);
 
-  $main::lxdebug->leave_sub();
-
   return $dbh ? 1 : 0;
 }
 
 sub create_database {
   return $dbh ? 1 : 0;
 }
 
 sub create_database {
-  $main::lxdebug->enter_sub();
-
   my $self   = shift;
   my %params = @_;
 
   my $self   = shift;
   my %params = @_;
 
@@ -292,18 +320,13 @@ sub create_database {
 
   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
 
 
   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
 
-  my $charset    = $::lx_office_conf{system}->{dbcharset};
-  $charset     ||= Common::DEFAULT_CHARSET;
-  my $encoding   = $Common::charset_to_db_encoding{$charset};
-  $encoding    ||= 'UNICODE';
-
-  my $dbh        = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
+  my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
 
   if (!$dbh) {
     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
   }
 
 
   if (!$dbh) {
     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
   }
 
-  my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
+  my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
 
   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
 
 
   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
 
@@ -315,8 +338,8 @@ sub create_database {
     $query                 = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
     my ($cluster_encoding) = $dbh->selectrow_array($query);
 
     $query                 = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
     my ($cluster_encoding) = $dbh->selectrow_array($query);
 
-    if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
-      $error = $main::locale->text('Your PostgreSQL installationen uses UTF-8 as its encoding. Therefore you have to configure Lx-Office to use UTF-8 as well.');
+    if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
+      $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
     }
 
     $dbh->disconnect();
     }
 
     $dbh->disconnect();
@@ -325,28 +348,17 @@ sub create_database {
   }
 
   $dbh->disconnect();
   }
 
   $dbh->disconnect();
-
-  $main::lxdebug->leave_sub();
 }
 
 sub create_tables {
 }
 
 sub create_tables {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
   my $dbh  = $self->dbconnect();
 
   my $self = shift;
   my $dbh  = $self->dbconnect();
 
-  my $charset    = $::lx_office_conf{system}->{dbcharset};
-  $charset     ||= Common::DEFAULT_CHARSET;
-
   $dbh->rollback();
   $dbh->rollback();
-  SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
-
-  $main::lxdebug->leave_sub();
+  SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
 }
 
 sub save_user {
 }
 
 sub save_user {
-  $main::lxdebug->enter_sub();
-
   my $self   = shift;
   my $login  = shift;
   my %params = @_;
   my $self   = shift;
   my $login  = shift;
   my %params = @_;
@@ -383,8 +395,6 @@ sub save_user {
   }
 
   $dbh->commit();
   }
 
   $dbh->commit();
-
-  $main::lxdebug->leave_sub();
 }
 
 sub can_change_password {
 }
 
 sub can_change_password {
@@ -394,59 +404,69 @@ sub can_change_password {
 }
 
 sub change_password {
 }
 
 sub change_password {
-  $main::lxdebug->enter_sub();
-
   my ($self, $login, $new_password) = @_;
 
   my $result = $self->{authenticator}->change_password($login, $new_password);
 
   my ($self, $login, $new_password) = @_;
 
   my $result = $self->{authenticator}->change_password($login, $new_password);
 
-  $self->store_credentials_in_session(login             => $login,
-                                      password          => $new_password,
-                                      look_up_algorithm => 1,
-                                      auth              => $self);
-
-  $main::lxdebug->leave_sub();
-
   return $result;
 }
 
 sub read_all_users {
   return $result;
 }
 
 sub read_all_users {
-  $main::lxdebug->enter_sub();
-
   my $self  = shift;
 
   my $dbh   = $self->dbconnect();
   my $self  = shift;
 
   my $dbh   = $self->dbconnect();
-  my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
-                 FROM auth.user_config cfg
-                 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
+  my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
+
+                 FROM auth."user" AS  u
+
+                 LEFT JOIN auth.user_config AS cfg
+                   ON (cfg.user_id = u.id)
+
+                 LEFT JOIN auth.session_content AS sc_login
+                   ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
+
+                 LEFT JOIN auth.session AS s
+                   ON (s.id = sc_login.session_id)
+              |;
   my $sth   = prepare_execute_query($main::form, $dbh, $query);
 
   my %users;
 
   while (my $ref = $sth->fetchrow_hashref()) {
   my $sth   = prepare_execute_query($main::form, $dbh, $query);
 
   my %users;
 
   while (my $ref = $sth->fetchrow_hashref()) {
-    $users{$ref->{login}}                    ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
+
+    $users{$ref->{login}}                    ||= {
+                                                'login' => $ref->{login},
+                                                'id' => $ref->{id},
+                                                'last_action' => $ref->{last_action},
+                                             };
     $users{$ref->{login}}->{$ref->{cfg_key}}   = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
   }
 
   $sth->finish();
 
     $users{$ref->{login}}->{$ref->{cfg_key}}   = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
   }
 
   $sth->finish();
 
-  $main::lxdebug->leave_sub();
-
   return %users;
 }
 
 sub read_user {
   return %users;
 }
 
 sub read_user {
-  $main::lxdebug->enter_sub();
-
-  my $self  = shift;
-  my $login = shift;
+  my ($self, %params) = @_;
 
   my $dbh   = $self->dbconnect();
 
   my $dbh   = $self->dbconnect();
+
+  my (@where, @values);
+  if ($params{login}) {
+    push @where,  'u.login = ?';
+    push @values, $params{login};
+  }
+  if ($params{id}) {
+    push @where,  'u.id = ?';
+    push @values, $params{id};
+  }
+  my $where = join ' AND ', '1 = 1', @where;
   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
                  FROM auth.user_config cfg
                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
                  FROM auth.user_config cfg
                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
-                 WHERE (u.login = ?)|;
-  my $sth   = prepare_execute_query($main::form, $dbh, $query, $login);
+                 WHERE $where|;
+  my $sth   = prepare_execute_query($main::form, $dbh, $query, @values);
 
   my %user_data;
 
 
   my %user_data;
 
@@ -455,55 +475,53 @@ sub read_user {
     @user_data{qw(id login)}    = @{$ref}{qw(id login)};
   }
 
     @user_data{qw(id login)}    = @{$ref}{qw(id login)};
   }
 
-  # The XUL/XML backed menu has been removed.
-  $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
+  # The XUL/XML & 'CSS new' backed menus have been removed.
+  my %menustyle_map = ( xml => 'new', v4 => 'v3' );
+  $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
 
 
-  $sth->finish();
+  # The 'Win2000.css' stylesheet has been removed.
+  $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
+
+  # Set default language if selected language does not exist (anymore).
+  $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
 
 
-  $main::lxdebug->leave_sub();
+  $sth->finish();
 
   return %user_data;
 }
 
 sub get_user_id {
 
   return %user_data;
 }
 
 sub get_user_id {
-  $main::lxdebug->enter_sub();
-
   my $self  = shift;
   my $login = shift;
 
   my $dbh   = $self->dbconnect();
   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
 
   my $self  = shift;
   my $login = shift;
 
   my $dbh   = $self->dbconnect();
   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
 
-  $main::lxdebug->leave_sub();
-
   return $id;
 }
 
 sub delete_user {
   return $id;
 }
 
 sub delete_user {
-  $::lxdebug->enter_sub;
-
   my $self  = shift;
   my $login = shift;
 
   my $self  = shift;
   my $login = shift;
 
-  my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
   my $dbh   = $self->dbconnect;
   my $dbh   = $self->dbconnect;
+  my $id    = $self->get_user_id($login);
 
 
-  $dbh->begin_work;
-
-  my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
-
-  my ($id)  = selectrow_query($::form, $dbh, $query, $login);
+  if (!$id) {
+    $dbh->rollback;
+    return;
+  }
 
 
-  $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
+  $dbh->begin_work;
 
   do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
   do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
 
   do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
   do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
-  do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
+  do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
 
 
-  $dbh->commit;
-  $u_dbh->commit if $u_dbh;
+  # TODO: SL::Auth::delete_user
+  # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
 
 
-  $::lxdebug->leave_sub;
+  $dbh->commit;
 }
 
 # --------------------------------------
 }
 
 # --------------------------------------
@@ -511,8 +529,6 @@ sub delete_user {
 my $session_id;
 
 sub restore_session {
 my $session_id;
 
 sub restore_session {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
 
   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
   my $self = shift;
 
   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
@@ -521,18 +537,16 @@ sub restore_session {
   $self->{SESSION}   = { };
 
   if (!$session_id) {
   $self->{SESSION}   = { };
 
   if (!$session_id) {
-    $main::lxdebug->leave_sub();
-    return SESSION_NONE;
+    return $self->session_restore_result(SESSION_NONE());
   }
 
   my ($dbh, $query, $sth, $cookie, $ref, $form);
 
   $form   = $main::form;
 
   }
 
   my ($dbh, $query, $sth, $cookie, $ref, $form);
 
   $form   = $main::form;
 
-  # Don't fail if the auth DB doesn't yet.
+  # Don't fail if the auth DB doesn't exist yet.
   if (!( $dbh = $self->dbconnect(1) )) {
   if (!( $dbh = $self->dbconnect(1) )) {
-    $::lxdebug->leave_sub;
-    return SESSION_NONE;
+    return $self->session_restore_result(SESSION_NONE());
   }
 
   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
   }
 
   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
@@ -541,17 +555,25 @@ sub restore_session {
 
   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
     $sth->finish if $sth;
 
   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
     $sth->finish if $sth;
-    $::lxdebug->leave_sub;
-    return SESSION_NONE;
+    return $self->session_restore_result(SESSION_NONE());
   }
 
   $cookie = $sth->fetchrow_hashref;
   $sth->finish;
 
   }
 
   $cookie = $sth->fetchrow_hashref;
   $sth->finish;
 
-  if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
+  # The session ID provided is valid in the following cases:
+  #  1. session ID exists in the database
+  #  2. hasn't expired yet
+  #  3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
+  #  4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address
+  $self->{api_token}   = $cookie->{api_token} if $cookie;
+  my $api_token_cookie = $self->get_api_token_cookie;
+  my $cookie_is_bad    = !$cookie || $cookie->{is_expired};
+  $cookie_is_bad     ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if  $api_token_cookie;
+  $cookie_is_bad     ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR}                       if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/;
+  if ($cookie_is_bad) {
     $self->destroy_session();
     $self->destroy_session();
-    $main::lxdebug->leave_sub();
-    return $cookie ? SESSION_EXPIRED : SESSION_NONE;
+    return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
   }
 
   if ($self->{column_information}->has('auto_restore')) {
   }
 
   if ($self->{column_information}->has('auto_restore')) {
@@ -560,9 +582,15 @@ sub restore_session {
     $self->_load_without_auto_restore_column($dbh, $session_id);
   }
 
     $self->_load_without_auto_restore_column($dbh, $session_id);
   }
 
-  $main::lxdebug->leave_sub();
+  return $self->session_restore_result(SESSION_OK());
+}
 
 
-  return SESSION_OK;
+sub session_restore_result {
+  my $self = shift;
+  if (@_) {
+    $self->{session_restore_result} = $_[0];
+  }
+  return $self->{session_restore_result};
 }
 
 sub _load_without_auto_restore_column {
 }
 
 sub _load_without_auto_restore_column {
@@ -592,52 +620,39 @@ SQL
 sub _load_with_auto_restore_column {
   my ($self, $dbh, $session_id) = @_;
 
 sub _load_with_auto_restore_column {
   my ($self, $dbh, $session_id) = @_;
 
-  my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
+  my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
 
   my $query = <<SQL;
     SELECT sess_key, sess_value, auto_restore
     FROM auth.session_content
     WHERE (session_id = ?)
 
   my $query = <<SQL;
     SELECT sess_key, sess_value, auto_restore
     FROM auth.session_content
     WHERE (session_id = ?)
-      AND (   auto_restore
-           OR sess_key IN (${auto_restore_keys}))
 SQL
   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 
   while (my $ref = $sth->fetchrow_hashref) {
 SQL
   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 
   while (my $ref = $sth->fetchrow_hashref) {
-    my $value = SL::Auth::SessionValue->new(auth         => $self,
-                                            key          => $ref->{sess_key},
-                                            value        => $ref->{sess_value},
-                                            auto_restore => $ref->{auto_restore},
-                                            raw          => 1);
-    $self->{SESSION}->{ $ref->{sess_key} } = $value;
-
-    next if defined $::form->{$ref->{sess_key}};
-
-    my $data                    = $value->get;
-    $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
+    if ($ref->{auto_restore} || $auto_restore_keys{$ref->{sess_key}}) {
+      my $value = SL::Auth::SessionValue->new(auth         => $self,
+                                              key          => $ref->{sess_key},
+                                              value        => $ref->{sess_value},
+                                              auto_restore => $ref->{auto_restore},
+                                              raw          => 1);
+      $self->{SESSION}->{ $ref->{sess_key} } = $value;
+
+      next if defined $::form->{$ref->{sess_key}};
+
+      my $data                    = $value->get;
+      $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
+    } else {
+      my $value = SL::Auth::SessionValue->new(auth => $self,
+                                              key  => $ref->{sess_key});
+      $self->{SESSION}->{ $ref->{sess_key} } = $value;
+    }
   }
 
   $sth->finish;
   }
 
   $sth->finish;
-
-  $query = <<SQL;
-    SELECT sess_key
-    FROM auth.session_content
-    WHERE (session_id = ?)
-      AND NOT COALESCE(auto_restore, FALSE)
-      AND (sess_key NOT IN (${auto_restore_keys}))
-SQL
-  $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
-
-  while (my $ref = $sth->fetchrow_hashref) {
-    my $value = SL::Auth::SessionValue->new(auth => $self,
-                                            key  => $ref->{sess_key});
-    $self->{SESSION}->{ $ref->{sess_key} } = $value;
-  }
 }
 
 sub destroy_session {
 }
 
 sub destroy_session {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
 
   if ($session_id) {
   my $self = shift;
 
   if ($session_id) {
@@ -655,16 +670,23 @@ sub destroy_session {
     $session_id      = undef;
     $self->{SESSION} = { };
   }
     $session_id      = undef;
     $self->{SESSION} = { };
   }
+}
+
+sub active_session_ids {
+  my $self  = shift;
+  my $dbh   = $self->dbconnect;
+
+  my $query = qq|SELECT id FROM auth.session|;
 
 
-  $main::lxdebug->leave_sub();
+  my @ids   = selectall_array_query($::form, $dbh, $query);
+
+  return @ids;
 }
 
 sub expire_sessions {
 }
 
 sub expire_sessions {
-  $main::lxdebug->enter_sub();
-
   my $self  = shift;
 
   my $self  = shift;
 
-  $main::lxdebug->leave_sub and return if !$self->session_tables_present;
+  return if !$self->session_tables_present;
 
   my $dbh   = $self->dbconnect();
 
 
   my $dbh   = $self->dbconnect();
 
@@ -689,20 +711,14 @@ sub expire_sessions {
 
     $dbh->commit();
   }
 
     $dbh->commit();
   }
-
-  $main::lxdebug->leave_sub();
 }
 
 sub _create_session_id {
 }
 
 sub _create_session_id {
-  $main::lxdebug->enter_sub();
-
   my @data;
   map { push @data, int(rand() * 255); } (1..32);
 
   my $id = md5_hex(pack 'C*', @data);
 
   my @data;
   map { push @data, int(rand() * 255); } (1..32);
 
   my $id = md5_hex(pack 'C*', @data);
 
-  $main::lxdebug->leave_sub();
-
   return $id;
 }
 
   return $id;
 }
 
@@ -711,13 +727,12 @@ sub create_or_refresh_session {
 }
 
 sub save_session {
 }
 
 sub save_session {
-  $::lxdebug->enter_sub;
   my $self         = shift;
   my $provided_dbh = shift;
 
   my $dbh          = $provided_dbh || $self->dbconnect(1);
 
   my $self         = shift;
   my $provided_dbh = shift;
 
   my $dbh          = $provided_dbh || $self->dbconnect(1);
 
-  $::lxdebug->leave_sub && return unless $dbh && $session_id;
+  return unless $dbh && $session_id;
 
   $dbh->begin_work unless $provided_dbh;
 
 
   $dbh->begin_work unless $provided_dbh;
 
@@ -725,7 +740,6 @@ sub save_session {
   # the admin is just trying to create the auth database.
   if (!$dbh->do(qq|LOCK auth.session_content|)) {
     $dbh->rollback unless $provided_dbh;
   # the admin is just trying to create the auth database.
   if (!$dbh->do(qq|LOCK auth.session_content|)) {
     $dbh->rollback unless $provided_dbh;
-    $::lxdebug->leave_sub;
     return;
   }
 
     return;
   }
 
@@ -747,6 +761,11 @@ sub save_session {
     do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
   }
 
     do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
   }
 
+  if ($self->{column_information}->has('api_token', 'session')) {
+    my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
+    do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
+  }
+
   my @values_to_save = grep    { $_->{fetched} }
                        values %{ $self->{SESSION} };
   if (@values_to_save) {
   my @values_to_save = grep    { $_->{fetched} }
                        values %{ $self->{SESSION} };
   if (@values_to_save) {
@@ -772,12 +791,9 @@ sub save_session {
   }
 
   $dbh->commit() unless $provided_dbh;
   }
 
   $dbh->commit() unless $provided_dbh;
-  $::lxdebug->leave_sub;
 }
 
 sub set_session_value {
 }
 
 sub set_session_value {
-  $main::lxdebug->enter_sub();
-
   my $self   = shift;
   my @params = @_;
 
   my $self   = shift;
   my @params = @_;
 
@@ -798,32 +814,22 @@ sub set_session_value {
     }
   }
 
     }
   }
 
-  $main::lxdebug->leave_sub();
-
   return $self;
 }
 
 sub delete_session_value {
   return $self;
 }
 
 sub delete_session_value {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
 
   $self->{SESSION} ||= { };
   delete @{ $self->{SESSION} }{ @_ };
 
   my $self = shift;
 
   $self->{SESSION} ||= { };
   delete @{ $self->{SESSION} }{ @_ };
 
-  $main::lxdebug->leave_sub();
-
   return $self;
 }
 
 sub get_session_value {
   return $self;
 }
 
 sub get_session_value {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
   my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
 
   my $self = shift;
   my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
 
-  $main::lxdebug->leave_sub();
-
   return $data;
 }
 
   return $data;
 }
 
@@ -883,113 +889,80 @@ sub set_cookie_environment_variable {
 }
 
 sub get_session_cookie_name {
 }
 
 sub get_session_cookie_name {
-  my $self = shift;
+  my ($self, %params) = @_;
+
+  $params{type}     ||= 'id';
+  my $name            = $self->{cookie_name} || 'lx_office_erp_session_id';
+  $name              .= '_api_token' if $params{type} eq 'api_token';
 
 
-  return $self->{cookie_name} || 'lx_office_erp_session_id';
+  return $name;
 }
 
 sub get_session_id {
   return $session_id;
 }
 
 }
 
 sub get_session_id {
   return $session_id;
 }
 
-sub session_tables_present {
-  $main::lxdebug->enter_sub();
+sub get_api_token_cookie {
+  my ($self) = @_;
 
 
-  my $self = shift;
+  $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
+}
+
+sub is_api_token_cookie_valid {
+  my ($self)             = @_;
+  my $provided_api_token = $self->get_api_token_cookie;
+  return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
+}
+
+sub _tables_present {
+  my ($self, @tables) = @_;
+  my $cache_key = join '_', @tables;
 
   # Only re-check for the presence of auth tables if either the check
   # hasn't been done before of if they weren't present.
 
   # Only re-check for the presence of auth tables if either the check
   # hasn't been done before of if they weren't present.
-  if ($self->{session_tables_present}) {
-    $main::lxdebug->leave_sub();
-    return $self->{session_tables_present};
-  }
-
-  my $dbh  = $self->dbconnect(1);
+  return $self->{"$cache_key\_tables_present"} ||= do {
+    my $dbh  = $self->dbconnect(1);
 
 
-  if (!$dbh) {
-    $main::lxdebug->leave_sub();
-    return 0;
-  }
+    if (!$dbh) {
+      return 0;
+    }
 
 
-  my $query =
-    qq|SELECT COUNT(*)
-       FROM pg_tables
-       WHERE (schemaname = 'auth')
-         AND (tablename IN ('session', 'session_content'))|;
+    my $query =
+      qq|SELECT COUNT(*)
+         FROM pg_tables
+         WHERE (schemaname = 'auth')
+           AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))|;
 
 
-  my ($count) = selectrow_query($main::form, $dbh, $query);
+    my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
 
 
-  $self->{session_tables_present} = 2 == $count;
+    scalar @tables == $count;
+  }
+}
 
 
-  $main::lxdebug->leave_sub();
+sub session_tables_present {
+  $_[0]->_tables_present('session', 'session_content');
+}
 
 
-  return $self->{session_tables_present};
+sub master_rights_present {
+  $_[0]->_tables_present('master_rights');
 }
 
 # --------------------------------------
 
 sub all_rights_full {
 }
 
 # --------------------------------------
 
 sub all_rights_full {
-  my $locale = $main::locale;
-
-  my @all_rights = (
-    ["--crm",                          $locale->text("CRM optional software")],
-    ["crm_search",                     $locale->text("CRM search")],
-    ["crm_new",                        $locale->text("CRM create customers, vendors and contacts")],
-    ["crm_service",                    $locale->text("CRM services")],
-    ["crm_admin",                      $locale->text("CRM admin")],
-    ["crm_adminuser",                  $locale->text("CRM user")],
-    ["crm_adminstatus",                $locale->text("CRM status")],
-    ["crm_email",                      $locale->text("CRM send email")],
-    ["crm_termin",                     $locale->text("CRM termin")],
-    ["crm_opportunity",                $locale->text("CRM opportunity")],
-    ["crm_knowhow",                    $locale->text("CRM know how")],
-    ["crm_follow",                     $locale->text("CRM follow up")],
-    ["crm_notices",                    $locale->text("CRM notices")],
-    ["crm_other",                      $locale->text("CRM other")],
-    ["--master_data",                  $locale->text("Master Data")],
-    ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
-    ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
-    ["project_edit",                   $locale->text("Create and edit projects")],
-    ["--ar",                           $locale->text("AR")],
-    ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
-    ["sales_order_edit",               $locale->text("Create and edit sales orders")],
-    ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
-    ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
-    ["dunning_edit",                   $locale->text("Create and edit dunnings")],
-    ["sales_all_edit",                 $locale->text("View/edit all employees sales documents")],
-    ["edit_prices",                    $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
-    ["--ap",                           $locale->text("AP")],
-    ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
-    ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
-    ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
-    ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
-    ["--warehouse_management",         $locale->text("Warehouse management")],
-    ["warehouse_contents",             $locale->text("View warehouse content")],
-    ["warehouse_management",           $locale->text("Warehouse management")],
-    ["--general_ledger_cash",          $locale->text("General ledger and cash")],
-    ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
-    ["datev_export",                   $locale->text("DATEV Export")],
-    ["cash",                           $locale->text("Receipt, payment, reconciliation")],
-    ["--reports",                      $locale->text('Reports')],
-    ["report",                         $locale->text('All reports')],
-    ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
-    ["--batch_printing",               $locale->text("Batch Printing")],
-    ["batch_printing",                 $locale->text("Batch Printing")],
-    ["--others",                       $locale->text("Others")],
-    ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
-    ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
-    );
-
-  return @all_rights;
+  my ($self) = @_;
+
+  @{ $self->{master_rights} ||= do {
+      $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position");
+    }
+  }
 }
 
 sub all_rights {
 }
 
 sub all_rights {
-  return grep !/^--/, map { $_->[0] } all_rights_full();
+  return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
 }
 
 sub read_groups {
 }
 
 sub read_groups {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
 
   my $form   = $main::form;
   my $self = shift;
 
   my $form   = $main::form;
@@ -1033,18 +1006,14 @@ sub read_groups {
       $group->{rights}->{$row->{right}} |= $row->{granted};
     }
 
       $group->{rights}->{$row->{right}} |= $row->{granted};
     }
 
-    map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
+    map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
   }
   $sth->finish();
 
   }
   $sth->finish();
 
-  $main::lxdebug->leave_sub();
-
   return $groups;
 }
 
 sub save_group {
   return $groups;
 }
 
 sub save_group {
-  $main::lxdebug->enter_sub();
-
   my $self  = shift;
   my $group = shift;
 
   my $self  = shift;
   my $group = shift;
 
@@ -1085,13 +1054,9 @@ sub save_group {
   $sth->finish();
 
   $dbh->commit();
   $sth->finish();
 
   $dbh->commit();
-
-  $main::lxdebug->leave_sub();
 }
 
 sub delete_group {
 }
 
 sub delete_group {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
   my $id   = shift;
 
   my $self = shift;
   my $id   = shift;
 
@@ -1105,13 +1070,9 @@ sub delete_group {
   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
 
   $dbh->commit();
   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
 
   $dbh->commit();
-
-  $main::lxdebug->leave_sub();
 }
 
 sub evaluate_rights_ary {
 }
 
 sub evaluate_rights_ary {
-  $main::lxdebug->enter_sub(2);
-
   my $ary    = shift;
 
   my $value  = 0;
   my $ary    = shift;
 
   my $value  = 0;
@@ -1137,14 +1098,10 @@ sub evaluate_rights_ary {
     }
   }
 
     }
   }
 
-  $main::lxdebug->leave_sub(2);
-
   return $value;
 }
 
 sub _parse_rights_string {
   return $value;
 }
 
 sub _parse_rights_string {
-  $main::lxdebug->enter_sub(2);
-
   my $self   = shift;
 
   my $login  = shift;
   my $self   = shift;
 
   my $login  = shift;
@@ -1171,7 +1128,6 @@ sub _parse_rights_string {
       pop @stack;
 
       if (!@stack) {
       pop @stack;
 
       if (!@stack) {
-        $main::lxdebug->leave_sub(2);
         return 0;
       }
 
         return 0;
       }
 
@@ -1181,20 +1137,16 @@ sub _parse_rights_string {
       push @{$cur_ary}, $token;
 
     } else {
       push @{$cur_ary}, $token;
 
     } else {
-      push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
+      push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
     }
   }
 
   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
 
     }
   }
 
   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
 
-  $main::lxdebug->leave_sub(2);
-
   return $result;
 }
 
 sub check_right {
   return $result;
 }
 
 sub check_right {
-  $main::lxdebug->enter_sub(2);
-
   my $self    = shift;
   my $login   = shift;
   my $right   = shift;
   my $self    = shift;
   my $login   = shift;
   my $right   = shift;
@@ -1213,17 +1165,13 @@ sub check_right {
   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
   $granted    = $default if (!defined $granted);
 
   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
   $granted    = $default if (!defined $granted);
 
-  $main::lxdebug->leave_sub(2);
-
   return $granted;
 }
 
 sub assert {
   return $granted;
 }
 
 sub assert {
-  $::lxdebug->enter_sub(2);
   my ($self, $right, $dont_abort) = @_;
 
   if ($self->check_right($::myconfig{login}, $right)) {
   my ($self, $right, $dont_abort) = @_;
 
   if ($self->check_right($::myconfig{login}, $right)) {
-    $::lxdebug->leave_sub(2);
     return 1;
   }
 
     return 1;
   }
 
@@ -1232,19 +1180,17 @@ sub assert {
     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
   }
 
     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
   }
 
-  $::lxdebug->leave_sub(2);
-
   return 0;
 }
 
 sub load_rights_for_user {
   return 0;
 }
 
 sub load_rights_for_user {
-  $::lxdebug->enter_sub;
-
   my ($self, $login) = @_;
   my $dbh   = $self->dbconnect;
   my ($query, $sth, $row, $rights);
 
   my ($self, $login) = @_;
   my $dbh   = $self->dbconnect;
   my ($query, $sth, $row, $rights);
 
-  $rights = { map { $_ => 0 } all_rights() };
+  $rights = { map { $_ => 0 } $self->all_rights };
+
+  return $rights if !$self->client || !$login;
 
   $query =
     qq|SELECT gr."right", gr.granted
 
   $query =
     qq|SELECT gr."right", gr.granted
@@ -1253,17 +1199,19 @@ sub load_rights_for_user {
          (SELECT ug.group_id
           FROM auth.user_group ug
           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
          (SELECT ug.group_id
           FROM auth.user_group ug
           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
-          WHERE u.login = ?)|;
+          WHERE u.login = ?)
+       AND group_id IN
+         (SELECT cg.group_id
+          FROM auth.clients_groups cg
+          WHERE cg.client_id = ?)|;
 
 
-  $sth = prepare_execute_query($::form, $dbh, $query, $login);
+  $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
 
   while ($row = $sth->fetchrow_hashref()) {
     $rights->{$row->{right}} |= $row->{granted};
   }
   $sth->finish();
 
 
   while ($row = $sth->fetchrow_hashref()) {
     $rights->{$row->{right}} |= $row->{granted};
   }
   $sth->finish();
 
-  $::lxdebug->leave_sub;
-
   return $rights;
 }
 
   return $rights;
 }
 
@@ -1278,11 +1226,12 @@ __END__
 
 SL::Auth - Authentication and session handling
 
 
 SL::Auth - Authentication and session handling
 
-=head1 FUNCTIONS
+=head1 METHODS
 
 =over 4
 
 =item C<set_session_value @values>
 
 =over 4
 
 =item C<set_session_value @values>
+
 =item C<set_session_value %values>
 
 Store all values of C<@values> or C<%values> in the session. Each
 =item C<set_session_value %values>
 
 Store all values of C<@values> or C<%values> in the session. Each
@@ -1327,7 +1276,7 @@ Stores the session values in the database. This is the only function
 that actually stores stuff in the database. Neither the various
 setters nor the deleter access the database.
 
 that actually stores stuff in the database. Neither the various
 setters nor the deleter access the database.
 
-=item <save_form_in_session %params>
+=item C<save_form_in_session %params>
 
 Stores the content of C<$params{form}> (default: C<$::form>) in the
 session using L</create_unique_sesion_value>.
 
 Stores the content of C<$params{form}> (default: C<$::form>) in the
 session using L</create_unique_sesion_value>.
@@ -1341,7 +1290,7 @@ can be given as an array ref in C<$params{skip_keys}>.
 
 Returns the unique key under which the form is stored.
 
 
 Returns the unique key under which the form is stored.
 
-=item <restore_form_from_session $key, %params>
+=item C<restore_form_from_session $key, %params>
 
 Restores the form from the session into C<$params{form}> (default:
 C<$::form>).
 
 Restores the form from the session into C<$params{form}> (default:
 C<$::form>).
@@ -1352,6 +1301,14 @@ is on by default.
 
 Returns C<$self>.
 
 
 Returns C<$self>.
 
+=item C<reset>
+
+C<reset> deletes every state information from previous requests, but does not
+close the database connection.
+
+Creating a new database handle on each request can take up to 30% of the
+pre-request startup time, so we want to avoid that for fast ajax calls.
+
 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS
Unnamed repository; edit this file 'description' to name the repository.