5 use Digest::MD5 qw(md5_hex);
7 use Time::HiRes qw(gettimeofday);
8 use List::MoreUtils qw(uniq);
10 use Regexp::IPv6 qw($IPv6_re);
12 use SL::Auth::ColumnInformation;
13 use SL::Auth::Constants qw(:all);
16 use SL::Auth::Password;
17 use SL::Auth::SessionValue;
23 use SL::DBUtils qw(do_query do_statement prepare_execute_query prepare_query selectall_array_query selectrow_query selectall_ids);
27 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
28 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
30 use Rose::Object::MakeMethods::Generic (
31 scalar => [ qw(client) ],
36 my ($type, %params) = @_;
37 my $self = bless {}, $type;
39 $self->_read_auth_config(%params);
46 my ($self, %params) = @_;
48 $self->{SESSION} = { };
49 $self->{FULL_RIGHTS} = { };
50 $self->{RIGHTS} = { };
51 $self->{unique_counter} = 0;
52 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
56 my ($self, %params) = @_;
58 $self->{SESSION} = { };
59 $self->{FULL_RIGHTS} = { };
60 $self->{RIGHTS} = { };
61 $self->{unique_counter} = 0;
63 if ($self->is_db_connected) {
64 # reset is called during request shutdown already. In case of a
65 # completely new auth DB this would fail and generate an error
66 # message even if the user is currently trying to create said auth
67 # DB. Therefore only fetch the column information if a connection
68 # has been established.
69 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
70 $self->{column_information}->_fetch;
72 delete $self->{column_information};
75 $self->{authenticator}->reset;
81 my ($self, $id_or_name) = @_;
85 return undef unless $id_or_name;
87 my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
88 my $dbh = $self->dbconnect;
90 return undef unless $dbh;
92 $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
97 sub get_default_client_id {
100 my $dbh = $self->dbconnect;
104 my $row = $dbh->selectrow_hashref(qq|SELECT id FROM auth.clients WHERE is_default = TRUE LIMIT 1|);
106 return $row->{id} if $row;
112 $self->{dbh}->disconnect() if ($self->{dbh});
115 # form isn't loaded yet, so auth needs it's own error.
117 $::lxdebug->show_backtrace();
119 my ($self, @msg) = @_;
120 if ($ENV{HTTP_USER_AGENT}) {
121 print Form->create_http_response(content_type => 'text/html');
122 print "<pre>", join ('<br>', @msg), "</pre>";
124 print STDERR "Error: @msg\n";
126 $::dispatcher->end_request;
129 sub _read_auth_config {
130 my ($self, %params) = @_;
132 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
134 # Prevent password leakage to log files when dumping Auth instances.
135 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
137 if ($params{unit_tests_database}) {
138 $self->{DB_config} = $::lx_office_conf{'testing/database'};
139 $self->{module} = 'DB';
142 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
143 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
146 if ($self->{module} eq 'DB') {
147 $self->{authenticator} = SL::Auth::DB->new($self);
149 } elsif ($self->{module} eq 'LDAP') {
150 $self->{authenticator} = SL::Auth::LDAP->new($self);
153 if (!$self->{authenticator}) {
154 my $locale = Locale->new('en');
155 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
158 my $cfg = $self->{DB_config};
161 my $locale = Locale->new('en');
162 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
165 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
166 my $locale = Locale->new('en');
167 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
170 $self->{authenticator}->verify_config();
172 $self->{session_timeout} *= 1;
173 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
176 sub has_access_to_client {
177 my ($self, $login) = @_;
179 return 0 if !$self->client || !$self->client->{id};
183 FROM auth.clients_users cu
184 LEFT JOIN auth."user" u ON (cu.user_id = u.id)
186 AND (cu.client_id = ?)
189 my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
193 sub authenticate_root {
194 my ($self, $password) = @_;
196 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
197 if (defined $session_root_auth && $session_root_auth == OK) {
201 if (!defined $password) {
205 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
206 $password = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
208 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
209 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
215 my ($self, $login, $password) = @_;
217 if (!$self->client || !$self->has_access_to_client($login)) {
221 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
222 if (defined $session_auth && $session_auth == OK) {
226 if (!defined $password) {
230 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
231 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
235 sub punish_wrong_login {
236 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
237 sleep $failed_login_penalty if $failed_login_penalty;
240 sub get_stored_password {
241 my ($self, $login) = @_;
243 my $dbh = $self->dbconnect;
245 return undef unless $dbh;
247 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
248 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
250 return $stored_password;
255 my $may_fail = shift;
261 my $cfg = $self->{DB_config};
262 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
265 $dsn .= ';port=' . $cfg->{port};
268 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
270 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
272 if (!$may_fail && !$self->{dbh}) {
274 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
284 $self->{dbh}->disconnect();
289 sub is_db_connected {
291 return !!$self->{dbh};
295 my ($self, $dbh) = @_;
297 $dbh ||= $self->dbconnect();
298 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
300 my ($count) = $dbh->selectrow_array($query);
308 my $dbh = $self->dbconnect(1);
313 sub create_database {
317 my $cfg = $self->{DB_config};
319 if (!$params{superuser}) {
320 $params{superuser} = $cfg->{user};
321 $params{superuser_password} = $cfg->{password};
324 $params{template} ||= 'template0';
325 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
327 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
330 $dsn .= ';port=' . $cfg->{port};
333 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
335 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
338 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
341 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
343 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
348 my $error = $dbh->errstr();
350 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
351 my ($cluster_encoding) = $dbh->selectrow_array($query);
353 if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
354 $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
359 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
367 my $dbh = $self->dbconnect();
370 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
378 my $form = $main::form;
380 my $dbh = $self->dbconnect();
382 my ($sth, $query, $user_id);
386 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
387 ($user_id) = selectrow_query($form, $dbh, $query, $login);
390 $query = qq|SELECT nextval('auth.user_id_seq')|;
391 ($user_id) = selectrow_query($form, $dbh, $query);
393 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
394 do_query($form, $dbh, $query, $user_id, $login);
397 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
398 do_query($form, $dbh, $query, $user_id);
400 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
401 $sth = prepare_query($form, $dbh, $query);
403 while (my ($cfg_key, $cfg_value) = each %params) {
404 next if ($cfg_key eq 'password');
406 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
412 sub can_change_password {
415 return $self->{authenticator}->can_change_password();
418 sub change_password {
419 my ($self, $login, $new_password) = @_;
421 my $result = $self->{authenticator}->change_password($login, $new_password);
429 my $dbh = $self->dbconnect();
430 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
432 FROM auth."user" AS u
434 LEFT JOIN auth.user_config AS cfg
435 ON (cfg.user_id = u.id)
437 LEFT JOIN auth.session_content AS sc_login
438 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
440 LEFT JOIN auth.session AS s
441 ON (s.id = sc_login.session_id)
443 my $sth = prepare_execute_query($main::form, $dbh, $query);
447 while (my $ref = $sth->fetchrow_hashref()) {
449 $users{$ref->{login}} ||= {
450 'login' => $ref->{login},
452 'last_action' => $ref->{last_action},
454 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
463 my ($self, %params) = @_;
465 my $dbh = $self->dbconnect();
467 my (@where, @values);
468 if ($params{login}) {
469 push @where, 'u.login = ?';
470 push @values, $params{login};
473 push @where, 'u.id = ?';
474 push @values, $params{id};
476 my $where = join ' AND ', '1 = 1', @where;
477 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
478 FROM auth.user_config cfg
479 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
481 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
485 while (my $ref = $sth->fetchrow_hashref()) {
486 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
487 @user_data{qw(id login)} = @{$ref}{qw(id login)};
490 # The XUL/XML & 'CSS new' backed menus have been removed.
491 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
492 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
494 # The 'Win2000.css' stylesheet has been removed.
495 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
497 # Set default language if selected language does not exist (anymore).
498 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
509 my $dbh = $self->dbconnect();
510 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
519 my $dbh = $self->dbconnect;
520 my $id = $self->get_user_id($login);
529 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
530 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
531 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
533 # TODO: SL::Auth::delete_user
534 # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
539 # --------------------------------------
543 sub restore_session {
546 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
547 $session_id =~ s|[^0-9a-f]||g if $session_id;
549 $self->{SESSION} = { };
552 return $self->session_restore_result(SESSION_NONE());
555 my ($dbh, $query, $sth, $cookie, $ref, $form);
559 # Don't fail if the auth DB doesn't exist yet.
560 if (!( $dbh = $self->dbconnect(1) )) {
561 return $self->session_restore_result(SESSION_NONE());
564 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
565 # admin is creating the session tables at the moment.
566 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
568 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
569 $sth->finish if $sth;
570 return $self->session_restore_result(SESSION_NONE());
573 $cookie = $sth->fetchrow_hashref;
576 # The session ID provided is valid in the following cases:
577 # 1. session ID exists in the database
578 # 2. hasn't expired yet
579 # 3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
580 $self->{api_token} = $cookie->{api_token} if $cookie;
581 my $api_token_cookie = $self->get_api_token_cookie;
582 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
583 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
584 if ($cookie_is_bad) {
585 $self->destroy_session();
586 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
589 if ($self->{column_information}->has('auto_restore')) {
590 $self->_load_with_auto_restore_column($dbh, $session_id);
592 $self->_load_without_auto_restore_column($dbh, $session_id);
595 return $self->session_restore_result(SESSION_OK());
598 sub session_restore_result {
601 $self->{session_restore_result} = $_[0];
603 return $self->{session_restore_result};
606 sub _load_without_auto_restore_column {
607 my ($self, $dbh, $session_id) = @_;
610 SELECT sess_key, sess_value
611 FROM auth.session_content
612 WHERE (session_id = ?)
614 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
616 while (my $ref = $sth->fetchrow_hashref) {
617 my $value = SL::Auth::SessionValue->new(auth => $self,
618 key => $ref->{sess_key},
619 value => $ref->{sess_value},
621 $self->{SESSION}->{ $ref->{sess_key} } = $value;
623 next if defined $::form->{$ref->{sess_key}};
625 my $data = $value->get;
626 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
630 sub _load_with_auto_restore_column {
631 my ($self, $dbh, $session_id) = @_;
633 my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
636 SELECT sess_key, sess_value, auto_restore
637 FROM auth.session_content
638 WHERE (session_id = ?) AND (auto_restore OR sess_key IN (@{[ join ',', ("?") x keys %auto_restore_keys ]}))
640 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id, keys %auto_restore_keys);
643 while (my $ref = $sth->fetchrow_hashref) {
644 $need_delete = 1 if $ref->{auto_restore};
645 my $value = SL::Auth::SessionValue->new(auth => $self,
646 key => $ref->{sess_key},
647 value => $ref->{sess_value},
648 auto_restore => $ref->{auto_restore},
650 $self->{SESSION}->{ $ref->{sess_key} } = $value;
652 next if defined $::form->{$ref->{sess_key}};
654 my $data = $value->get;
655 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
661 do_query($::form, $dbh, 'DELETE FROM auth.session_content WHERE auto_restore AND session_id = ?', $session_id);
665 sub destroy_session {
669 my $dbh = $self->dbconnect();
673 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
674 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
678 SL::SessionFile->destroy_session($session_id);
681 $self->{SESSION} = { };
685 sub active_session_ids {
687 my $dbh = $self->dbconnect;
689 my $query = qq|SELECT id FROM auth.session|;
691 my @ids = selectall_array_query($::form, $dbh, $query);
696 sub expire_sessions {
699 return if !$self->session_tables_present;
701 my $dbh = $self->dbconnect();
703 my $query = qq|SELECT id
705 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
707 my @ids = selectall_array_query($::form, $dbh, $query);
712 SL::SessionFile->destroy_session($_) for @ids;
714 $query = qq|DELETE FROM auth.session_content
715 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
716 do_query($main::form, $dbh, $query, @ids);
718 $query = qq|DELETE FROM auth.session
719 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
720 do_query($main::form, $dbh, $query, @ids);
726 sub _create_session_id {
728 map { push @data, int(rand() * 255); } (1..32);
730 my $id = md5_hex(pack 'C*', @data);
735 sub create_or_refresh_session {
736 $session_id ||= shift->_create_session_id;
741 my $provided_dbh = shift;
743 my $dbh = $provided_dbh || $self->dbconnect(1);
745 return unless $dbh && $session_id;
747 $dbh->begin_work unless $provided_dbh;
749 # If this fails then the "auth" schema might not exist yet, e.g. if
750 # the admin is just trying to create the auth database.
751 if (!$dbh->do(qq|LOCK auth.session_content|)) {
752 $dbh->rollback unless $provided_dbh;
756 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
759 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
761 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
764 if ($self->{column_information}->has('api_token', 'session')) {
765 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
766 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
769 my @values_to_save = grep { $_->{modified} }
770 values %{ $self->{SESSION} };
771 if (@values_to_save) {
772 my %known_keys = map { $_ => 1 }
773 selectall_ids($::form, $dbh, qq|SELECT sess_key FROM auth.session_content WHERE session_id = ?|, 'sess_key', $session_id);
774 my $auto_restore = $self->{column_information}->has('auto_restore');
776 my $insert_query = $auto_restore
777 ? "INSERT INTO auth.session_content (session_id, sess_key, sess_value, auto_restore) VALUES (?, ?, ?, ?)"
778 : "INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)";
779 my $insert_sth = prepare_query($::form, $dbh, $insert_query);
781 my $update_query = $auto_restore
782 ? "UPDATE auth.session_content SET sess_value = ?, auto_restore = ? WHERE session_id = ? AND sess_key = ?"
783 : "UPDATE auth.session_content SET sess_value = ? WHERE session_id = ? AND sess_key = ?";
784 my $update_sth = prepare_query($::form, $dbh, $update_query);
786 foreach my $value (@values_to_save) {
787 my @values = ($value->{key}, $value->get_dumped);
788 push @values, $value->{auto_restore} if $auto_restore;
790 if ($known_keys{$value->{key}}) {
791 do_statement($::form, $update_sth, $update_query,
792 $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore, $session_id, $value->{key}
795 do_statement($::form, $insert_sth, $insert_query,
796 $session_id, $value->{key}, $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore
805 $dbh->commit() unless $provided_dbh;
808 sub set_session_value {
812 $self->{SESSION} ||= { };
815 my $key = shift @params;
817 if (ref $key eq 'HASH') {
818 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
819 value => $key->{value},
821 auto_restore => $key->{auto_restore});
824 my $value = shift @params;
825 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
834 sub delete_session_value {
837 $self->{SESSION} ||= { };
838 delete @{ $self->{SESSION} }{ @_ };
843 sub get_session_value {
844 my ($self, $key) = @_;
846 return if !$self->{SESSION};
848 ($self->{SESSION}{$key} //= SL::Auth::SessionValue->new(auth => $self, key => $key))->get
851 sub create_unique_sesion_value {
852 my ($self, $value, %params) = @_;
854 $self->{SESSION} ||= { };
856 my @now = gettimeofday();
857 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
858 $self->{unique_counter} ||= 0;
862 $self->{unique_counter}++;
863 $hashed_key = md5_hex($key . $self->{unique_counter});
864 } while (exists $self->{SESSION}->{$hashed_key});
866 $self->set_session_value($hashed_key => $value);
871 sub save_form_in_session {
872 my ($self, %params) = @_;
874 my $form = delete($params{form}) || $::form;
875 my $non_scalars = delete $params{non_scalars};
878 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
880 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
881 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
884 return $self->create_unique_sesion_value($data, %params);
887 sub restore_form_from_session {
888 my ($self, $key, %params) = @_;
890 my $data = $self->get_session_value($key);
891 return $self unless $data;
893 my $form = delete($params{form}) || $::form;
894 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
896 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
901 sub set_cookie_environment_variable {
903 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
906 sub get_session_cookie_name {
907 my ($self, %params) = @_;
909 $params{type} ||= 'id';
910 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
911 $name .= '_api_token' if $params{type} eq 'api_token';
920 sub get_api_token_cookie {
923 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
926 sub is_api_token_cookie_valid {
928 my $provided_api_token = $self->get_api_token_cookie;
929 return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
932 sub _tables_present {
933 my ($self, @tables) = @_;
934 my $cache_key = join '_', @tables;
936 # Only re-check for the presence of auth tables if either the check
937 # hasn't been done before of if they weren't present.
938 return $self->{"$cache_key\_tables_present"} ||= do {
939 my $dbh = $self->dbconnect(1);
948 WHERE (schemaname = 'auth')
949 AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))|;
951 my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
953 scalar @tables == $count;
957 sub session_tables_present {
958 $_[0]->_tables_present('session', 'session_content');
961 sub master_rights_present {
962 $_[0]->_tables_present('master_rights');
965 # --------------------------------------
967 sub all_rights_full {
970 @{ $self->{master_rights} ||= do {
971 $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position");
977 return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
983 my $form = $main::form;
985 my $dbh = $self->dbconnect();
987 my $query = 'SELECT * FROM auth."group"';
988 my $sth = prepare_execute_query($form, $dbh, $query);
992 while ($row = $sth->fetchrow_hashref()) {
993 $groups->{$row->{id}} = $row;
997 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
998 $sth = prepare_query($form, $dbh, $query);
1000 foreach $group (values %{$groups}) {
1003 do_statement($form, $sth, $query, $group->{id});
1005 while ($row = $sth->fetchrow_hashref()) {
1006 push @members, $row->{user_id};
1008 $group->{members} = [ uniq @members ];
1012 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1013 $sth = prepare_query($form, $dbh, $query);
1015 foreach $group (values %{$groups}) {
1016 $group->{rights} = {};
1018 do_statement($form, $sth, $query, $group->{id});
1020 while ($row = $sth->fetchrow_hashref()) {
1021 $group->{rights}->{$row->{right}} |= $row->{granted};
1024 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
1035 my $form = $main::form;
1036 my $dbh = $self->dbconnect();
1040 my ($query, $sth, $row, $rights);
1042 if (!$group->{id}) {
1043 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1045 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1046 do_query($form, $dbh, $query, $group->{id});
1049 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1051 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1053 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1054 $sth = prepare_query($form, $dbh, $query);
1056 foreach my $user_id (uniq @{ $group->{members} }) {
1057 do_statement($form, $sth, $query, $user_id, $group->{id});
1061 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1063 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1064 $sth = prepare_query($form, $dbh, $query);
1066 foreach my $right (keys %{ $group->{rights} }) {
1067 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1078 my $form = $main::form;
1080 my $dbh = $self->dbconnect();
1083 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1084 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1085 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1090 sub evaluate_rights_ary {
1097 foreach my $el (@{$ary}) {
1098 if (ref $el eq "ARRAY") {
1099 my $val = evaluate_rights_ary($el);
1100 $val = !$val if $negate;
1102 if ($action eq '|') {
1108 } elsif (($el eq '&') || ($el eq '|')) {
1111 } elsif ($el eq '!') {
1114 } elsif ($action eq '|') {
1116 $val = !$val if $negate;
1122 $val = !$val if $negate;
1132 sub _parse_rights_string {
1141 push @stack, $cur_ary;
1143 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1145 substr($access, 0, length $1) = "";
1147 next if ($token =~ /\s/);
1149 if ($token eq "(") {
1150 my $new_cur_ary = [];
1151 push @stack, $new_cur_ary;
1152 push @{$cur_ary}, $new_cur_ary;
1153 $cur_ary = $new_cur_ary;
1155 } elsif ($token eq ")") {
1162 $cur_ary = $stack[-1];
1164 } elsif (($token eq "|") || ($token eq "&")) {
1165 push @{$cur_ary}, $token;
1168 push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
1172 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1181 my $default = shift;
1183 $self->{FULL_RIGHTS} ||= { };
1184 $self->{FULL_RIGHTS}->{$login} ||= { };
1186 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1187 $self->{RIGHTS} ||= { };
1188 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1190 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1193 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1194 $granted = $default if (!defined $granted);
1200 my ($self, $right, $dont_abort) = @_;
1202 if ($self->check_right($::myconfig{login}, $right)) {
1207 delete $::form->{title};
1208 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1214 sub load_rights_for_user {
1215 my ($self, $login) = @_;
1216 my $dbh = $self->dbconnect;
1217 my ($query, $sth, $row, $rights);
1219 $rights = { map { $_ => 0 } $self->all_rights };
1221 return $rights if !$self->client || !$login;
1224 qq|SELECT gr."right", gr.granted
1225 FROM auth.group_rights gr
1228 FROM auth.user_group ug
1229 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1233 FROM auth.clients_groups cg
1234 WHERE cg.client_id = ?)|;
1236 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1238 while ($row = $sth->fetchrow_hashref()) {
1239 $rights->{$row->{right}} |= $row->{granted};
1255 SL::Auth - Authentication and session handling
1261 =item C<set_session_value @values>
1263 =item C<set_session_value %values>
1265 Store all values of C<@values> or C<%values> in the session. Each
1266 member of C<@values> is tested if it is a hash reference. If it is
1267 then it must contain the keys C<key> and C<value> and can optionally
1268 contain the key C<auto_restore>. In this case C<value> is associated
1269 with C<key> and restored to C<$::form> upon the next request
1270 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1273 If the current member of C<@values> is not a hash reference then it
1274 will be used as the C<key> and the next entry of C<@values> is used as
1275 the C<value> to store. In this case setting C<auto_restore> is not
1278 Therefore the following two invocations are identical:
1280 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1281 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1283 All of these values are copied back into C<$::form> for the next
1284 request automatically if they're scalar values or if they have
1285 C<auto_restore> set to trueish.
1287 The values can be any Perl structure. They are stored as YAML dumps.
1289 =item C<get_session_value $key>
1291 Retrieve a value from the session. Returns C<undef> if the value
1294 =item C<create_unique_sesion_value $value, %params>
1296 Create a unique key in the session and store C<$value>
1299 Returns the key created in the session.
1301 =item C<save_session>
1303 Stores the session values in the database. This is the only function
1304 that actually stores stuff in the database. Neither the various
1305 setters nor the deleter access the database.
1307 =item C<save_form_in_session %params>
1309 Stores the content of C<$params{form}> (default: C<$::form>) in the
1310 session using L</create_unique_sesion_value>.
1312 If C<$params{non_scalars}> is trueish then non-scalar values will be
1313 stored as well. Default is to only store scalar values.
1315 The following keys will never be saved: C<login>, C<password>,
1316 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1317 can be given as an array ref in C<$params{skip_keys}>.
1319 Returns the unique key under which the form is stored.
1321 =item C<restore_form_from_session $key, %params>
1323 Restores the form from the session into C<$params{form}> (default:
1326 If C<$params{clobber}> is falsish then existing values with the same
1327 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1334 C<reset> deletes every state information from previous requests, but does not
1335 close the database connection.
1337 Creating a new database handle on each request can take up to 30% of the
1338 pre-request startup time, so we want to avoid that for fast ajax calls.
1340 =item C<assert, $right, $dont_abort>
1342 Checks if current user has the C<$right>. If C<$dont_abort> is falsish
1343 the request dies with a access denied error, otherwise returns true or false.
1353 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>