PriceSource: credit_notes auch im Popup unterstützen

[kivitendo-erp.git] / SL / Auth.pm

diff --git a/SL/Auth.pm b/SL/Auth.pm
index ddd8233..a2236a7 100644 (file)
--- a/SL/Auth.pm
+++ b/SL/Auth.pm
@@ -26,19 +26,18 @@ use strict;
 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
 
 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();
+use Rose::Object::MakeMethods::Generic (
+  scalar => [ qw(client) ],
+);

 
 

-  my $type = shift;
-  my $self = {};

 
 

-  bless $self, $type;
+sub new {
+  my ($type, %params) = @_;
+  my $self            = bless {}, $type;

 
 

-  $self->_read_auth_config();
+  $self->_read_auth_config(%params);

   $self->reset;
 
   $self->reset;
 

-  $main::lxdebug->leave_sub();
-

   return $self;
 }
 
   return $self;
 }
 


@@ -51,32 +50,25 @@ sub reset {
   $self->{unique_counter}     = 0;
   $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
   $self->{authenticator}->reset;
   $self->{unique_counter}     = 0;
   $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
   $self->{authenticator}->reset;

+
+  $self->client(undef);

 }
 
 }
 

-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 set_client {
+  my ($self, $id_or_name) = @_;

 
 

-  if (!$may_fail && !$dbh) {
-    $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
-  }
+  $self->client(undef);

 
 

-  if ($user{dboptions} && $dbh) {
-    $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
-  }
+  return undef unless $id_or_name;
+
+  my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
+  my $dbh    = $self->dbconnect;

 
 

-  return $dbh;
+  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 {


@@ -100,17 +92,21 @@ sub mini_error {
 }
 
 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 ($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);


@@ -140,23 +136,34 @@ sub _read_auth_config {
 
   $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) = @_;
+
+  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 $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;
   }
 


@@ -166,30 +173,27 @@ sub authenticate_root {
   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;
   }
 
   my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
     return ERR_PASSWORD;
   }
 
   my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;

-  $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login);
-
-  $::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 +216,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 +232,25 @@ 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}) {
     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
   }
 
 
   if (!$may_fail && !$self->{dbh}) {
     $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 check_tables {
 }
 
 sub check_tables {

-  $main::lxdebug->enter_sub();
-

   my ($self, $dbh)    = @_;
 
   $dbh   ||= $self->dbconnect();
   my ($self, $dbh)    = @_;
 
   $dbh   ||= $self->dbconnect();


@@ -265,26 +258,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 +291,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 +309,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();


@@ -339,28 +319,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,8 +366,6 @@ sub save_user {
   }
 
   $dbh->commit();
   }
 
   $dbh->commit();

-
-  $main::lxdebug->leave_sub();

 }
 
 sub can_change_password {
 }
 
 sub can_change_password {


@@ -408,20 +375,14 @@ 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);
 

-  $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();


@@ -454,14 +415,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();


@@ -489,58 +446,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;

 
 

-  $main::lxdebug->leave_sub();
+  # 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}";
+
+  $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 $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;

 }
 
 # --------------------------------------
 }
 
 # --------------------------------------


@@ -548,8 +500,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());


@@ -558,8 +508,7 @@ 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);
   }
 
   my ($dbh, $query, $sth, $cookie, $ref, $form);


@@ -568,8 +517,7 @@ sub restore_session {
 
   # Don't fail if the auth DB doesn't yet.
   if (!( $dbh = $self->dbconnect(1) )) {
 
   # Don't fail if the auth DB doesn't yet.
   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


@@ -578,17 +526,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;
+  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')) {


@@ -597,9 +553,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 {


@@ -673,8 +635,6 @@ SQL
 }
 
 sub destroy_session {
 }
 
 sub destroy_session {

-  $main::lxdebug->enter_sub();
-

   my $self = shift;
 
   if ($session_id) {
   my $self = shift;
 
   if ($session_id) {


@@ -692,16 +652,23 @@ sub destroy_session {
     $session_id      = undef;
     $self->{SESSION} = { };
   }
     $session_id      = undef;
     $self->{SESSION} = { };
   }

+}

 
 

-  $main::lxdebug->leave_sub();
+sub active_session_ids {
+  my $self  = shift;
+  my $dbh   = $self->dbconnect;
+
+  my $query = qq|SELECT id FROM auth.session|;
+
+  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();
 


@@ -726,20 +693,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;
 }
 


@@ -748,13 +709,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;
 


@@ -762,7 +722,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;
   }
 


@@ -784,6 +743,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) {


@@ -809,12 +773,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 = @_;
 


@@ -835,32 +796,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;
 }
 


@@ -920,31 +871,43 @@ 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) = @_;
+
+  $::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 session_tables_present {

   my $self = shift;
 
   # 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}) {
   my $self = shift;
 
   # 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);
 
   if (!$dbh) {
     return $self->{session_tables_present};
   }
 
   my $dbh  = $self->dbconnect(1);
 
   if (!$dbh) {

-    $main::lxdebug->leave_sub();

     return 0;
   }
 
     return 0;
   }
 


@@ -958,8 +921,6 @@ sub session_tables_present {
 
   $self->{session_tables_present} = 2 == $count;
 
 
   $self->{session_tables_present} = 2 == $count;
 

-  $main::lxdebug->leave_sub();
-

   return $self->{session_tables_present};
 }
 
   return $self->{session_tables_present};
 }
 


@@ -987,8 +948,10 @@ sub all_rights_full {
     ["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")],
     ["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")],

+    ["part_service_assembly_details",  $locale->text("Show details and reports of parts, services, assemblies")],

     ["project_edit",                   $locale->text("Create and edit projects")],
     ["--ar",                           $locale->text("AR")],
     ["project_edit",                   $locale->text("Create and edit projects")],
     ["--ar",                           $locale->text("AR")],

+    ["requirement_spec_edit",          $locale->text("Create and edit requirement specs")],

     ["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")],
     ["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")],


@@ -996,11 +959,15 @@ sub all_rights_full {
     ["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)")],
     ["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)")],

+    ["show_ar_transactions",           $locale->text("Show AR transactions as part of AR invoice report")],
+    ["delivery_plan",                  $locale->text("Show delivery plan")],
+    ["delivery_value_report",          $locale->text("Show delivery value report")],

     ["--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")],
     ["--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")],

+    ["show_ap_transactions",           $locale->text("Show AP transactions as part of AP invoice report")],

     ["--warehouse_management",         $locale->text("Warehouse management")],
     ["warehouse_contents",             $locale->text("View warehouse content")],
     ["warehouse_management",           $locale->text("Warehouse management")],
     ["--warehouse_management",         $locale->text("Warehouse management")],
     ["warehouse_contents",             $locale->text("View warehouse content")],
     ["warehouse_management",           $locale->text("Warehouse management")],


@@ -1013,10 +980,13 @@ sub all_rights_full {
     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
     ["--batch_printing",               $locale->text("Batch Printing")],
     ["batch_printing",                 $locale->text("Batch Printing")],
     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
     ["--batch_printing",               $locale->text("Batch Printing")],
     ["batch_printing",                 $locale->text("Batch Printing")],

+    ["--configuration",                $locale->text("Configuration")],
+    ["config",                         $locale->text("Change kivitendo installation settings (most entries in the 'System' menu)")],
+    ["admin",                          $locale->text("Client administration: configuration, editing templates, task server control, background jobs (remaining entries in the 'System' menu)")],

     ["--others",                       $locale->text("Others")],
     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
     ["--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')")],
-    ["admin",                          $locale->text("Administration (Used to access instance administration from user logins)")],
+    ["productivity",                   $locale->text("Productivity")],
+    ["display_admin_link",             $locale->text("Show administration link")],

     );
 
   return @all_rights;
     );
 
   return @all_rights;


@@ -1027,8 +997,6 @@ sub all_rights {
 }
 
 sub read_groups {
 }
 
 sub read_groups {

-  $main::lxdebug->enter_sub();
-

   my $self = shift;
 
   my $form   = $main::form;
   my $self = shift;
 
   my $form   = $main::form;


@@ -1076,14 +1044,10 @@ sub read_groups {
   }
   $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;
 


@@ -1124,13 +1088,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;
 


@@ -1144,13 +1104,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;


@@ -1176,14 +1132,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;


@@ -1210,7 +1162,6 @@ sub _parse_rights_string {
       pop @stack;
 
       if (!@stack) {
       pop @stack;
 
       if (!@stack) {

-        $main::lxdebug->leave_sub(2);

         return 0;
       }
 
         return 0;
       }
 


@@ -1226,14 +1177,10 @@ sub _parse_rights_string {
 
   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;


@@ -1252,17 +1199,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;
   }
 


@@ -1271,20 +1214,18 @@ 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);
 
   $rights = { map { $_ => 0 } all_rights() };
 
   my ($self, $login) = @_;
   my $dbh   = $self->dbconnect;
   my ($query, $sth, $row, $rights);
 
   $rights = { map { $_ => 0 } all_rights() };
 

+  return $rights if !$self->client || !$login;
+

   $query =
     qq|SELECT gr."right", gr.granted
        FROM auth.group_rights gr
   $query =
     qq|SELECT gr."right", gr.granted
        FROM auth.group_rights gr


@@ -1292,17 +1233,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;
 }
 


@@ -1317,7 +1260,7 @@ __END__
 
 SL::Auth - Authentication and session handling
 
 
 SL::Auth - Authentication and session handling
 

-=head1 FUNCTIONS
+=head1 METHODS

 
 =over 4
 
 
 =over 4
 


@@ -1367,7 +1310,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>.


@@ -1381,7 +1324,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>).


@@ -1392,6 +1335,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