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);
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 # 4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address
581 $self->{api_token} = $cookie->{api_token} if $cookie;
582 my $api_token_cookie = $self->get_api_token_cookie;
583 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
584 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
585 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/;
586 if ($cookie_is_bad) {
587 $self->destroy_session();
588 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
591 if ($self->{column_information}->has('auto_restore')) {
592 $self->_load_with_auto_restore_column($dbh, $session_id);
594 $self->_load_without_auto_restore_column($dbh, $session_id);
597 return $self->session_restore_result(SESSION_OK());
600 sub session_restore_result {
603 $self->{session_restore_result} = $_[0];
605 return $self->{session_restore_result};
608 sub _load_without_auto_restore_column {
609 my ($self, $dbh, $session_id) = @_;
612 SELECT sess_key, sess_value
613 FROM auth.session_content
614 WHERE (session_id = ?)
616 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
618 while (my $ref = $sth->fetchrow_hashref) {
619 my $value = SL::Auth::SessionValue->new(auth => $self,
620 key => $ref->{sess_key},
621 value => $ref->{sess_value},
623 $self->{SESSION}->{ $ref->{sess_key} } = $value;
625 next if defined $::form->{$ref->{sess_key}};
627 my $data = $value->get;
628 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
632 sub _load_with_auto_restore_column {
633 my ($self, $dbh, $session_id) = @_;
635 my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
638 SELECT sess_key, sess_value, auto_restore
639 FROM auth.session_content
640 WHERE (session_id = ?)
642 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
644 while (my $ref = $sth->fetchrow_hashref) {
645 if ($ref->{auto_restore} || $auto_restore_keys{$ref->{sess_key}}) {
646 my $value = SL::Auth::SessionValue->new(auth => $self,
647 key => $ref->{sess_key},
648 value => $ref->{sess_value},
649 auto_restore => $ref->{auto_restore},
651 $self->{SESSION}->{ $ref->{sess_key} } = $value;
653 next if defined $::form->{$ref->{sess_key}};
655 my $data = $value->get;
656 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
658 my $value = SL::Auth::SessionValue->new(auth => $self,
659 key => $ref->{sess_key});
660 $self->{SESSION}->{ $ref->{sess_key} } = $value;
667 sub destroy_session {
671 my $dbh = $self->dbconnect();
675 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
676 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
680 SL::SessionFile->destroy_session($session_id);
683 $self->{SESSION} = { };
687 sub active_session_ids {
689 my $dbh = $self->dbconnect;
691 my $query = qq|SELECT id FROM auth.session|;
693 my @ids = selectall_array_query($::form, $dbh, $query);
698 sub expire_sessions {
701 return if !$self->session_tables_present;
703 my $dbh = $self->dbconnect();
705 my $query = qq|SELECT id
707 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
709 my @ids = selectall_array_query($::form, $dbh, $query);
714 SL::SessionFile->destroy_session($_) for @ids;
716 $query = qq|DELETE FROM auth.session_content
717 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
718 do_query($main::form, $dbh, $query, @ids);
720 $query = qq|DELETE FROM auth.session
721 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
722 do_query($main::form, $dbh, $query, @ids);
728 sub _create_session_id {
730 map { push @data, int(rand() * 255); } (1..32);
732 my $id = md5_hex(pack 'C*', @data);
737 sub create_or_refresh_session {
738 $session_id ||= shift->_create_session_id;
743 my $provided_dbh = shift;
745 my $dbh = $provided_dbh || $self->dbconnect(1);
747 return unless $dbh && $session_id;
749 $dbh->begin_work unless $provided_dbh;
751 # If this fails then the "auth" schema might not exist yet, e.g. if
752 # the admin is just trying to create the auth database.
753 if (!$dbh->do(qq|LOCK auth.session_content|)) {
754 $dbh->rollback unless $provided_dbh;
758 my @unfetched_keys = map { $_->{key} }
759 grep { ! $_->{fetched} }
760 values %{ $self->{SESSION} };
761 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
762 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
763 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
764 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
766 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
768 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
771 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
773 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
776 if ($self->{column_information}->has('api_token', 'session')) {
777 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
778 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
781 my @values_to_save = grep { $_->{fetched} }
782 values %{ $self->{SESSION} };
783 if (@values_to_save) {
784 my ($columns, $placeholders) = ('', '');
785 my $auto_restore = $self->{column_information}->has('auto_restore');
788 $columns .= ', auto_restore';
789 $placeholders .= ', ?';
792 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
793 my $sth = prepare_query($::form, $dbh, $query);
795 foreach my $value (@values_to_save) {
796 my @values = ($value->{key}, $value->get_dumped);
797 push @values, $value->{auto_restore} if $auto_restore;
799 do_statement($::form, $sth, $query, $session_id, @values);
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},
820 auto_restore => $key->{auto_restore});
823 my $value = shift @params;
824 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
832 sub delete_session_value {
835 $self->{SESSION} ||= { };
836 delete @{ $self->{SESSION} }{ @_ };
841 sub get_session_value {
843 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
848 sub create_unique_sesion_value {
849 my ($self, $value, %params) = @_;
851 $self->{SESSION} ||= { };
853 my @now = gettimeofday();
854 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
855 $self->{unique_counter} ||= 0;
859 $self->{unique_counter}++;
860 $hashed_key = md5_hex($key . $self->{unique_counter});
861 } while (exists $self->{SESSION}->{$hashed_key});
863 $self->set_session_value($hashed_key => $value);
868 sub save_form_in_session {
869 my ($self, %params) = @_;
871 my $form = delete($params{form}) || $::form;
872 my $non_scalars = delete $params{non_scalars};
875 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
877 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
878 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
881 return $self->create_unique_sesion_value($data, %params);
884 sub restore_form_from_session {
885 my ($self, $key, %params) = @_;
887 my $data = $self->get_session_value($key);
888 return $self unless $data;
890 my $form = delete($params{form}) || $::form;
891 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
893 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
898 sub set_cookie_environment_variable {
900 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
903 sub get_session_cookie_name {
904 my ($self, %params) = @_;
906 $params{type} ||= 'id';
907 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
908 $name .= '_api_token' if $params{type} eq 'api_token';
917 sub get_api_token_cookie {
920 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
923 sub is_api_token_cookie_valid {
925 my $provided_api_token = $self->get_api_token_cookie;
926 return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
929 sub _tables_present {
930 my ($self, @tables) = @_;
931 my $cache_key = join '_', @tables;
933 # Only re-check for the presence of auth tables if either the check
934 # hasn't been done before of if they weren't present.
935 return $self->{"$cache_key\_tables_present"} ||= do {
936 my $dbh = $self->dbconnect(1);
945 WHERE (schemaname = 'auth')
946 AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))|;
948 my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
950 scalar @tables == $count;
954 sub session_tables_present {
955 $_[0]->_tables_present('session', 'session_content');
958 sub master_rights_present {
959 $_[0]->_tables_present('master_rights');
962 # --------------------------------------
964 sub all_rights_full {
967 @{ $self->{master_rights} ||= do {
968 $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position");
974 return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
980 my $form = $main::form;
982 my $dbh = $self->dbconnect();
984 my $query = 'SELECT * FROM auth."group"';
985 my $sth = prepare_execute_query($form, $dbh, $query);
989 while ($row = $sth->fetchrow_hashref()) {
990 $groups->{$row->{id}} = $row;
994 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
995 $sth = prepare_query($form, $dbh, $query);
997 foreach $group (values %{$groups}) {
1000 do_statement($form, $sth, $query, $group->{id});
1002 while ($row = $sth->fetchrow_hashref()) {
1003 push @members, $row->{user_id};
1005 $group->{members} = [ uniq @members ];
1009 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1010 $sth = prepare_query($form, $dbh, $query);
1012 foreach $group (values %{$groups}) {
1013 $group->{rights} = {};
1015 do_statement($form, $sth, $query, $group->{id});
1017 while ($row = $sth->fetchrow_hashref()) {
1018 $group->{rights}->{$row->{right}} |= $row->{granted};
1021 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
1032 my $form = $main::form;
1033 my $dbh = $self->dbconnect();
1037 my ($query, $sth, $row, $rights);
1039 if (!$group->{id}) {
1040 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1042 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1043 do_query($form, $dbh, $query, $group->{id});
1046 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1048 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1050 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1051 $sth = prepare_query($form, $dbh, $query);
1053 foreach my $user_id (uniq @{ $group->{members} }) {
1054 do_statement($form, $sth, $query, $user_id, $group->{id});
1058 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1060 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1061 $sth = prepare_query($form, $dbh, $query);
1063 foreach my $right (keys %{ $group->{rights} }) {
1064 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1075 my $form = $main::form;
1077 my $dbh = $self->dbconnect();
1080 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1081 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1082 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1087 sub evaluate_rights_ary {
1094 foreach my $el (@{$ary}) {
1095 if (ref $el eq "ARRAY") {
1096 my $val = evaluate_rights_ary($el);
1097 $val = !$val if $negate;
1099 if ($action eq '|') {
1105 } elsif (($el eq '&') || ($el eq '|')) {
1108 } elsif ($el eq '!') {
1111 } elsif ($action eq '|') {
1113 $val = !$val if $negate;
1119 $val = !$val if $negate;
1129 sub _parse_rights_string {
1138 push @stack, $cur_ary;
1140 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1142 substr($access, 0, length $1) = "";
1144 next if ($token =~ /\s/);
1146 if ($token eq "(") {
1147 my $new_cur_ary = [];
1148 push @stack, $new_cur_ary;
1149 push @{$cur_ary}, $new_cur_ary;
1150 $cur_ary = $new_cur_ary;
1152 } elsif ($token eq ")") {
1159 $cur_ary = $stack[-1];
1161 } elsif (($token eq "|") || ($token eq "&")) {
1162 push @{$cur_ary}, $token;
1165 push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
1169 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1178 my $default = shift;
1180 $self->{FULL_RIGHTS} ||= { };
1181 $self->{FULL_RIGHTS}->{$login} ||= { };
1183 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1184 $self->{RIGHTS} ||= { };
1185 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1187 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1190 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1191 $granted = $default if (!defined $granted);
1197 my ($self, $right, $dont_abort) = @_;
1199 if ($self->check_right($::myconfig{login}, $right)) {
1204 delete $::form->{title};
1205 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1211 sub load_rights_for_user {
1212 my ($self, $login) = @_;
1213 my $dbh = $self->dbconnect;
1214 my ($query, $sth, $row, $rights);
1216 $rights = { map { $_ => 0 } $self->all_rights };
1218 return $rights if !$self->client || !$login;
1221 qq|SELECT gr."right", gr.granted
1222 FROM auth.group_rights gr
1225 FROM auth.user_group ug
1226 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1230 FROM auth.clients_groups cg
1231 WHERE cg.client_id = ?)|;
1233 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1235 while ($row = $sth->fetchrow_hashref()) {
1236 $rights->{$row->{right}} |= $row->{granted};
1252 SL::Auth - Authentication and session handling
1258 =item C<set_session_value @values>
1260 =item C<set_session_value %values>
1262 Store all values of C<@values> or C<%values> in the session. Each
1263 member of C<@values> is tested if it is a hash reference. If it is
1264 then it must contain the keys C<key> and C<value> and can optionally
1265 contain the key C<auto_restore>. In this case C<value> is associated
1266 with C<key> and restored to C<$::form> upon the next request
1267 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1270 If the current member of C<@values> is not a hash reference then it
1271 will be used as the C<key> and the next entry of C<@values> is used as
1272 the C<value> to store. In this case setting C<auto_restore> is not
1275 Therefore the following two invocations are identical:
1277 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1278 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1280 All of these values are copied back into C<$::form> for the next
1281 request automatically if they're scalar values or if they have
1282 C<auto_restore> set to trueish.
1284 The values can be any Perl structure. They are stored as YAML dumps.
1286 =item C<get_session_value $key>
1288 Retrieve a value from the session. Returns C<undef> if the value
1291 =item C<create_unique_sesion_value $value, %params>
1293 Create a unique key in the session and store C<$value>
1296 Returns the key created in the session.
1298 =item C<save_session>
1300 Stores the session values in the database. This is the only function
1301 that actually stores stuff in the database. Neither the various
1302 setters nor the deleter access the database.
1304 =item C<save_form_in_session %params>
1306 Stores the content of C<$params{form}> (default: C<$::form>) in the
1307 session using L</create_unique_sesion_value>.
1309 If C<$params{non_scalars}> is trueish then non-scalar values will be
1310 stored as well. Default is to only store scalar values.
1312 The following keys will never be saved: C<login>, C<password>,
1313 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1314 can be given as an array ref in C<$params{skip_keys}>.
1316 Returns the unique key under which the form is stored.
1318 =item C<restore_form_from_session $key, %params>
1320 Restores the form from the session into C<$params{form}> (default:
1323 If C<$params{clobber}> is falsish then existing values with the same
1324 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1331 C<reset> deletes every state information from previous requests, but does not
1332 close the database connection.
1334 Creating a new database handle on each request can take up to 30% of the
1335 pre-request startup time, so we want to avoid that for fast ajax calls.
1337 =item C<assert, $right, $dont_abort>
1339 Checks if current user has the C<$right>. If C<$dont_abort> is falsish
1340 the request dies with a access denied error, otherwise returns true or false.
1350 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>