X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FAuth.pm;h=116d5de681a640758af862ee443a3e4ee7468e31;hb=826d79929635c726f7459296fafa7e630c00e72d;hp=1577eb862947cc2fe77b3692d8e26e00f40ff0cc;hpb=2974447a09f906718f8f2485d62a32c2cbdb56b5;p=kivitendo-erp.git diff --git a/SL/Auth.pm b/SL/Auth.pm index 1577eb862..116d5de68 100644 --- a/SL/Auth.pm +++ b/SL/Auth.pm @@ -7,6 +7,7 @@ use IO::File; use Time::HiRes qw(gettimeofday); use List::MoreUtils qw(uniq); use YAML; +use Regexp::IPv6 qw($IPv6_re); use SL::Auth::ColumnInformation; use SL::Auth::Constants qw(:all); @@ -19,27 +20,29 @@ use SL::SessionFile; use SL::User; use SL::DBConnect; use SL::DBUpgrade2; -use SL::DBUtils; +use SL::DBUtils qw(do_query do_statement prepare_execute_query prepare_query selectall_array_query selectrow_query); use strict; -sub new { - $main::lxdebug->enter_sub(); +use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root'; +use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user'; - my $type = shift; - my $self = {}; +use Rose::Object::MakeMethods::Generic ( + scalar => [ qw(client) ], +); - bless $self, $type; - $self->_read_auth_config(); - $self->reset; +sub new { + my ($type, %params) = @_; + my $self = bless {}, $type; - $main::lxdebug->leave_sub(); + $self->_read_auth_config(%params); + $self->init; return $self; } -sub reset { +sub init { my ($self, %params) = @_; $self->{SESSION} = { }; @@ -49,30 +52,46 @@ sub reset { $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self); } -sub get_user_dbh { - my ($self, $login, %params) = @_; - my $may_fail = delete $params{may_fail}; - - my %user = $self->read_user($login); - my $dbh = SL::DBConnect->connect( - $user{dbconnect}, - $user{dbuser}, - $user{dbpasswd}, - { - pg_enable_utf8 => $::locale->is_utf8, - AutoCommit => 0 - } - ); +sub reset { + my ($self, %params) = @_; - if (!$may_fail && !$dbh) { - $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr); + $self->{SESSION} = { }; + $self->{FULL_RIGHTS} = { }; + $self->{RIGHTS} = { }; + $self->{unique_counter} = 0; + + if ($self->is_db_connected) { + # reset is called during request shutdown already. In case of a + # completely new auth DB this would fail and generate an error + # message even if the user is currently trying to create said auth + # DB. Therefore only fetch the column information if a connection + # has been established. + $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self); + $self->{column_information}->_fetch; + } else { + delete $self->{column_information}; } - if ($user{dboptions} && $dbh) { - $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions}); - } + $self->{authenticator}->reset; - return $dbh; + $self->client(undef); +} + +sub set_client { + my ($self, $id_or_name) = @_; + + $self->client(undef); + + return undef unless $id_or_name; + + my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name'; + my $dbh = $self->dbconnect; + + return undef unless $dbh; + + $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name)); + + return $self->client; } sub DESTROY { @@ -92,17 +111,25 @@ sub mini_error { } else { print STDERR "Error: @msg\n"; } - ::end_of_request(); + $::dispatcher->end_request; } 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} }; - $self->{DB_config} = $::lx_office_conf{'authentication/database'}; - $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'}; + + # Prevent password leakage to log files when dumping Auth instances. + $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} }; + + if ($params{unit_tests_database}) { + $self->{DB_config} = $::lx_office_conf{'testing/database'}; + $self->{module} = 'DB'; + + } else { + $self->{DB_config} = $::lx_office_conf{'authentication/database'}; + $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'}; + } if ($self->{module} eq 'DB') { $self->{authenticator} = SL::Auth::DB->new($self); @@ -113,74 +140,89 @@ sub _read_auth_config { if (!$self->{authenticator}) { my $locale = Locale->new('en'); - $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".')); + $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".')); } my $cfg = $self->{DB_config}; if (!$cfg) { my $locale = Locale->new('en'); - $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.')); + $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.')); } if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) { my $locale = Locale->new('en'); - $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".')); + $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".')); } $self->{authenticator}->verify_config(); $self->{session_timeout} *= 1; $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout}); +} + +sub has_access_to_client { + my ($self, $login) = @_; + + return 0 if !$self->client || !$self->client->{id}; - $main::lxdebug->leave_sub(); + my $sql = <dbconnect->selectrow_array($sql, undef, $login, $self->client->{id}); + return $has_access; } sub authenticate_root { - $main::lxdebug->enter_sub(); - my ($self, $password) = @_; - $password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password); - my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}); + my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH()); + if (defined $session_root_auth && $session_root_auth == OK) { + return OK; + } + + if (!defined $password) { + return ERR_PASSWORD; + } - $main::lxdebug->leave_sub(); + 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); - return OK if $password eq $admin_password; - sleep 5; - return ERR_PASSWORD; + my $result = $password eq $admin_password ? OK : ERR_PASSWORD; + $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result); + + return $result; } sub authenticate { - $main::lxdebug->enter_sub(); - my ($self, $login, $password) = @_; - $main::lxdebug->leave_sub(); - - my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER; - return OK if $result eq OK; - sleep 5; - return $result; -} + if (!$self->client || !$self->has_access_to_client($login)) { + return ERR_PASSWORD; + } -sub store_credentials_in_session { - my ($self, %params) = @_; + my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH()); + if (defined $session_auth && $session_auth == OK) { + return OK; + } - if (!$self->{authenticator}->requires_cleartext_password) { - $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login}, - password => $params{password}, - look_up_algorithm => 1, - auth => $self); + if (!defined $password) { + return ERR_PASSWORD; } - $self->set_session_value(login => $params{login}, password => $params{password}); + my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER; + $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id}); + return $result; } -sub store_root_credentials_in_session { - my ($self, $rpw) = @_; - - $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw)); +sub punish_wrong_login { + my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty}; + sleep $failed_login_penalty if $failed_login_penalty; } sub get_stored_password { @@ -197,13 +239,10 @@ sub get_stored_password { } sub dbconnect { - $main::lxdebug->enter_sub(2); - my $self = shift; my $may_fail = shift; if ($self->{dbh}) { - $main::lxdebug->leave_sub(2); return $self->{dbh}; } @@ -216,60 +255,50 @@ sub dbconnect { $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}) { + delete $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 { - $main::lxdebug->enter_sub(); - 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 { - $main::lxdebug->enter_sub(); - - my $self = shift; + my ($self, $dbh) = @_; - my $dbh = $self->dbconnect(); + $dbh ||= $self->dbconnect(); my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|; my ($count) = $dbh->selectrow_array($query); - $main::lxdebug->leave_sub(); - return $count > 0; } sub check_database { - $main::lxdebug->enter_sub(); - my $self = shift; my $dbh = $self->dbconnect(1); - $main::lxdebug->leave_sub(); - return $dbh ? 1 : 0; } sub create_database { - $main::lxdebug->enter_sub(); - my $self = shift; my %params = @_; @@ -291,18 +320,13 @@ sub create_database { $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); } - 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"); @@ -314,8 +338,8 @@ sub create_database { $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|; my ($cluster_encoding) = $dbh->selectrow_array($query); - 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(); @@ -324,28 +348,17 @@ sub create_database { } $dbh->disconnect(); - - $main::lxdebug->leave_sub(); } sub create_tables { - $main::lxdebug->enter_sub(); - my $self = shift; my $dbh = $self->dbconnect(); - my $charset = $::lx_office_conf{system}->{dbcharset}; - $charset ||= Common::DEFAULT_CHARSET; - $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 { - $main::lxdebug->enter_sub(); - my $self = shift; my $login = shift; my %params = @_; @@ -382,8 +395,6 @@ sub save_user { } $dbh->commit(); - - $main::lxdebug->leave_sub(); } sub can_change_password { @@ -393,59 +404,69 @@ sub can_change_password { } sub change_password { - $main::lxdebug->enter_sub(); - my ($self, $login, $new_password) = @_; my $result = $self->{authenticator}->change_password($login, $new_password); - $self->store_credentials_in_session(login => $login, - password => $new_password, - look_up_algorithm => 1, - auth => $self); - - $main::lxdebug->leave_sub(); - return $result; } sub read_all_users { - $main::lxdebug->enter_sub(); - my $self = shift; my $dbh = $self->dbconnect(); - my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value - FROM auth.user_config cfg - LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|; + my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action + + FROM auth."user" AS u + + LEFT JOIN auth.user_config AS cfg + ON (cfg.user_id = u.id) + + LEFT JOIN auth.session_content AS sc_login + ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n')) + + LEFT JOIN auth.session AS s + ON (s.id = sc_login.session_id) + |; my $sth = prepare_execute_query($main::form, $dbh, $query); my %users; while (my $ref = $sth->fetchrow_hashref()) { - $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} }; + + $users{$ref->{login}} ||= { + 'login' => $ref->{login}, + 'id' => $ref->{id}, + 'last_action' => $ref->{last_action}, + }; $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id')); } $sth->finish(); - $main::lxdebug->leave_sub(); - return %users; } sub read_user { - $main::lxdebug->enter_sub(); - - my $self = shift; - my $login = shift; + my ($self, %params) = @_; my $dbh = $self->dbconnect(); + + my (@where, @values); + if ($params{login}) { + push @where, 'u.login = ?'; + push @values, $params{login}; + } + if ($params{id}) { + push @where, 'u.id = ?'; + push @values, $params{id}; + } + my $where = join ' AND ', '1 = 1', @where; my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value FROM auth.user_config cfg LEFT JOIN auth."user" u ON (cfg.user_id = u.id) - WHERE (u.login = ?)|; - my $sth = prepare_execute_query($main::form, $dbh, $query, $login); + WHERE $where|; + my $sth = prepare_execute_query($main::form, $dbh, $query, @values); my %user_data; @@ -454,52 +475,53 @@ sub read_user { @user_data{qw(id login)} = @{$ref}{qw(id login)}; } - $sth->finish(); + # 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}; - $main::lxdebug->leave_sub(); + # The 'Win2000.css' stylesheet has been removed. + $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i; + + # Set default language if selected language does not exist (anymore). + $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}"; + + $sth->finish(); 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); - $main::lxdebug->leave_sub(); - return $id; } sub delete_user { - $::lxdebug->enter_sub; - my $self = shift; my $login = shift; - my $u_dbh = $self->get_user_dbh($login, may_fail => 1); my $dbh = $self->dbconnect; + my $id = $self->get_user_id($login); - $dbh->begin_work; - - my $query = qq|SELECT id FROM auth."user" WHERE login = ?|; - - my ($id) = selectrow_query($::form, $dbh, $query, $login); + if (!$id) { + $dbh->rollback; + return; + } - $dbh->rollback and return $::lxdebug->leave_sub if (!$id); + $dbh->begin_work; do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id); do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id); - do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh; + do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id); - $dbh->commit; - $u_dbh->commit if $u_dbh; + # TODO: SL::Auth::delete_user + # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists; - $::lxdebug->leave_sub; + $dbh->commit; } # -------------------------------------- @@ -507,8 +529,6 @@ sub delete_user { my $session_id; sub restore_session { - $main::lxdebug->enter_sub(); - my $self = shift; $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name()); @@ -517,18 +537,16 @@ sub restore_session { $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; - # 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) )) { - $::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 @@ -537,17 +555,25 @@ sub restore_session { 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; - if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) { + # The session ID provided is valid in the following cases: + # 1. session ID exists in the database + # 2. hasn't expired yet + # 3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID + # 4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address + $self->{api_token} = $cookie->{api_token} if $cookie; + my $api_token_cookie = $self->get_api_token_cookie; + my $cookie_is_bad = !$cookie || $cookie->{is_expired}; + $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie; + $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/; + if ($cookie_is_bad) { $self->destroy_session(); - $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')) { @@ -556,9 +582,15 @@ sub restore_session { $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 { @@ -588,52 +620,39 @@ SQL 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 = <fetchrow_hashref) { - my $value = SL::Auth::SessionValue->new(auth => $self, - key => $ref->{sess_key}, - value => $ref->{sess_value}, - auto_restore => $ref->{auto_restore}, - raw => 1); - $self->{SESSION}->{ $ref->{sess_key} } = $value; - - next if defined $::form->{$ref->{sess_key}}; - - my $data = $value->get; - $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data; + if ($ref->{auto_restore} || $auto_restore_keys{$ref->{sess_key}}) { + my $value = SL::Auth::SessionValue->new(auth => $self, + key => $ref->{sess_key}, + value => $ref->{sess_value}, + auto_restore => $ref->{auto_restore}, + raw => 1); + $self->{SESSION}->{ $ref->{sess_key} } = $value; + + next if defined $::form->{$ref->{sess_key}}; + + my $data = $value->get; + $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data; + } else { + my $value = SL::Auth::SessionValue->new(auth => $self, + key => $ref->{sess_key}); + $self->{SESSION}->{ $ref->{sess_key} } = $value; + } } $sth->finish; - - $query = <fetchrow_hashref) { - my $value = SL::Auth::SessionValue->new(auth => $self, - key => $ref->{sess_key}); - $self->{SESSION}->{ $ref->{sess_key} } = $value; - } } sub destroy_session { - $main::lxdebug->enter_sub(); - my $self = shift; if ($session_id) { @@ -651,16 +670,23 @@ sub destroy_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 { - $main::lxdebug->enter_sub(); - my $self = shift; - $main::lxdebug->leave_sub and return if !$self->session_tables_present; + return if !$self->session_tables_present; my $dbh = $self->dbconnect(); @@ -685,20 +711,14 @@ sub expire_sessions { $dbh->commit(); } - - $main::lxdebug->leave_sub(); } 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); - $main::lxdebug->leave_sub(); - return $id; } @@ -707,13 +727,12 @@ sub create_or_refresh_session { } sub save_session { - $::lxdebug->enter_sub; 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; @@ -721,7 +740,6 @@ sub save_session { # the admin is just trying to create the auth database. if (!$dbh->do(qq|LOCK auth.session_content|)) { $dbh->rollback unless $provided_dbh; - $::lxdebug->leave_sub; return; } @@ -743,6 +761,11 @@ sub save_session { do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR}); } + 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) { @@ -768,12 +791,9 @@ sub save_session { } $dbh->commit() unless $provided_dbh; - $::lxdebug->leave_sub; } sub set_session_value { - $main::lxdebug->enter_sub(); - my $self = shift; my @params = @_; @@ -794,32 +814,22 @@ sub set_session_value { } } - $main::lxdebug->leave_sub(); - return $self; } sub delete_session_value { - $main::lxdebug->enter_sub(); - my $self = shift; $self->{SESSION} ||= { }; delete @{ $self->{SESSION} }{ @_ }; - $main::lxdebug->leave_sub(); - 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; - $main::lxdebug->leave_sub(); - return $data; } @@ -879,113 +889,80 @@ sub set_cookie_environment_variable { } 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 session_tables_present { - $main::lxdebug->enter_sub(); +sub get_api_token_cookie { + my ($self) = @_; - my $self = shift; + $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token')); +} + +sub is_api_token_cookie_valid { + my ($self) = @_; + my $provided_api_token = $self->get_api_token_cookie; + return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token); +} + +sub _tables_present { + my ($self, @tables) = @_; + my $cache_key = join '_', @tables; # Only re-check for the presence of auth tables if either the check # hasn't been done before of if they weren't present. - 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 { - my $locale = $main::locale; - - my @all_rights = ( - ["--crm", $locale->text("CRM optional software")], - ["crm_search", $locale->text("CRM search")], - ["crm_new", $locale->text("CRM create customers, vendors and contacts")], - ["crm_service", $locale->text("CRM services")], - ["crm_admin", $locale->text("CRM admin")], - ["crm_adminuser", $locale->text("CRM user")], - ["crm_adminstatus", $locale->text("CRM status")], - ["crm_email", $locale->text("CRM send email")], - ["crm_termin", $locale->text("CRM termin")], - ["crm_opportunity", $locale->text("CRM opportunity")], - ["crm_knowhow", $locale->text("CRM know how")], - ["crm_follow", $locale->text("CRM follow up")], - ["crm_notices", $locale->text("CRM notices")], - ["crm_other", $locale->text("CRM other")], - ["--master_data", $locale->text("Master Data")], - ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")], - ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")], - ["project_edit", $locale->text("Create and edit projects")], - ["--ar", $locale->text("AR")], - ["sales_quotation_edit", $locale->text("Create and edit sales quotations")], - ["sales_order_edit", $locale->text("Create and edit sales orders")], - ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")], - ["invoice_edit", $locale->text("Create and edit invoices and credit notes")], - ["dunning_edit", $locale->text("Create and edit dunnings")], - ["sales_all_edit", $locale->text("View/edit all employees sales documents")], - ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")], - ["--ap", $locale->text("AP")], - ["request_quotation_edit", $locale->text("Create and edit RFQs")], - ["purchase_order_edit", $locale->text("Create and edit purchase orders")], - ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")], - ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")], - ["--warehouse_management", $locale->text("Warehouse management")], - ["warehouse_contents", $locale->text("View warehouse content")], - ["warehouse_management", $locale->text("Warehouse management")], - ["--general_ledger_cash", $locale->text("General ledger and cash")], - ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")], - ["datev_export", $locale->text("DATEV Export")], - ["cash", $locale->text("Receipt, payment, reconciliation")], - ["--reports", $locale->text('Reports')], - ["report", $locale->text('All reports')], - ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')], - ["--batch_printing", $locale->text("Batch Printing")], - ["batch_printing", $locale->text("Batch Printing")], - ["--others", $locale->text("Others")], - ["email_bcc", $locale->text("May set the BCC field when sending emails")], - ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")], - ); - - return @all_rights; + my ($self) = @_; + + @{ $self->{master_rights} ||= do { + $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position"); + } + } } sub all_rights { - return grep !/^--/, map { $_->[0] } all_rights_full(); + return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full; } sub read_groups { - $main::lxdebug->enter_sub(); - my $self = shift; my $form = $main::form; @@ -1029,18 +1006,14 @@ sub read_groups { $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(); - $main::lxdebug->leave_sub(); - return $groups; } sub save_group { - $main::lxdebug->enter_sub(); - my $self = shift; my $group = shift; @@ -1081,13 +1054,9 @@ sub save_group { $sth->finish(); $dbh->commit(); - - $main::lxdebug->leave_sub(); } sub delete_group { - $main::lxdebug->enter_sub(); - my $self = shift; my $id = shift; @@ -1101,13 +1070,9 @@ sub delete_group { do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id); $dbh->commit(); - - $main::lxdebug->leave_sub(); } sub evaluate_rights_ary { - $main::lxdebug->enter_sub(2); - my $ary = shift; my $value = 0; @@ -1133,14 +1098,10 @@ sub evaluate_rights_ary { } } - $main::lxdebug->leave_sub(2); - return $value; } sub _parse_rights_string { - $main::lxdebug->enter_sub(2); - my $self = shift; my $login = shift; @@ -1167,7 +1128,6 @@ sub _parse_rights_string { pop @stack; if (!@stack) { - $main::lxdebug->leave_sub(2); return 0; } @@ -1177,20 +1137,16 @@ sub _parse_rights_string { 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]); - $main::lxdebug->leave_sub(2); - return $result; } sub check_right { - $main::lxdebug->enter_sub(2); - my $self = shift; my $login = shift; my $right = shift; @@ -1209,17 +1165,13 @@ sub check_right { my $granted = $self->{FULL_RIGHTS}->{$login}->{$right}; $granted = $default if (!defined $granted); - $main::lxdebug->leave_sub(2); - return $granted; } sub assert { - $::lxdebug->enter_sub(2); my ($self, $right, $dont_abort) = @_; if ($self->check_right($::myconfig{login}, $right)) { - $::lxdebug->leave_sub(2); return 1; } @@ -1228,19 +1180,17 @@ sub assert { $::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 { - $::lxdebug->enter_sub; - 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 @@ -1249,17 +1199,19 @@ sub load_rights_for_user { (SELECT ug.group_id FROM auth.user_group ug LEFT JOIN auth."user" u ON (ug.user_id = u.id) - 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(); - $::lxdebug->leave_sub; - return $rights; } @@ -1274,11 +1226,12 @@ __END__ SL::Auth - Authentication and session handling -=head1 FUNCTIONS +=head1 METHODS =over 4 =item C + =item C Store all values of C<@values> or C<%values> in the session. Each @@ -1323,7 +1276,7 @@ Stores the session values in the database. This is the only function that actually stores stuff in the database. Neither the various setters nor the deleter access the database. -=item +=item C Stores the content of C<$params{form}> (default: C<$::form>) in the session using L. @@ -1337,7 +1290,7 @@ can be given as an array ref in C<$params{skip_keys}>. Returns the unique key under which the form is stored. -=item +=item C Restores the form from the session into C<$params{form}> (default: C<$::form>). @@ -1348,6 +1301,14 @@ is on by default. Returns C<$self>. +=item C + +C 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