projects / kivitendo-erp.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
changelog zu Workflow zu Lieferantenauftrag
[kivitendo-erp.git] / SL / Auth.pm
diff --git a/SL/Auth.pm b/SL/Auth.pm
index d0e8c9a..6be6933 100644 (file)
--- a/SL/Auth.pm
+++ b/SL/Auth.pm
@@ -5,8 +5,9 @@ use DBI;
 use Digest::MD5 qw(md5_hex);
 use IO::File;
 use Time::HiRes qw(gettimeofday);
 use Digest::MD5 qw(md5_hex);
 use IO::File;
 use Time::HiRes qw(gettimeofday);
-use List::MoreUtils qw(uniq);
+use List::MoreUtils qw(any uniq);
 use YAML;
 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,30 +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 selectall_ids);
 
 use strict;
 
 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
 
 
 use strict;
 
 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
 
-sub new {
-  $main::lxdebug->enter_sub();
-
-  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}            = { };
@@ -50,33 +50,60 @@ 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 => $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});
-  }
+  $_->reset for @{ $self->{authenticators} };
+
+  $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 get_default_client_id {
+  my ($self) = @_;
+
+  my $dbh    = $self->dbconnect;
+
+  return unless $dbh;
 
 
-  return $dbh;
+  my $row = $dbh->selectrow_hashref(qq|SELECT id FROM auth.clients WHERE is_default = TRUE LIMIT 1|);
+
+  return $row->{id} if $row;
 }
 
 sub DESTROY {
 }
 
 sub DESTROY {
@@ -91,37 +118,58 @@ sub mini_error {
 
   my ($self, @msg) = @_;
   if ($ENV{HTTP_USER_AGENT}) {
 
   my ($self, @msg) = @_;
   if ($ENV{HTTP_USER_AGENT}) {
-    print Form->create_http_response(content_type => 'text/html');
+    # $::form might not be initialized yet at this point — therefore
+    # we cannot use "create_http_response" yet.
+    my $cgi = CGI->new('');
+    print $cgi->header('-type' => 'text/html', '-charset' => 'UTF-8');
     print "<pre>", join ('<br>', @msg), "</pre>";
   } else {
     print STDERR "Error: @msg\n";
   }
     print "<pre>", join ('<br>', @msg), "</pre>";
   } 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} };
 
   # Prevent password leakage to log files when dumping Auth instances.
   $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
 
 
   map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
 
   # Prevent password leakage to log files when dumping Auth instances.
   $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
 
-  $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 ($params{unit_tests_database}) {
+    $self->{DB_config}   = $::lx_office_conf{'testing/database'};
+    $self->{module}      = 'DB';
 
 
-  } elsif ($self->{module} eq 'LDAP') {
-    $self->{authenticator} = SL::Auth::LDAP->new($self);
+  } else {
+    $self->{DB_config}   = $::lx_office_conf{'authentication/database'};
   }
 
   }
 
-  if (!$self->{authenticator}) {
-    my $locale = Locale->new('en');
-    $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
+  $self->{authenticators} =  [];
+  $self->{module}       ||=  'DB';
+  $self->{module}         =~ s{^ +| +$}{}g;
+
+  foreach my $module (split m{ +}, $self->{module}) {
+    my $config_name;
+    ($module, $config_name) = split m{:}, $module, 2;
+    $config_name          ||= $module eq 'DB' ? 'database' : lc($module);
+    my $config              = $::lx_office_conf{'authentication/' . $config_name};
+
+    if (!$config) {
+      my $locale = Locale->new('en');
+      $self->mini_error($locale->text('Missing configuration section "authentication/#1" in "config/kivitendo.conf".', $config_name));
+    }
+
+    if ($module eq 'DB') {
+      push @{ $self->{authenticators} }, SL::Auth::DB->new($self);
+
+    } elsif ($module eq 'LDAP') {
+      push @{ $self->{authenticators} }, SL::Auth::LDAP->new($config);
+
+    } else {
+      my $locale = Locale->new('en');
+      $self->mini_error($locale->text('Unknown authenticantion module #1 specified in "config/kivitendo.conf".', $module));
+    }
   }
 
   my $cfg = $self->{DB_config};
   }
 
   my $cfg = $self->{DB_config};
@@ -136,60 +184,75 @@ sub _read_auth_config {
     $self->mini_error($locale->text('config/kivitendo.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();
+  $_->verify_config for @{ $self->{authenticators} };
 
   $self->{session_timeout} *= 1;
   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
 
   $self->{session_timeout} *= 1;
   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
+}
+
+sub has_access_to_client {
+  my ($self, $login) = @_;
 
 
-  $main::lxdebug->leave_sub();
+  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
+
+  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 $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
   if (defined $session_root_auth && $session_root_auth == OK) {
   my ($self, $password) = @_;
 
   my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
   if (defined $session_root_auth && $session_root_auth == OK) {
-    $::lxdebug->leave_sub;
     return OK;
   }
 
   if (!defined $password) {
     return OK;
   }
 
   if (!defined $password) {
-    $::lxdebug->leave_sub;
     return ERR_PASSWORD;
   }
 
     return ERR_PASSWORD;
   }
 
-  $password             = SL::Auth::Password->hash(login => 'root', password => $password);
   my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_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);
 
 
   my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
   $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
 
-  $::lxdebug->leave_sub;
   return $result;
 }
 
 sub authenticate {
   return $result;
 }
 
 sub authenticate {
-  $main::lxdebug->enter_sub();
-
   my ($self, $login, $password) = @_;
 
   my ($self, $login, $password) = @_;
 
+  if (!$self->client || !$self->has_access_to_client($login)) {
+    return ERR_PASSWORD;
+  }
+
   my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
   if (defined $session_auth && $session_auth == OK) {
   my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
   if (defined $session_auth && $session_auth == OK) {
-    $::lxdebug->leave_sub;
     return OK;
   }
 
   if (!defined $password) {
     return OK;
   }
 
   if (!defined $password) {
-    $::lxdebug->leave_sub;
     return ERR_PASSWORD;
   }
 
     return ERR_PASSWORD;
   }
 
-  my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
-  $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login);
+  my $result = ERR_USER;
+  if ($login) {
+    foreach my $authenticator (@{ $self->{authenticators} }) {
+      $result = $authenticator->authenticate($login, $password);
+      last if $result == OK;
+    }
+  }
 
 
-  $::lxdebug->leave_sub;
+  $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
   return $result;
 }
 
   return $result;
 }
 
@@ -212,13 +275,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};
   }
 
@@ -231,33 +291,31 @@ 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)    = @_;
 
   $dbh   ||= $self->dbconnect();
   my ($self, $dbh)    = @_;
 
   $dbh   ||= $self->dbconnect();
@@ -265,26 +323,18 @@ sub check_tables {
 
   my ($count) = $dbh->selectrow_array($query);
 
 
   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 = @_;
 
@@ -306,18 +356,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");
 
@@ -329,8 +374,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 kivitendo 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();
@@ -339,28 +384,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 = @_;
@@ -397,31 +431,30 @@ sub save_user {
   }
 
   $dbh->commit();
   }
 
   $dbh->commit();
-
-  $main::lxdebug->leave_sub();
 }
 
 sub can_change_password {
   my $self = shift;
 
 }
 
 sub can_change_password {
   my $self = shift;
 
-  return $self->{authenticator}->can_change_password();
+  return any { $_->can_change_password } @{ $self->{authenticators} };
 }
 
 sub change_password {
 }
 
 sub change_password {
-  $main::lxdebug->enter_sub();
-
   my ($self, $login, $new_password) = @_;
 
   my ($self, $login, $new_password) = @_;
 
-  my $result = $self->{authenticator}->change_password($login, $new_password);
+  my $overall_result = OK;
 
 
-  $main::lxdebug->leave_sub();
+  foreach my $authenticator (@{ $self->{authenticators} }) {
+    next unless $authenticator->can_change_password;
 
 
-  return $result;
+    my $result = $authenticator->change_password($login, $new_password);
+    $overall_result = $result if $result != OK;
+  }
+
+  return $overall_result;
 }
 
 sub read_all_users {
 }
 
 sub read_all_users {
-  $main::lxdebug->enter_sub();
-
   my $self  = shift;
 
   my $dbh   = $self->dbconnect();
   my $self  = shift;
 
   my $dbh   = $self->dbconnect();
@@ -454,14 +487,10 @@ sub read_all_users {
 
   $sth->finish();
 
 
   $sth->finish();
 
-  $main::lxdebug->leave_sub();
-
   return %users;
 }
 
 sub read_user {
   return %users;
 }
 
 sub read_user {
-  $main::lxdebug->enter_sub();
-
   my ($self, %params) = @_;
 
   my $dbh   = $self->dbconnect();
   my ($self, %params) = @_;
 
   my $dbh   = $self->dbconnect();
@@ -501,53 +530,41 @@ sub read_user {
 
   $sth->finish();
 
 
   $sth->finish();
 
-  $main::lxdebug->leave_sub();
-
   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 $dbh   = $self->dbconnect;
   my $id    = $self->get_user_id($login);
   my $self  = shift;
   my $login = shift;
 
   my $dbh   = $self->dbconnect;
   my $id    = $self->get_user_id($login);
-  my $user_db_exists;
-
-  $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
 
 
-  my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
-  $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
-
-  $u_dbh->begin_work if $u_dbh && $user_db_exists;
+  if (!$id) {
+    $dbh->rollback;
+    return;
+  }
 
   $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 WHERE id = ?|, $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 WHERE id = ?|, $id);
-  do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
 
 
-  $dbh->commit;
-  $u_dbh->commit if $u_dbh && $user_db_exists;
+  # 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;
 }
 
 # --------------------------------------
 }
 
 # --------------------------------------
@@ -555,8 +572,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());
@@ -565,18 +580,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
@@ -585,8 +598,7 @@ 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;
   }
 
   $cookie = $sth->fetchrow_hashref;
@@ -595,17 +607,14 @@ sub restore_session {
   # The session ID provided is valid in the following cases:
   #  1. session ID exists in the database
   #  2. hasn't expired yet
   # The session ID provided is valid in the following cases:
   #  1. session ID exists in the database
   #  2. hasn't expired yet
-  #  3. if form field '{AUTH}api_token' is given: form field must equal database column 'auth.session.api_token' for the session ID
-  #  4. if form field '{AUTH}api_token' is NOT given then: the requestee's IP address must match the stored IP address
+  #  3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
   $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;
   $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;
   if ($cookie_is_bad) {
     $self->destroy_session();
   if ($cookie_is_bad) {
     $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')) {
@@ -614,9 +623,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 {
@@ -646,18 +661,18 @@ 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
 
   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}))
+    WHERE (session_id = ?) AND (auto_restore OR sess_key IN (@{[ join ',', ("?") x keys %auto_restore_keys ]}))
 SQL
 SQL
-  my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
+  my $sth = prepare_execute_query($::form, $dbh, $query, $session_id, keys %auto_restore_keys);
 
 
+  my $need_delete;
   while (my $ref = $sth->fetchrow_hashref) {
   while (my $ref = $sth->fetchrow_hashref) {
+    $need_delete = 1 if $ref->{auto_restore};
     my $value = SL::Auth::SessionValue->new(auth         => $self,
                                             key          => $ref->{sess_key},
                                             value        => $ref->{sess_value},
     my $value = SL::Auth::SessionValue->new(auth         => $self,
                                             key          => $ref->{sess_key},
                                             value        => $ref->{sess_value},
@@ -673,25 +688,12 @@ SQL
 
   $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;
+  if ($need_delete) {
+    do_query($::form, $dbh, 'DELETE FROM auth.session_content WHERE auto_restore AND session_id = ?', $session_id);
   }
 }
 
 sub destroy_session {
   }
 }
 
 sub destroy_session {
-  $main::lxdebug->enter_sub();
-
   my $self = shift;
 
   if ($session_id) {
   my $self = shift;
 
   if ($session_id) {
@@ -709,16 +711,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();
 
@@ -743,20 +752,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;
 }
 
@@ -765,13 +768,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;
 
@@ -779,20 +781,9 @@ 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;
   }
 
-  my @unfetched_keys = map     { $_->{key}        }
-                       grep    { ! $_->{fetched}  }
-                       values %{ $self->{SESSION} };
-  # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
-  # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
-  my $query          = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
-  $query            .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
-
-  do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
-
   my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
 
   if ($id) {
   my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
 
   if ($id) {
@@ -806,37 +797,46 @@ sub save_session {
     do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
   }
 
     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} }
+  my @values_to_save = grep    { $_->{modified} }
                        values %{ $self->{SESSION} };
   if (@values_to_save) {
                        values %{ $self->{SESSION} };
   if (@values_to_save) {
-    my ($columns, $placeholders) = ('', '');
+    my %known_keys = map { $_ => 1 }
+      selectall_ids($::form, $dbh, qq|SELECT sess_key FROM auth.session_content WHERE session_id = ?|, 'sess_key', $session_id);
     my $auto_restore             = $self->{column_information}->has('auto_restore');
 
     my $auto_restore             = $self->{column_information}->has('auto_restore');
 
-    if ($auto_restore) {
-      $columns      .= ', auto_restore';
-      $placeholders .= ', ?';
-    }
+    my $insert_query  = $auto_restore
+      ? "INSERT INTO auth.session_content (session_id, sess_key, sess_value, auto_restore) VALUES (?, ?, ?, ?)"
+      : "INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)";
+    my $insert_sth = prepare_query($::form, $dbh, $insert_query);
 
 
-    $query  = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
-    my $sth = prepare_query($::form, $dbh, $query);
+    my $update_query  = $auto_restore
+      ? "UPDATE auth.session_content SET sess_value = ?, auto_restore = ? WHERE session_id = ? AND sess_key = ?"
+      : "UPDATE auth.session_content SET sess_value = ? WHERE session_id = ? AND sess_key = ?";
+    my $update_sth = prepare_query($::form, $dbh, $update_query);
 
     foreach my $value (@values_to_save) {
       my @values = ($value->{key}, $value->get_dumped);
       push @values, $value->{auto_restore} if $auto_restore;
 
 
     foreach my $value (@values_to_save) {
       my @values = ($value->{key}, $value->get_dumped);
       push @values, $value->{auto_restore} if $auto_restore;
 
-      do_statement($::form, $sth, $query, $session_id, @values);
+      if ($known_keys{$value->{key}}) {
+        do_statement($::form, $update_sth, $update_query,
+          $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore, $session_id, $value->{key}
+        );
+      } else {
+        do_statement($::form, $insert_sth, $insert_query,
+          $session_id, $value->{key}, $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore
+        );
+      }
     }
 
     }
 
-    $sth->finish();
+    $insert_sth->finish;
+    $update_sth->finish;
   }
 
   $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 = @_;
 
@@ -848,45 +848,38 @@ sub set_session_value {
     if (ref $key eq 'HASH') {
       $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key          => $key->{key},
                                                                       value        => $key->{value},
     if (ref $key eq 'HASH') {
       $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key          => $key->{key},
                                                                       value        => $key->{value},
+                                                                      modified     => 1,
                                                                       auto_restore => $key->{auto_restore});
 
     } else {
       my $value = shift @params;
       $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key   => $key,
                                                                       auto_restore => $key->{auto_restore});
 
     } else {
       my $value = shift @params;
       $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key   => $key,
-                                                               value => $value);
+                                                               value => $value,
+                                                               modified => 1);
     }
   }
 
     }
   }
 
-  $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, $key) = @_;
 
 
-  my $self = shift;
-  my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
-
-  $main::lxdebug->leave_sub();
+  return if !$self->{SESSION};
 
 
-  return $data;
+  ($self->{SESSION}{$key} //= SL::Auth::SessionValue->new(auth => $self, key => $key))->get
 }
 
 }
 
-sub create_unique_sesion_value {
+sub create_unique_session_value {
   my ($self, $value, %params) = @_;
 
   $self->{SESSION} ||= { };
   my ($self, $value, %params) = @_;
 
   $self->{SESSION} ||= { };
@@ -919,7 +912,7 @@ sub save_form_in_session {
     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
   }
 
     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
   }
 
-  return $self->create_unique_sesion_value($data, %params);
+  return $self->create_unique_session_value($data, %params);
 }
 
 sub restore_form_from_session {
 }
 
 sub restore_form_from_session {
@@ -961,106 +954,61 @@ sub get_api_token_cookie {
   $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
 }
 
   $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
 }
 
-sub session_tables_present {
-  $main::lxdebug->enter_sub();
+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);
+}
 
 
-  my $self = shift;
+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 customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
-    ["customer_vendor_all_edit",       $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
-    ["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 kivitendo installation settings (all menu entries beneath 'System')")],
-    ["admin",                          $locale->text("Administration (Used to access instance administration from user logins)")],
-    );
-
-  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;
@@ -1104,18 +1052,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;
 
@@ -1156,13 +1100,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;
 
@@ -1176,46 +1116,53 @@ 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 $action = '|';
   my $ary    = shift;
 
   my $value  = 0;
   my $action = '|';
+  my $negate = 0;
 
   foreach my $el (@{$ary}) {
 
   foreach my $el (@{$ary}) {
+    next unless defined $el;
+
     if (ref $el eq "ARRAY") {
     if (ref $el eq "ARRAY") {
+      my $val = evaluate_rights_ary($el);
+      $val    = !$val if $negate;
+      $negate = 0;
       if ($action eq '|') {
       if ($action eq '|') {
-        $value |= evaluate_rights_ary($el);
+        $value |= $val;
       } else {
       } else {
-        $value &= evaluate_rights_ary($el);
+        $value &= $val;
       }
 
     } elsif (($el eq '&') || ($el eq '|')) {
       $action = $el;
 
       }
 
     } elsif (($el eq '&') || ($el eq '|')) {
       $action = $el;
 
+    } elsif ($el eq '!') {
+      $negate = !$negate;
+
     } elsif ($action eq '|') {
     } elsif ($action eq '|') {
-      $value |= $el;
+      my $val = $el;
+      $val    = !$val if $negate;
+      $negate = 0;
+      $value |= $val;
 
     } else {
 
     } else {
-      $value &= $el;
+      my $val = $el;
+      $val    = !$val if $negate;
+      $negate = 0;
+      $value &= $val;
 
     }
   }
 
 
     }
   }
 
-  $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;
@@ -1242,7 +1189,6 @@ sub _parse_rights_string {
       pop @stack;
 
       if (!@stack) {
       pop @stack;
 
       if (!@stack) {
-        $main::lxdebug->leave_sub(2);
         return 0;
       }
 
         return 0;
       }
 
@@ -1252,20 +1198,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;
@@ -1284,38 +1226,40 @@ 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;
 }
 
   return $granted;
 }
 
+sub deny_access {
+  my ($self) = @_;
+
+  $::dispatcher->reply_with_json_error(error => 'access') if $::request->type eq 'json';
+
+  delete $::form->{title};
+  $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
+}
+
 sub assert {
 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;
   }
 
   if (!$dont_abort) {
     return 1;
   }
 
   if (!$dont_abort) {
-    delete $::form->{title};
-    $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
+    $self->deny_access;
   }
 
   }
 
-  $::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
@@ -1324,17 +1268,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;
 }
 
@@ -1349,7 +1295,7 @@ __END__
 
 SL::Auth - Authentication and session handling
 
 
 SL::Auth - Authentication and session handling
 
-=head1 FUNCTIONS
+=head1 METHODS
 
 =over 4
 
 
 =over 4
 
@@ -1386,7 +1332,7 @@ The values can be any Perl structure. They are stored as YAML dumps.
 Retrieve a value from the session. Returns C<undef> if the value
 doesn't exist.
 
 Retrieve a value from the session. Returns C<undef> if the value
 doesn't exist.
 
-=item C<create_unique_sesion_value $value, %params>
+=item C<create_unique_session_value $value, %params>
 
 Create a unique key in the session and store C<$value>
 there.
 
 Create a unique key in the session and store C<$value>
 there.
@@ -1399,10 +1345,10 @@ 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
 
 Stores the content of C<$params{form}> (default: C<$::form>) in the
-session using L</create_unique_sesion_value>.
+session using L</create_unique_session_value>.
 
 If C<$params{non_scalars}> is trueish then non-scalar values will be
 stored as well. Default is to only store scalar values.
 
 If C<$params{non_scalars}> is trueish then non-scalar values will be
 stored as well. Default is to only store scalar values.
@@ -1413,7 +1359,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>).
@@ -1424,6 +1370,19 @@ 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.
+
+=item C<assert, $right, $dont_abort>
+
+Checks if current user has the C<$right>. If C<$dont_abort> is falsish
+the request dies with a access denied error, otherwise returns true or false.
+
 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS
Unnamed repository; edit this file 'description' to name the repository.