X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FAuth.pm;h=a2236a7ce8041c603bd56135c254df008c681881;hb=17384c044b465c262772eb9737ea298069c4d826;hp=365ee2323bf2b55e15ed095e4dc89e8f72398316;hpb=8ed928617d0af21e7afeb9aca0575c5a2e686ed7;p=kivitendo-erp.git diff --git a/SL/Auth.pm b/SL/Auth.pm index 365ee2323..a2236a7ce 100644 --- a/SL/Auth.pm +++ b/SL/Auth.pm @@ -8,10 +8,12 @@ use Time::HiRes qw(gettimeofday); use List::MoreUtils qw(uniq); use YAML; +use SL::Auth::ColumnInformation; use SL::Auth::Constants qw(:all); use SL::Auth::DB; use SL::Auth::LDAP; use SL::Auth::Password; +use SL::Auth::SessionValue; use SL::SessionFile; use SL::User; @@ -21,19 +23,20 @@ use SL::DBUtils; use strict; -sub new { - $main::lxdebug->enter_sub(); - - my $type = shift; - my $self = {}; +use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root'; +use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user'; - bless $self, $type; +use Rose::Object::MakeMethods::Generic ( + scalar => [ qw(client) ], +); - $self->{SESSION} = { }; - $self->_read_auth_config(); +sub new { + my ($type, %params) = @_; + my $self = bless {}, $type; - $main::lxdebug->leave_sub(); + $self->_read_auth_config(%params); + $self->reset; return $self; } @@ -41,36 +44,31 @@ sub new { sub reset { my ($self, %params) = @_; - $self->{SESSION} = { }; - $self->{FULL_RIGHTS} = { }; - $self->{RIGHTS} = { }; - $self->{unique_counter} = 0; + $self->{SESSION} = { }; + $self->{FULL_RIGHTS} = { }; + $self->{RIGHTS} = { }; + $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); - 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 undef unless $dbh; + + $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name)); - return $dbh; + return $self->client; } sub DESTROY { @@ -94,13 +92,21 @@ sub mini_error { } 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); @@ -111,74 +117,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; + } + + $password = SL::Auth::Password->hash(login => 'root', password => $password); + my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->()); - $main::lxdebug->leave_sub(); + my $result = $password eq $admin_password ? OK : ERR_PASSWORD; + $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result); - return OK if $password eq $admin_password; - sleep 5; - return ERR_PASSWORD; + return $result; } sub authenticate { - $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 { @@ -195,13 +216,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}; } @@ -214,60 +232,44 @@ 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}) { $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 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 = @_; @@ -289,18 +291,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"); @@ -312,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); - 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(); @@ -322,28 +319,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 = @_; @@ -380,8 +366,6 @@ sub save_user { } $dbh->commit(); - - $main::lxdebug->leave_sub(); } sub can_change_password { @@ -391,59 +375,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; @@ -452,52 +446,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; } # -------------------------------------- @@ -505,82 +500,141 @@ sub delete_user { my $session_id; sub restore_session { - $main::lxdebug->enter_sub(); - my $self = shift; - my $cgi = $main::cgi; - $cgi ||= CGI->new(''); - - $session_id = $cgi->cookie($self->get_session_cookie_name()); - $session_id =~ s|[^0-9a-f]||g; + $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name()); + $session_id =~ s|[^0-9a-f]||g 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; - $dbh = $self->dbconnect(); + # Don't fail if the auth DB doesn't yet. + if (!( $dbh = $self->dbconnect(1) )) { + return $self->session_restore_result(SESSION_NONE()); + } + + # Don't fail if the "auth" schema doesn't exist yet, e.g. if the + # admin is creating the session tables at the moment. $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|; - $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id); + if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) { + $sth->finish if $sth; + return $self->session_restore_result(SESSION_NONE()); + } - if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) { + $cookie = $sth->fetchrow_hashref; + $sth->finish; + + # 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(); - $main::lxdebug->leave_sub(); - return $cookie ? SESSION_EXPIRED : SESSION_NONE; + return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE()); } - $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|; - $sth = prepare_execute_query($form, $dbh, $query, $session_id); + if ($self->{column_information}->has('auto_restore')) { + $self->_load_with_auto_restore_column($dbh, $session_id); + } else { + $self->_load_without_auto_restore_column($dbh, $session_id); + } - while (my $ref = $sth->fetchrow_hashref()) { - $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value}; - next if defined $form->{$ref->{sess_key}}; + return $self->session_restore_result(SESSION_OK()); +} - my $params = $self->_load_value($ref->{sess_value}); - $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple}; +sub session_restore_result { + my $self = shift; + if (@_) { + $self->{session_restore_result} = $_[0]; } + return $self->{session_restore_result}; +} - $sth->finish(); +sub _load_without_auto_restore_column { + my ($self, $dbh, $session_id) = @_; + + my $query = <leave_sub(); + while (my $ref = $sth->fetchrow_hashref) { + my $value = SL::Auth::SessionValue->new(auth => $self, + key => $ref->{sess_key}, + value => $ref->{sess_value}, + raw => 1); + $self->{SESSION}->{ $ref->{sess_key} } = $value; - return SESSION_OK; + next if defined $::form->{$ref->{sess_key}}; + + my $data = $value->get; + $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data; + } } -sub _load_value { - my ($self, $value) = @_; +sub _load_with_auto_restore_column { + my ($self, $dbh, $session_id) = @_; - return { simple => 1, data => $value } if $value !~ m/^---/; + my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw); - my %params = ( simple => 1 ); - eval { - my $data = YAML::Load($value); + my $query = <{$_} } keys %{ $data }; - $params{simple} = 0; + while (my $ref = $sth->fetchrow_hashref) { + my $value = SL::Auth::SessionValue->new(auth => $self, + key => $ref->{sess_key}, + value => $ref->{sess_value}, + auto_restore => $ref->{auto_restore}, + raw => 1); + $self->{SESSION}->{ $ref->{sess_key} } = $value; - } else { - $params{data} = $data; - } + next if defined $::form->{$ref->{sess_key}}; - 1; - } or $params{data} = $value; + my $data = $value->get; + $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data; + } - return \%params; + $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) { @@ -598,16 +652,23 @@ sub destroy_session { $session_id = undef; $self->{SESSION} = { }; } +} + +sub active_session_ids { + my $self = shift; + my $dbh = $self->dbconnect; - $main::lxdebug->leave_sub(); + my $query = qq|SELECT id FROM auth.session|; + + 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(); @@ -632,20 +693,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; } @@ -654,22 +709,33 @@ 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; - do_query($::form, $dbh, qq|LOCK auth.session_content|); - do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id); + # If this fails then the "auth" schema might not exist yet, e.g. if + # the admin is just trying to create the auth database. + if (!$dbh->do(qq|LOCK auth.session_content|)) { + $dbh->rollback unless $provided_dbh; + 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; - my $query = qq|SELECT id FROM auth.session WHERE id = ?|; + do_query($::form, $dbh, $query, $session_id, @unfetched_keys); - my ($id) = selectrow_query($::form, $dbh, $query, $session_id); + my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id); if ($id) { do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id); @@ -677,24 +743,39 @@ 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->{SESSION} }) { - my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|; - my $sth = prepare_query($::form, $dbh, $query); + 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 ($columns, $placeholders) = ('', ''); + my $auto_restore = $self->{column_information}->has('auto_restore'); - foreach my $key (sort keys %{ $self->{SESSION} }) { - do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key}); + if ($auto_restore) { + $columns .= ', auto_restore'; + $placeholders .= ', ?'; + } + + $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|; + my $sth = prepare_query($::form, $dbh, $query); + + 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); } $sth->finish(); } $dbh->commit() unless $provided_dbh; - $::lxdebug->leave_sub; } sub set_session_value { - $main::lxdebug->enter_sub(); - my $self = shift; my @params = @_; @@ -704,44 +785,34 @@ sub set_session_value { my $key = shift @params; if (ref $key eq 'HASH') { - my $value = { data => $key->{value}, - auto_restore => $key->{auto_restore}, - }; - $self->{SESSION}->{ $key->{key} } = YAML::Dump($value); + $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key}, + value => $key->{value}, + auto_restore => $key->{auto_restore}); } else { my $value = shift @params; - $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value); + $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key, + value => $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 $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {}; - - $main::lxdebug->leave_sub(); + my $self = shift; + my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef; - return $params->{data}; + return $data; } sub create_unique_sesion_value { @@ -753,16 +824,15 @@ sub create_unique_sesion_value { my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-"; $self->{unique_counter} ||= 0; - $self->{unique_counter}++ while exists $self->{SESSION}->{$key . ($self->{unique_counter} + 1)}; - $self->{unique_counter}++; + my $hashed_key; + do { + $self->{unique_counter}++; + $hashed_key = md5_hex($key . $self->{unique_counter}); + } while (exists $self->{SESSION}->{$hashed_key}); - $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef, - data => $value, - }; + $self->set_session_value($hashed_key => $value); - $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value); - - return $key . $self->{unique_counter}; + return $hashed_key; } sub save_form_in_session { @@ -795,58 +865,49 @@ sub restore_form_from_session { return $self; } -sub expire_session_keys { - my ($self) = @_; - - $self->{SESSION} ||= { }; - - my @now = gettimeofday(); - my $now = $now[0] * 1000000 + $now[1]; - - $self->delete_session_value(map { $_->[0] } - grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) } - map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] } - keys %{ $self->{SESSION} }); - - return $self; -} - -sub _has_expiration { - my ($value) = @_; - return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data}; -} - sub set_cookie_environment_variable { my $self = shift; $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}"; } 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) = @_; + $::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}) { - $main::lxdebug->leave_sub(); return $self->{session_tables_present}; } my $dbh = $self->dbconnect(1); if (!$dbh) { - $main::lxdebug->leave_sub(); return 0; } @@ -860,8 +921,6 @@ sub session_tables_present { $self->{session_tables_present} = 2 == $count; - $main::lxdebug->leave_sub(); - return $self->{session_tables_present}; } @@ -886,21 +945,29 @@ sub all_rights_full { ["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")], + ["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")], + ["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")], ["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)")], + ["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")], + ["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")], @@ -913,9 +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")], + ["--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")], - ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")], + ["productivity", $locale->text("Productivity")], + ["display_admin_link", $locale->text("Show administration link")], ); return @all_rights; @@ -926,8 +997,6 @@ sub all_rights { } sub read_groups { - $main::lxdebug->enter_sub(); - my $self = shift; my $form = $main::form; @@ -975,14 +1044,10 @@ sub read_groups { } $sth->finish(); - $main::lxdebug->leave_sub(); - return $groups; } sub save_group { - $main::lxdebug->enter_sub(); - my $self = shift; my $group = shift; @@ -1023,13 +1088,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; @@ -1043,13 +1104,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; @@ -1075,14 +1132,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; @@ -1109,7 +1162,6 @@ sub _parse_rights_string { pop @stack; if (!@stack) { - $main::lxdebug->leave_sub(2); return 0; } @@ -1125,14 +1177,10 @@ sub _parse_rights_string { 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; @@ -1151,17 +1199,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; } @@ -1170,20 +1214,18 @@ 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() }; + return $rights if !$self->client || !$login; + $query = qq|SELECT gr."right", gr.granted FROM auth.group_rights gr @@ -1191,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) - 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; } @@ -1216,11 +1260,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 @@ -1257,24 +1302,15 @@ doesn't exist. Create a unique key in the session and store C<$value> there. -If C<$params{expiration}> is set then it is interpreted as a number of -seconds after which the value is removed from the session. It will -never expire if that parameter is falsish. - Returns the key created in the session. -=item C - -Removes all keys from the session that have an expiration time set and -whose expiration time is in the past. - =item C 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. @@ -1288,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. -=item +=item C Restores the form from the session into C<$params{form}> (default: C<$::form>). @@ -1299,6 +1335,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