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);
53 $self->{authenticator}->reset;
59 my ($self, $id_or_name) = @_;
63 return undef unless $id_or_name;
65 my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
66 my $dbh = $self->dbconnect;
68 return undef unless $dbh;
70 $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
78 $self->{dbh}->disconnect() if ($self->{dbh});
81 # form isn't loaded yet, so auth needs it's own error.
83 $::lxdebug->show_backtrace();
85 my ($self, @msg) = @_;
86 if ($ENV{HTTP_USER_AGENT}) {
87 print Form->create_http_response(content_type => 'text/html');
88 print "<pre>", join ('<br>', @msg), "</pre>";
90 print STDERR "Error: @msg\n";
92 $::dispatcher->end_request;
95 sub _read_auth_config {
96 my ($self, %params) = @_;
98 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
100 # Prevent password leakage to log files when dumping Auth instances.
101 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
103 if ($params{unit_tests_database}) {
104 $self->{DB_config} = $::lx_office_conf{'testing/database'};
105 $self->{module} = 'DB';
108 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
109 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
112 if ($self->{module} eq 'DB') {
113 $self->{authenticator} = SL::Auth::DB->new($self);
115 } elsif ($self->{module} eq 'LDAP') {
116 $self->{authenticator} = SL::Auth::LDAP->new($self);
119 if (!$self->{authenticator}) {
120 my $locale = Locale->new('en');
121 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
124 my $cfg = $self->{DB_config};
127 my $locale = Locale->new('en');
128 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
131 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
132 my $locale = Locale->new('en');
133 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
136 $self->{authenticator}->verify_config();
138 $self->{session_timeout} *= 1;
139 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
142 sub has_access_to_client {
143 my ($self, $login) = @_;
145 return 0 if !$self->client || !$self->client->{id};
149 FROM auth.clients_users cu
150 LEFT JOIN auth."user" u ON (cu.user_id = u.id)
152 AND (cu.client_id = ?)
155 my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
159 sub authenticate_root {
160 my ($self, $password) = @_;
162 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
163 if (defined $session_root_auth && $session_root_auth == OK) {
167 if (!defined $password) {
171 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
172 $password = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
174 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
175 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
181 my ($self, $login, $password) = @_;
183 if (!$self->client || !$self->has_access_to_client($login)) {
187 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
188 if (defined $session_auth && $session_auth == OK) {
192 if (!defined $password) {
196 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
197 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
201 sub punish_wrong_login {
202 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
203 sleep $failed_login_penalty if $failed_login_penalty;
206 sub get_stored_password {
207 my ($self, $login) = @_;
209 my $dbh = $self->dbconnect;
211 return undef unless $dbh;
213 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
214 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
216 return $stored_password;
221 my $may_fail = shift;
227 my $cfg = $self->{DB_config};
228 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
231 $dsn .= ';port=' . $cfg->{port};
234 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
236 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
238 if (!$may_fail && !$self->{dbh}) {
239 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
249 $self->{dbh}->disconnect();
255 my ($self, $dbh) = @_;
257 $dbh ||= $self->dbconnect();
258 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
260 my ($count) = $dbh->selectrow_array($query);
268 my $dbh = $self->dbconnect(1);
273 sub create_database {
277 my $cfg = $self->{DB_config};
279 if (!$params{superuser}) {
280 $params{superuser} = $cfg->{user};
281 $params{superuser_password} = $cfg->{password};
284 $params{template} ||= 'template0';
285 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
287 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
290 $dsn .= ';port=' . $cfg->{port};
293 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
295 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
298 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
301 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
303 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
308 my $error = $dbh->errstr();
310 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
311 my ($cluster_encoding) = $dbh->selectrow_array($query);
313 if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
314 $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
319 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
327 my $dbh = $self->dbconnect();
330 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
338 my $form = $main::form;
340 my $dbh = $self->dbconnect();
342 my ($sth, $query, $user_id);
346 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
347 ($user_id) = selectrow_query($form, $dbh, $query, $login);
350 $query = qq|SELECT nextval('auth.user_id_seq')|;
351 ($user_id) = selectrow_query($form, $dbh, $query);
353 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
354 do_query($form, $dbh, $query, $user_id, $login);
357 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
358 do_query($form, $dbh, $query, $user_id);
360 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
361 $sth = prepare_query($form, $dbh, $query);
363 while (my ($cfg_key, $cfg_value) = each %params) {
364 next if ($cfg_key eq 'password');
366 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
372 sub can_change_password {
375 return $self->{authenticator}->can_change_password();
378 sub change_password {
379 my ($self, $login, $new_password) = @_;
381 my $result = $self->{authenticator}->change_password($login, $new_password);
389 my $dbh = $self->dbconnect();
390 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
392 FROM auth."user" AS u
394 LEFT JOIN auth.user_config AS cfg
395 ON (cfg.user_id = u.id)
397 LEFT JOIN auth.session_content AS sc_login
398 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
400 LEFT JOIN auth.session AS s
401 ON (s.id = sc_login.session_id)
403 my $sth = prepare_execute_query($main::form, $dbh, $query);
407 while (my $ref = $sth->fetchrow_hashref()) {
409 $users{$ref->{login}} ||= {
410 'login' => $ref->{login},
412 'last_action' => $ref->{last_action},
414 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
423 my ($self, %params) = @_;
425 my $dbh = $self->dbconnect();
427 my (@where, @values);
428 if ($params{login}) {
429 push @where, 'u.login = ?';
430 push @values, $params{login};
433 push @where, 'u.id = ?';
434 push @values, $params{id};
436 my $where = join ' AND ', '1 = 1', @where;
437 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
438 FROM auth.user_config cfg
439 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
441 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
445 while (my $ref = $sth->fetchrow_hashref()) {
446 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
447 @user_data{qw(id login)} = @{$ref}{qw(id login)};
450 # The XUL/XML & 'CSS new' backed menus have been removed.
451 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
452 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
454 # The 'Win2000.css' stylesheet has been removed.
455 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
457 # Set default language if selected language does not exist (anymore).
458 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
469 my $dbh = $self->dbconnect();
470 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
479 my $dbh = $self->dbconnect;
480 my $id = $self->get_user_id($login);
489 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
490 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
491 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
493 # TODO: SL::Auth::delete_user
494 # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
499 # --------------------------------------
503 sub restore_session {
506 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
507 $session_id =~ s|[^0-9a-f]||g if $session_id;
509 $self->{SESSION} = { };
512 return $self->session_restore_result(SESSION_NONE());
515 my ($dbh, $query, $sth, $cookie, $ref, $form);
519 # Don't fail if the auth DB doesn't exist yet.
520 if (!( $dbh = $self->dbconnect(1) )) {
521 return $self->session_restore_result(SESSION_NONE());
524 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
525 # admin is creating the session tables at the moment.
526 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
528 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
529 $sth->finish if $sth;
530 return $self->session_restore_result(SESSION_NONE());
533 $cookie = $sth->fetchrow_hashref;
536 # The session ID provided is valid in the following cases:
537 # 1. session ID exists in the database
538 # 2. hasn't expired yet
539 # 3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
540 # 4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address
541 $self->{api_token} = $cookie->{api_token} if $cookie;
542 my $api_token_cookie = $self->get_api_token_cookie;
543 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
544 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
545 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/;
546 if ($cookie_is_bad) {
547 $self->destroy_session();
548 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
551 if ($self->{column_information}->has('auto_restore')) {
552 $self->_load_with_auto_restore_column($dbh, $session_id);
554 $self->_load_without_auto_restore_column($dbh, $session_id);
557 return $self->session_restore_result(SESSION_OK());
560 sub session_restore_result {
563 $self->{session_restore_result} = $_[0];
565 return $self->{session_restore_result};
568 sub _load_without_auto_restore_column {
569 my ($self, $dbh, $session_id) = @_;
572 SELECT sess_key, sess_value
573 FROM auth.session_content
574 WHERE (session_id = ?)
576 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
578 while (my $ref = $sth->fetchrow_hashref) {
579 my $value = SL::Auth::SessionValue->new(auth => $self,
580 key => $ref->{sess_key},
581 value => $ref->{sess_value},
583 $self->{SESSION}->{ $ref->{sess_key} } = $value;
585 next if defined $::form->{$ref->{sess_key}};
587 my $data = $value->get;
588 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
592 sub _load_with_auto_restore_column {
593 my ($self, $dbh, $session_id) = @_;
595 my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
598 SELECT sess_key, sess_value, auto_restore
599 FROM auth.session_content
600 WHERE (session_id = ?)
602 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
604 while (my $ref = $sth->fetchrow_hashref) {
605 if ($ref->{auto_restore} || $auto_restore_keys{$ref->{sess_key}}) {
606 my $value = SL::Auth::SessionValue->new(auth => $self,
607 key => $ref->{sess_key},
608 value => $ref->{sess_value},
609 auto_restore => $ref->{auto_restore},
611 $self->{SESSION}->{ $ref->{sess_key} } = $value;
613 next if defined $::form->{$ref->{sess_key}};
615 my $data = $value->get;
616 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
618 my $value = SL::Auth::SessionValue->new(auth => $self,
619 key => $ref->{sess_key});
620 $self->{SESSION}->{ $ref->{sess_key} } = $value;
627 sub destroy_session {
631 my $dbh = $self->dbconnect();
635 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
636 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
640 SL::SessionFile->destroy_session($session_id);
643 $self->{SESSION} = { };
647 sub active_session_ids {
649 my $dbh = $self->dbconnect;
651 my $query = qq|SELECT id FROM auth.session|;
653 my @ids = selectall_array_query($::form, $dbh, $query);
658 sub expire_sessions {
661 return if !$self->session_tables_present;
663 my $dbh = $self->dbconnect();
665 my $query = qq|SELECT id
667 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
669 my @ids = selectall_array_query($::form, $dbh, $query);
674 SL::SessionFile->destroy_session($_) for @ids;
676 $query = qq|DELETE FROM auth.session_content
677 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
678 do_query($main::form, $dbh, $query, @ids);
680 $query = qq|DELETE FROM auth.session
681 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
682 do_query($main::form, $dbh, $query, @ids);
688 sub _create_session_id {
690 map { push @data, int(rand() * 255); } (1..32);
692 my $id = md5_hex(pack 'C*', @data);
697 sub create_or_refresh_session {
698 $session_id ||= shift->_create_session_id;
703 my $provided_dbh = shift;
705 my $dbh = $provided_dbh || $self->dbconnect(1);
707 return unless $dbh && $session_id;
709 $dbh->begin_work unless $provided_dbh;
711 # If this fails then the "auth" schema might not exist yet, e.g. if
712 # the admin is just trying to create the auth database.
713 if (!$dbh->do(qq|LOCK auth.session_content|)) {
714 $dbh->rollback unless $provided_dbh;
718 my @unfetched_keys = map { $_->{key} }
719 grep { ! $_->{fetched} }
720 values %{ $self->{SESSION} };
721 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
722 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
723 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
724 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
726 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
728 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
731 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
733 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
736 if ($self->{column_information}->has('api_token', 'session')) {
737 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
738 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
741 my @values_to_save = grep { $_->{fetched} }
742 values %{ $self->{SESSION} };
743 if (@values_to_save) {
744 my ($columns, $placeholders) = ('', '');
745 my $auto_restore = $self->{column_information}->has('auto_restore');
748 $columns .= ', auto_restore';
749 $placeholders .= ', ?';
752 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
753 my $sth = prepare_query($::form, $dbh, $query);
755 foreach my $value (@values_to_save) {
756 my @values = ($value->{key}, $value->get_dumped);
757 push @values, $value->{auto_restore} if $auto_restore;
759 do_statement($::form, $sth, $query, $session_id, @values);
765 $dbh->commit() unless $provided_dbh;
768 sub set_session_value {
772 $self->{SESSION} ||= { };
775 my $key = shift @params;
777 if (ref $key eq 'HASH') {
778 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
779 value => $key->{value},
780 auto_restore => $key->{auto_restore});
783 my $value = shift @params;
784 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
792 sub delete_session_value {
795 $self->{SESSION} ||= { };
796 delete @{ $self->{SESSION} }{ @_ };
801 sub get_session_value {
803 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
808 sub create_unique_sesion_value {
809 my ($self, $value, %params) = @_;
811 $self->{SESSION} ||= { };
813 my @now = gettimeofday();
814 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
815 $self->{unique_counter} ||= 0;
819 $self->{unique_counter}++;
820 $hashed_key = md5_hex($key . $self->{unique_counter});
821 } while (exists $self->{SESSION}->{$hashed_key});
823 $self->set_session_value($hashed_key => $value);
828 sub save_form_in_session {
829 my ($self, %params) = @_;
831 my $form = delete($params{form}) || $::form;
832 my $non_scalars = delete $params{non_scalars};
835 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
837 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
838 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
841 return $self->create_unique_sesion_value($data, %params);
844 sub restore_form_from_session {
845 my ($self, $key, %params) = @_;
847 my $data = $self->get_session_value($key);
848 return $self unless $data;
850 my $form = delete($params{form}) || $::form;
851 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
853 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
858 sub set_cookie_environment_variable {
860 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
863 sub get_session_cookie_name {
864 my ($self, %params) = @_;
866 $params{type} ||= 'id';
867 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
868 $name .= '_api_token' if $params{type} eq 'api_token';
877 sub get_api_token_cookie {
880 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
883 sub is_api_token_cookie_valid {
885 my $provided_api_token = $self->get_api_token_cookie;
886 return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
889 sub _tables_present {
890 my ($self, @tables) = @_;
891 my $cache_key = join '_', @tables;
893 # Only re-check for the presence of auth tables if either the check
894 # hasn't been done before of if they weren't present.
895 return $self->{"$cache_key\_tables_present"} ||= do {
896 my $dbh = $self->dbconnect(1);
905 WHERE (schemaname = 'auth')
906 AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))|;
908 my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
910 scalar @tables == $count;
914 sub session_tables_present {
915 $_[0]->_tables_present('session', 'session_content');
918 sub master_rights_present {
919 $_[0]->_tables_present('master_rights');
922 # --------------------------------------
924 sub all_rights_full {
927 @{ $self->{master_rights} ||= do {
928 $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY id");
934 return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
940 my $form = $main::form;
942 my $dbh = $self->dbconnect();
944 my $query = 'SELECT * FROM auth."group"';
945 my $sth = prepare_execute_query($form, $dbh, $query);
949 while ($row = $sth->fetchrow_hashref()) {
950 $groups->{$row->{id}} = $row;
954 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
955 $sth = prepare_query($form, $dbh, $query);
957 foreach $group (values %{$groups}) {
960 do_statement($form, $sth, $query, $group->{id});
962 while ($row = $sth->fetchrow_hashref()) {
963 push @members, $row->{user_id};
965 $group->{members} = [ uniq @members ];
969 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
970 $sth = prepare_query($form, $dbh, $query);
972 foreach $group (values %{$groups}) {
973 $group->{rights} = {};
975 do_statement($form, $sth, $query, $group->{id});
977 while ($row = $sth->fetchrow_hashref()) {
978 $group->{rights}->{$row->{right}} |= $row->{granted};
981 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
992 my $form = $main::form;
993 my $dbh = $self->dbconnect();
997 my ($query, $sth, $row, $rights);
1000 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1002 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1003 do_query($form, $dbh, $query, $group->{id});
1006 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1008 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1010 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1011 $sth = prepare_query($form, $dbh, $query);
1013 foreach my $user_id (uniq @{ $group->{members} }) {
1014 do_statement($form, $sth, $query, $user_id, $group->{id});
1018 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1020 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1021 $sth = prepare_query($form, $dbh, $query);
1023 foreach my $right (keys %{ $group->{rights} }) {
1024 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1035 my $form = $main::form;
1037 my $dbh = $self->dbconnect();
1040 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1041 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1042 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1047 sub evaluate_rights_ary {
1053 foreach my $el (@{$ary}) {
1054 if (ref $el eq "ARRAY") {
1055 if ($action eq '|') {
1056 $value |= evaluate_rights_ary($el);
1058 $value &= evaluate_rights_ary($el);
1061 } elsif (($el eq '&') || ($el eq '|')) {
1064 } elsif ($action eq '|') {
1076 sub _parse_rights_string {
1085 push @stack, $cur_ary;
1087 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1089 substr($access, 0, length $1) = "";
1091 next if ($token =~ /\s/);
1093 if ($token eq "(") {
1094 my $new_cur_ary = [];
1095 push @stack, $new_cur_ary;
1096 push @{$cur_ary}, $new_cur_ary;
1097 $cur_ary = $new_cur_ary;
1099 } elsif ($token eq ")") {
1106 $cur_ary = $stack[-1];
1108 } elsif (($token eq "|") || ($token eq "&")) {
1109 push @{$cur_ary}, $token;
1112 push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
1116 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1125 my $default = shift;
1127 $self->{FULL_RIGHTS} ||= { };
1128 $self->{FULL_RIGHTS}->{$login} ||= { };
1130 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1131 $self->{RIGHTS} ||= { };
1132 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1134 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1137 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1138 $granted = $default if (!defined $granted);
1144 my ($self, $right, $dont_abort) = @_;
1146 if ($self->check_right($::myconfig{login}, $right)) {
1151 delete $::form->{title};
1152 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1158 sub load_rights_for_user {
1159 my ($self, $login) = @_;
1160 my $dbh = $self->dbconnect;
1161 my ($query, $sth, $row, $rights);
1163 $rights = { map { $_ => 0 } $self->all_rights };
1165 return $rights if !$self->client || !$login;
1168 qq|SELECT gr."right", gr.granted
1169 FROM auth.group_rights gr
1172 FROM auth.user_group ug
1173 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1177 FROM auth.clients_groups cg
1178 WHERE cg.client_id = ?)|;
1180 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1182 while ($row = $sth->fetchrow_hashref()) {
1183 $rights->{$row->{right}} |= $row->{granted};
1199 SL::Auth - Authentication and session handling
1205 =item C<set_session_value @values>
1207 =item C<set_session_value %values>
1209 Store all values of C<@values> or C<%values> in the session. Each
1210 member of C<@values> is tested if it is a hash reference. If it is
1211 then it must contain the keys C<key> and C<value> and can optionally
1212 contain the key C<auto_restore>. In this case C<value> is associated
1213 with C<key> and restored to C<$::form> upon the next request
1214 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1217 If the current member of C<@values> is not a hash reference then it
1218 will be used as the C<key> and the next entry of C<@values> is used as
1219 the C<value> to store. In this case setting C<auto_restore> is not
1222 Therefore the following two invocations are identical:
1224 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1225 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1227 All of these values are copied back into C<$::form> for the next
1228 request automatically if they're scalar values or if they have
1229 C<auto_restore> set to trueish.
1231 The values can be any Perl structure. They are stored as YAML dumps.
1233 =item C<get_session_value $key>
1235 Retrieve a value from the session. Returns C<undef> if the value
1238 =item C<create_unique_sesion_value $value, %params>
1240 Create a unique key in the session and store C<$value>
1243 Returns the key created in the session.
1245 =item C<save_session>
1247 Stores the session values in the database. This is the only function
1248 that actually stores stuff in the database. Neither the various
1249 setters nor the deleter access the database.
1251 =item C<save_form_in_session %params>
1253 Stores the content of C<$params{form}> (default: C<$::form>) in the
1254 session using L</create_unique_sesion_value>.
1256 If C<$params{non_scalars}> is trueish then non-scalar values will be
1257 stored as well. Default is to only store scalar values.
1259 The following keys will never be saved: C<login>, C<password>,
1260 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1261 can be given as an array ref in C<$params{skip_keys}>.
1263 Returns the unique key under which the form is stored.
1265 =item C<restore_form_from_session $key, %params>
1267 Restores the form from the session into C<$params{form}> (default:
1270 If C<$params{clobber}> is falsish then existing values with the same
1271 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1278 C<reset> deletes every state information from previous requests, but does not
1279 close the database connection.
1281 Creating a new database handle on each request can take up to 30% of the
1282 pre-request startup time, so we want to avoid that for fast ajax calls.
1292 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>