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;
62 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
63 $self->{column_information}->_fetch;
64 $self->{authenticator}->reset;
70 my ($self, $id_or_name) = @_;
74 return undef unless $id_or_name;
76 my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
77 my $dbh = $self->dbconnect;
79 return undef unless $dbh;
81 $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
89 $self->{dbh}->disconnect() if ($self->{dbh});
92 # form isn't loaded yet, so auth needs it's own error.
94 $::lxdebug->show_backtrace();
96 my ($self, @msg) = @_;
97 if ($ENV{HTTP_USER_AGENT}) {
98 print Form->create_http_response(content_type => 'text/html');
99 print "<pre>", join ('<br>', @msg), "</pre>";
101 print STDERR "Error: @msg\n";
103 $::dispatcher->end_request;
106 sub _read_auth_config {
107 my ($self, %params) = @_;
109 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
111 # Prevent password leakage to log files when dumping Auth instances.
112 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
114 if ($params{unit_tests_database}) {
115 $self->{DB_config} = $::lx_office_conf{'testing/database'};
116 $self->{module} = 'DB';
119 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
120 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
123 if ($self->{module} eq 'DB') {
124 $self->{authenticator} = SL::Auth::DB->new($self);
126 } elsif ($self->{module} eq 'LDAP') {
127 $self->{authenticator} = SL::Auth::LDAP->new($self);
130 if (!$self->{authenticator}) {
131 my $locale = Locale->new('en');
132 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
135 my $cfg = $self->{DB_config};
138 my $locale = Locale->new('en');
139 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
142 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
143 my $locale = Locale->new('en');
144 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
147 $self->{authenticator}->verify_config();
149 $self->{session_timeout} *= 1;
150 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
153 sub has_access_to_client {
154 my ($self, $login) = @_;
156 return 0 if !$self->client || !$self->client->{id};
160 FROM auth.clients_users cu
161 LEFT JOIN auth."user" u ON (cu.user_id = u.id)
163 AND (cu.client_id = ?)
166 my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
170 sub authenticate_root {
171 my ($self, $password) = @_;
173 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
174 if (defined $session_root_auth && $session_root_auth == OK) {
178 if (!defined $password) {
182 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
183 $password = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
185 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
186 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
192 my ($self, $login, $password) = @_;
194 if (!$self->client || !$self->has_access_to_client($login)) {
198 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
199 if (defined $session_auth && $session_auth == OK) {
203 if (!defined $password) {
207 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
208 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
212 sub punish_wrong_login {
213 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
214 sleep $failed_login_penalty if $failed_login_penalty;
217 sub get_stored_password {
218 my ($self, $login) = @_;
220 my $dbh = $self->dbconnect;
222 return undef unless $dbh;
224 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
225 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
227 return $stored_password;
232 my $may_fail = shift;
238 my $cfg = $self->{DB_config};
239 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
242 $dsn .= ';port=' . $cfg->{port};
245 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
247 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
249 if (!$may_fail && !$self->{dbh}) {
250 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
260 $self->{dbh}->disconnect();
266 my ($self, $dbh) = @_;
268 $dbh ||= $self->dbconnect();
269 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
271 my ($count) = $dbh->selectrow_array($query);
279 my $dbh = $self->dbconnect(1);
284 sub create_database {
288 my $cfg = $self->{DB_config};
290 if (!$params{superuser}) {
291 $params{superuser} = $cfg->{user};
292 $params{superuser_password} = $cfg->{password};
295 $params{template} ||= 'template0';
296 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
298 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
301 $dsn .= ';port=' . $cfg->{port};
304 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
306 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
309 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
312 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
314 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
319 my $error = $dbh->errstr();
321 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
322 my ($cluster_encoding) = $dbh->selectrow_array($query);
324 if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
325 $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
330 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
338 my $dbh = $self->dbconnect();
341 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
349 my $form = $main::form;
351 my $dbh = $self->dbconnect();
353 my ($sth, $query, $user_id);
357 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
358 ($user_id) = selectrow_query($form, $dbh, $query, $login);
361 $query = qq|SELECT nextval('auth.user_id_seq')|;
362 ($user_id) = selectrow_query($form, $dbh, $query);
364 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
365 do_query($form, $dbh, $query, $user_id, $login);
368 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
369 do_query($form, $dbh, $query, $user_id);
371 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
372 $sth = prepare_query($form, $dbh, $query);
374 while (my ($cfg_key, $cfg_value) = each %params) {
375 next if ($cfg_key eq 'password');
377 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
383 sub can_change_password {
386 return $self->{authenticator}->can_change_password();
389 sub change_password {
390 my ($self, $login, $new_password) = @_;
392 my $result = $self->{authenticator}->change_password($login, $new_password);
400 my $dbh = $self->dbconnect();
401 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
403 FROM auth."user" AS u
405 LEFT JOIN auth.user_config AS cfg
406 ON (cfg.user_id = u.id)
408 LEFT JOIN auth.session_content AS sc_login
409 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
411 LEFT JOIN auth.session AS s
412 ON (s.id = sc_login.session_id)
414 my $sth = prepare_execute_query($main::form, $dbh, $query);
418 while (my $ref = $sth->fetchrow_hashref()) {
420 $users{$ref->{login}} ||= {
421 'login' => $ref->{login},
423 'last_action' => $ref->{last_action},
425 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
434 my ($self, %params) = @_;
436 my $dbh = $self->dbconnect();
438 my (@where, @values);
439 if ($params{login}) {
440 push @where, 'u.login = ?';
441 push @values, $params{login};
444 push @where, 'u.id = ?';
445 push @values, $params{id};
447 my $where = join ' AND ', '1 = 1', @where;
448 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
449 FROM auth.user_config cfg
450 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
452 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
456 while (my $ref = $sth->fetchrow_hashref()) {
457 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
458 @user_data{qw(id login)} = @{$ref}{qw(id login)};
461 # The XUL/XML & 'CSS new' backed menus have been removed.
462 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
463 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
465 # The 'Win2000.css' stylesheet has been removed.
466 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
468 # Set default language if selected language does not exist (anymore).
469 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
480 my $dbh = $self->dbconnect();
481 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
490 my $dbh = $self->dbconnect;
491 my $id = $self->get_user_id($login);
500 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
501 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
502 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
504 # TODO: SL::Auth::delete_user
505 # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
510 # --------------------------------------
514 sub restore_session {
517 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
518 $session_id =~ s|[^0-9a-f]||g if $session_id;
520 $self->{SESSION} = { };
523 return $self->session_restore_result(SESSION_NONE());
526 my ($dbh, $query, $sth, $cookie, $ref, $form);
530 # Don't fail if the auth DB doesn't exist yet.
531 if (!( $dbh = $self->dbconnect(1) )) {
532 return $self->session_restore_result(SESSION_NONE());
535 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
536 # admin is creating the session tables at the moment.
537 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
539 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
540 $sth->finish if $sth;
541 return $self->session_restore_result(SESSION_NONE());
544 $cookie = $sth->fetchrow_hashref;
547 # The session ID provided is valid in the following cases:
548 # 1. session ID exists in the database
549 # 2. hasn't expired yet
550 # 3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
551 # 4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address
552 $self->{api_token} = $cookie->{api_token} if $cookie;
553 my $api_token_cookie = $self->get_api_token_cookie;
554 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
555 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
556 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/;
557 if ($cookie_is_bad) {
558 $self->destroy_session();
559 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
562 if ($self->{column_information}->has('auto_restore')) {
563 $self->_load_with_auto_restore_column($dbh, $session_id);
565 $self->_load_without_auto_restore_column($dbh, $session_id);
568 return $self->session_restore_result(SESSION_OK());
571 sub session_restore_result {
574 $self->{session_restore_result} = $_[0];
576 return $self->{session_restore_result};
579 sub _load_without_auto_restore_column {
580 my ($self, $dbh, $session_id) = @_;
583 SELECT sess_key, sess_value
584 FROM auth.session_content
585 WHERE (session_id = ?)
587 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
589 while (my $ref = $sth->fetchrow_hashref) {
590 my $value = SL::Auth::SessionValue->new(auth => $self,
591 key => $ref->{sess_key},
592 value => $ref->{sess_value},
594 $self->{SESSION}->{ $ref->{sess_key} } = $value;
596 next if defined $::form->{$ref->{sess_key}};
598 my $data = $value->get;
599 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
603 sub _load_with_auto_restore_column {
604 my ($self, $dbh, $session_id) = @_;
606 my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
609 SELECT sess_key, sess_value, auto_restore
610 FROM auth.session_content
611 WHERE (session_id = ?)
613 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
615 while (my $ref = $sth->fetchrow_hashref) {
616 if ($ref->{auto_restore} || $auto_restore_keys{$ref->{sess_key}}) {
617 my $value = SL::Auth::SessionValue->new(auth => $self,
618 key => $ref->{sess_key},
619 value => $ref->{sess_value},
620 auto_restore => $ref->{auto_restore},
622 $self->{SESSION}->{ $ref->{sess_key} } = $value;
624 next if defined $::form->{$ref->{sess_key}};
626 my $data = $value->get;
627 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
629 my $value = SL::Auth::SessionValue->new(auth => $self,
630 key => $ref->{sess_key});
631 $self->{SESSION}->{ $ref->{sess_key} } = $value;
638 sub destroy_session {
642 my $dbh = $self->dbconnect();
646 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
647 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
651 SL::SessionFile->destroy_session($session_id);
654 $self->{SESSION} = { };
658 sub active_session_ids {
660 my $dbh = $self->dbconnect;
662 my $query = qq|SELECT id FROM auth.session|;
664 my @ids = selectall_array_query($::form, $dbh, $query);
669 sub expire_sessions {
672 return if !$self->session_tables_present;
674 my $dbh = $self->dbconnect();
676 my $query = qq|SELECT id
678 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
680 my @ids = selectall_array_query($::form, $dbh, $query);
685 SL::SessionFile->destroy_session($_) for @ids;
687 $query = qq|DELETE FROM auth.session_content
688 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
689 do_query($main::form, $dbh, $query, @ids);
691 $query = qq|DELETE FROM auth.session
692 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
693 do_query($main::form, $dbh, $query, @ids);
699 sub _create_session_id {
701 map { push @data, int(rand() * 255); } (1..32);
703 my $id = md5_hex(pack 'C*', @data);
708 sub create_or_refresh_session {
709 $session_id ||= shift->_create_session_id;
714 my $provided_dbh = shift;
716 my $dbh = $provided_dbh || $self->dbconnect(1);
718 return unless $dbh && $session_id;
720 $dbh->begin_work unless $provided_dbh;
722 # If this fails then the "auth" schema might not exist yet, e.g. if
723 # the admin is just trying to create the auth database.
724 if (!$dbh->do(qq|LOCK auth.session_content|)) {
725 $dbh->rollback unless $provided_dbh;
729 my @unfetched_keys = map { $_->{key} }
730 grep { ! $_->{fetched} }
731 values %{ $self->{SESSION} };
732 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
733 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
734 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
735 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
737 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
739 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
742 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
744 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
747 if ($self->{column_information}->has('api_token', 'session')) {
748 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
749 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
752 my @values_to_save = grep { $_->{fetched} }
753 values %{ $self->{SESSION} };
754 if (@values_to_save) {
755 my ($columns, $placeholders) = ('', '');
756 my $auto_restore = $self->{column_information}->has('auto_restore');
759 $columns .= ', auto_restore';
760 $placeholders .= ', ?';
763 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
764 my $sth = prepare_query($::form, $dbh, $query);
766 foreach my $value (@values_to_save) {
767 my @values = ($value->{key}, $value->get_dumped);
768 push @values, $value->{auto_restore} if $auto_restore;
770 do_statement($::form, $sth, $query, $session_id, @values);
776 $dbh->commit() unless $provided_dbh;
779 sub set_session_value {
783 $self->{SESSION} ||= { };
786 my $key = shift @params;
788 if (ref $key eq 'HASH') {
789 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
790 value => $key->{value},
791 auto_restore => $key->{auto_restore});
794 my $value = shift @params;
795 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
803 sub delete_session_value {
806 $self->{SESSION} ||= { };
807 delete @{ $self->{SESSION} }{ @_ };
812 sub get_session_value {
814 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
819 sub create_unique_sesion_value {
820 my ($self, $value, %params) = @_;
822 $self->{SESSION} ||= { };
824 my @now = gettimeofday();
825 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
826 $self->{unique_counter} ||= 0;
830 $self->{unique_counter}++;
831 $hashed_key = md5_hex($key . $self->{unique_counter});
832 } while (exists $self->{SESSION}->{$hashed_key});
834 $self->set_session_value($hashed_key => $value);
839 sub save_form_in_session {
840 my ($self, %params) = @_;
842 my $form = delete($params{form}) || $::form;
843 my $non_scalars = delete $params{non_scalars};
846 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
848 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
849 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
852 return $self->create_unique_sesion_value($data, %params);
855 sub restore_form_from_session {
856 my ($self, $key, %params) = @_;
858 my $data = $self->get_session_value($key);
859 return $self unless $data;
861 my $form = delete($params{form}) || $::form;
862 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
864 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
869 sub set_cookie_environment_variable {
871 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
874 sub get_session_cookie_name {
875 my ($self, %params) = @_;
877 $params{type} ||= 'id';
878 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
879 $name .= '_api_token' if $params{type} eq 'api_token';
888 sub get_api_token_cookie {
891 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
894 sub is_api_token_cookie_valid {
896 my $provided_api_token = $self->get_api_token_cookie;
897 return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
900 sub _tables_present {
901 my ($self, @tables) = @_;
902 my $cache_key = join '_', @tables;
904 # Only re-check for the presence of auth tables if either the check
905 # hasn't been done before of if they weren't present.
906 return $self->{"$cache_key\_tables_present"} ||= do {
907 my $dbh = $self->dbconnect(1);
916 WHERE (schemaname = 'auth')
917 AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))|;
919 my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
921 scalar @tables == $count;
925 sub session_tables_present {
926 $_[0]->_tables_present('session', 'session_content');
929 sub master_rights_present {
930 $_[0]->_tables_present('master_rights');
933 # --------------------------------------
935 sub all_rights_full {
938 @{ $self->{master_rights} ||= do {
939 $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position");
945 return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
951 my $form = $main::form;
953 my $dbh = $self->dbconnect();
955 my $query = 'SELECT * FROM auth."group"';
956 my $sth = prepare_execute_query($form, $dbh, $query);
960 while ($row = $sth->fetchrow_hashref()) {
961 $groups->{$row->{id}} = $row;
965 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
966 $sth = prepare_query($form, $dbh, $query);
968 foreach $group (values %{$groups}) {
971 do_statement($form, $sth, $query, $group->{id});
973 while ($row = $sth->fetchrow_hashref()) {
974 push @members, $row->{user_id};
976 $group->{members} = [ uniq @members ];
980 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
981 $sth = prepare_query($form, $dbh, $query);
983 foreach $group (values %{$groups}) {
984 $group->{rights} = {};
986 do_statement($form, $sth, $query, $group->{id});
988 while ($row = $sth->fetchrow_hashref()) {
989 $group->{rights}->{$row->{right}} |= $row->{granted};
992 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
1003 my $form = $main::form;
1004 my $dbh = $self->dbconnect();
1008 my ($query, $sth, $row, $rights);
1010 if (!$group->{id}) {
1011 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1013 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1014 do_query($form, $dbh, $query, $group->{id});
1017 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1019 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1021 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1022 $sth = prepare_query($form, $dbh, $query);
1024 foreach my $user_id (uniq @{ $group->{members} }) {
1025 do_statement($form, $sth, $query, $user_id, $group->{id});
1029 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1031 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1032 $sth = prepare_query($form, $dbh, $query);
1034 foreach my $right (keys %{ $group->{rights} }) {
1035 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1046 my $form = $main::form;
1048 my $dbh = $self->dbconnect();
1051 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1052 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1053 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1058 sub evaluate_rights_ary {
1064 foreach my $el (@{$ary}) {
1065 if (ref $el eq "ARRAY") {
1066 if ($action eq '|') {
1067 $value |= evaluate_rights_ary($el);
1069 $value &= evaluate_rights_ary($el);
1072 } elsif (($el eq '&') || ($el eq '|')) {
1075 } elsif ($action eq '|') {
1087 sub _parse_rights_string {
1096 push @stack, $cur_ary;
1098 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1100 substr($access, 0, length $1) = "";
1102 next if ($token =~ /\s/);
1104 if ($token eq "(") {
1105 my $new_cur_ary = [];
1106 push @stack, $new_cur_ary;
1107 push @{$cur_ary}, $new_cur_ary;
1108 $cur_ary = $new_cur_ary;
1110 } elsif ($token eq ")") {
1117 $cur_ary = $stack[-1];
1119 } elsif (($token eq "|") || ($token eq "&")) {
1120 push @{$cur_ary}, $token;
1123 push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
1127 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1136 my $default = shift;
1138 $self->{FULL_RIGHTS} ||= { };
1139 $self->{FULL_RIGHTS}->{$login} ||= { };
1141 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1142 $self->{RIGHTS} ||= { };
1143 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1145 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1148 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1149 $granted = $default if (!defined $granted);
1155 my ($self, $right, $dont_abort) = @_;
1157 if ($self->check_right($::myconfig{login}, $right)) {
1162 delete $::form->{title};
1163 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1169 sub load_rights_for_user {
1170 my ($self, $login) = @_;
1171 my $dbh = $self->dbconnect;
1172 my ($query, $sth, $row, $rights);
1174 $rights = { map { $_ => 0 } $self->all_rights };
1176 return $rights if !$self->client || !$login;
1179 qq|SELECT gr."right", gr.granted
1180 FROM auth.group_rights gr
1183 FROM auth.user_group ug
1184 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1188 FROM auth.clients_groups cg
1189 WHERE cg.client_id = ?)|;
1191 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1193 while ($row = $sth->fetchrow_hashref()) {
1194 $rights->{$row->{right}} |= $row->{granted};
1210 SL::Auth - Authentication and session handling
1216 =item C<set_session_value @values>
1218 =item C<set_session_value %values>
1220 Store all values of C<@values> or C<%values> in the session. Each
1221 member of C<@values> is tested if it is a hash reference. If it is
1222 then it must contain the keys C<key> and C<value> and can optionally
1223 contain the key C<auto_restore>. In this case C<value> is associated
1224 with C<key> and restored to C<$::form> upon the next request
1225 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1228 If the current member of C<@values> is not a hash reference then it
1229 will be used as the C<key> and the next entry of C<@values> is used as
1230 the C<value> to store. In this case setting C<auto_restore> is not
1233 Therefore the following two invocations are identical:
1235 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1236 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1238 All of these values are copied back into C<$::form> for the next
1239 request automatically if they're scalar values or if they have
1240 C<auto_restore> set to trueish.
1242 The values can be any Perl structure. They are stored as YAML dumps.
1244 =item C<get_session_value $key>
1246 Retrieve a value from the session. Returns C<undef> if the value
1249 =item C<create_unique_sesion_value $value, %params>
1251 Create a unique key in the session and store C<$value>
1254 Returns the key created in the session.
1256 =item C<save_session>
1258 Stores the session values in the database. This is the only function
1259 that actually stores stuff in the database. Neither the various
1260 setters nor the deleter access the database.
1262 =item C<save_form_in_session %params>
1264 Stores the content of C<$params{form}> (default: C<$::form>) in the
1265 session using L</create_unique_sesion_value>.
1267 If C<$params{non_scalars}> is trueish then non-scalar values will be
1268 stored as well. Default is to only store scalar values.
1270 The following keys will never be saved: C<login>, C<password>,
1271 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1272 can be given as an array ref in C<$params{skip_keys}>.
1274 Returns the unique key under which the form is stored.
1276 =item C<restore_form_from_session $key, %params>
1278 Restores the form from the session into C<$params{form}> (default:
1281 If C<$params{clobber}> is falsish then existing values with the same
1282 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1289 C<reset> deletes every state information from previous requests, but does not
1290 close the database connection.
1292 Creating a new database handle on each request can take up to 30% of the
1293 pre-request startup time, so we want to avoid that for fast ajax calls.
1303 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>