5 use Digest::MD5 qw(md5_hex);
7 use Time::HiRes qw(gettimeofday);
8 use List::MoreUtils qw(uniq);
11 use SL::Auth::ColumnInformation;
12 use SL::Auth::Constants qw(:all);
15 use SL::Auth::Password;
16 use SL::Auth::SessionValue;
26 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
27 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
29 use Rose::Object::MakeMethods::Generic (
30 scalar => [ qw(client) ],
35 my ($type, %params) = @_;
36 my $self = bless {}, $type;
38 $self->_read_auth_config(%params);
45 my ($self, %params) = @_;
47 $self->{SESSION} = { };
48 $self->{FULL_RIGHTS} = { };
49 $self->{RIGHTS} = { };
50 $self->{unique_counter} = 0;
51 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
52 $self->{authenticator}->reset;
58 my ($self, $id_or_name) = @_;
62 return undef unless $id_or_name;
64 my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
65 my $dbh = $self->dbconnect;
67 return undef unless $dbh;
69 $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
77 $self->{dbh}->disconnect() if ($self->{dbh});
80 # form isn't loaded yet, so auth needs it's own error.
82 $::lxdebug->show_backtrace();
84 my ($self, @msg) = @_;
85 if ($ENV{HTTP_USER_AGENT}) {
86 print Form->create_http_response(content_type => 'text/html');
87 print "<pre>", join ('<br>', @msg), "</pre>";
89 print STDERR "Error: @msg\n";
94 sub _read_auth_config {
95 my ($self, %params) = @_;
97 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
99 # Prevent password leakage to log files when dumping Auth instances.
100 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
102 if ($params{unit_tests_database}) {
103 $self->{DB_config} = $::lx_office_conf{'testing/database'};
104 $self->{module} = 'DB';
107 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
108 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
111 if ($self->{module} eq 'DB') {
112 $self->{authenticator} = SL::Auth::DB->new($self);
114 } elsif ($self->{module} eq 'LDAP') {
115 $self->{authenticator} = SL::Auth::LDAP->new($self);
118 if (!$self->{authenticator}) {
119 my $locale = Locale->new('en');
120 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
123 my $cfg = $self->{DB_config};
126 my $locale = Locale->new('en');
127 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
130 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
131 my $locale = Locale->new('en');
132 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
135 $self->{authenticator}->verify_config();
137 $self->{session_timeout} *= 1;
138 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
141 sub has_access_to_client {
142 my ($self, $login) = @_;
144 return 0 if !$self->client || !$self->client->{id};
148 FROM auth.clients_users cu
149 LEFT JOIN auth."user" u ON (cu.user_id = u.id)
151 AND (cu.client_id = ?)
154 my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
158 sub authenticate_root {
159 my ($self, $password) = @_;
161 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
162 if (defined $session_root_auth && $session_root_auth == OK) {
166 if (!defined $password) {
170 $password = SL::Auth::Password->hash(login => 'root', password => $password);
171 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
173 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
174 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
180 my ($self, $login, $password) = @_;
182 if (!$self->client || !$self->has_access_to_client($login)) {
186 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
187 if (defined $session_auth && $session_auth == OK) {
191 if (!defined $password) {
195 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
196 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
200 sub punish_wrong_login {
201 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
202 sleep $failed_login_penalty if $failed_login_penalty;
205 sub get_stored_password {
206 my ($self, $login) = @_;
208 my $dbh = $self->dbconnect;
210 return undef unless $dbh;
212 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
213 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
215 return $stored_password;
220 my $may_fail = shift;
226 my $cfg = $self->{DB_config};
227 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
230 $dsn .= ';port=' . $cfg->{port};
233 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
235 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
237 if (!$may_fail && !$self->{dbh}) {
238 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
248 $self->{dbh}->disconnect();
254 my ($self, $dbh) = @_;
256 $dbh ||= $self->dbconnect();
257 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
259 my ($count) = $dbh->selectrow_array($query);
267 my $dbh = $self->dbconnect(1);
272 sub create_database {
276 my $cfg = $self->{DB_config};
278 if (!$params{superuser}) {
279 $params{superuser} = $cfg->{user};
280 $params{superuser_password} = $cfg->{password};
283 $params{template} ||= 'template0';
284 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
286 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
289 $dsn .= ';port=' . $cfg->{port};
292 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
294 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
297 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
300 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
302 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
307 my $error = $dbh->errstr();
309 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
310 my ($cluster_encoding) = $dbh->selectrow_array($query);
312 if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
313 $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
318 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
326 my $dbh = $self->dbconnect();
329 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
337 my $form = $main::form;
339 my $dbh = $self->dbconnect();
341 my ($sth, $query, $user_id);
345 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
346 ($user_id) = selectrow_query($form, $dbh, $query, $login);
349 $query = qq|SELECT nextval('auth.user_id_seq')|;
350 ($user_id) = selectrow_query($form, $dbh, $query);
352 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
353 do_query($form, $dbh, $query, $user_id, $login);
356 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
357 do_query($form, $dbh, $query, $user_id);
359 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
360 $sth = prepare_query($form, $dbh, $query);
362 while (my ($cfg_key, $cfg_value) = each %params) {
363 next if ($cfg_key eq 'password');
365 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
371 sub can_change_password {
374 return $self->{authenticator}->can_change_password();
377 sub change_password {
378 my ($self, $login, $new_password) = @_;
380 my $result = $self->{authenticator}->change_password($login, $new_password);
388 my $dbh = $self->dbconnect();
389 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
391 FROM auth."user" AS u
393 LEFT JOIN auth.user_config AS cfg
394 ON (cfg.user_id = u.id)
396 LEFT JOIN auth.session_content AS sc_login
397 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
399 LEFT JOIN auth.session AS s
400 ON (s.id = sc_login.session_id)
402 my $sth = prepare_execute_query($main::form, $dbh, $query);
406 while (my $ref = $sth->fetchrow_hashref()) {
408 $users{$ref->{login}} ||= {
409 'login' => $ref->{login},
411 'last_action' => $ref->{last_action},
413 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
422 my ($self, %params) = @_;
424 my $dbh = $self->dbconnect();
426 my (@where, @values);
427 if ($params{login}) {
428 push @where, 'u.login = ?';
429 push @values, $params{login};
432 push @where, 'u.id = ?';
433 push @values, $params{id};
435 my $where = join ' AND ', '1 = 1', @where;
436 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
437 FROM auth.user_config cfg
438 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
440 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
444 while (my $ref = $sth->fetchrow_hashref()) {
445 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
446 @user_data{qw(id login)} = @{$ref}{qw(id login)};
449 # The XUL/XML & 'CSS new' backed menus have been removed.
450 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
451 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
453 # The 'Win2000.css' stylesheet has been removed.
454 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
456 # Set default language if selected language does not exist (anymore).
457 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
468 my $dbh = $self->dbconnect();
469 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
478 my $dbh = $self->dbconnect;
479 my $id = $self->get_user_id($login);
488 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
489 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
490 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
492 # TODO: SL::Auth::delete_user
493 # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
498 # --------------------------------------
502 sub restore_session {
505 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
506 $session_id =~ s|[^0-9a-f]||g if $session_id;
508 $self->{SESSION} = { };
511 return $self->session_restore_result(SESSION_NONE());
514 my ($dbh, $query, $sth, $cookie, $ref, $form);
518 # Don't fail if the auth DB doesn't yet.
519 if (!( $dbh = $self->dbconnect(1) )) {
520 return $self->session_restore_result(SESSION_NONE());
523 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
524 # admin is creating the session tables at the moment.
525 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
527 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
528 $sth->finish if $sth;
529 return $self->session_restore_result(SESSION_NONE());
532 $cookie = $sth->fetchrow_hashref;
535 # The session ID provided is valid in the following cases:
536 # 1. session ID exists in the database
537 # 2. hasn't expired yet
538 # 3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
539 # 4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address
540 $self->{api_token} = $cookie->{api_token} if $cookie;
541 my $api_token_cookie = $self->get_api_token_cookie;
542 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
543 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
544 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie;
545 if ($cookie_is_bad) {
546 $self->destroy_session();
547 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
550 if ($self->{column_information}->has('auto_restore')) {
551 $self->_load_with_auto_restore_column($dbh, $session_id);
553 $self->_load_without_auto_restore_column($dbh, $session_id);
556 return $self->session_restore_result(SESSION_OK());
559 sub session_restore_result {
562 $self->{session_restore_result} = $_[0];
564 return $self->{session_restore_result};
567 sub _load_without_auto_restore_column {
568 my ($self, $dbh, $session_id) = @_;
571 SELECT sess_key, sess_value
572 FROM auth.session_content
573 WHERE (session_id = ?)
575 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
577 while (my $ref = $sth->fetchrow_hashref) {
578 my $value = SL::Auth::SessionValue->new(auth => $self,
579 key => $ref->{sess_key},
580 value => $ref->{sess_value},
582 $self->{SESSION}->{ $ref->{sess_key} } = $value;
584 next if defined $::form->{$ref->{sess_key}};
586 my $data = $value->get;
587 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
591 sub _load_with_auto_restore_column {
592 my ($self, $dbh, $session_id) = @_;
594 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
597 SELECT sess_key, sess_value, auto_restore
598 FROM auth.session_content
599 WHERE (session_id = ?)
601 OR sess_key IN (${auto_restore_keys}))
603 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
605 while (my $ref = $sth->fetchrow_hashref) {
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;
623 FROM auth.session_content
624 WHERE (session_id = ?)
625 AND NOT COALESCE(auto_restore, FALSE)
626 AND (sess_key NOT IN (${auto_restore_keys}))
628 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
630 while (my $ref = $sth->fetchrow_hashref) {
631 my $value = SL::Auth::SessionValue->new(auth => $self,
632 key => $ref->{sess_key});
633 $self->{SESSION}->{ $ref->{sess_key} } = $value;
637 sub destroy_session {
641 my $dbh = $self->dbconnect();
645 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
646 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
650 SL::SessionFile->destroy_session($session_id);
653 $self->{SESSION} = { };
657 sub active_session_ids {
659 my $dbh = $self->dbconnect;
661 my $query = qq|SELECT id FROM auth.session|;
663 my @ids = selectall_array_query($::form, $dbh, $query);
668 sub expire_sessions {
671 return if !$self->session_tables_present;
673 my $dbh = $self->dbconnect();
675 my $query = qq|SELECT id
677 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
679 my @ids = selectall_array_query($::form, $dbh, $query);
684 SL::SessionFile->destroy_session($_) for @ids;
686 $query = qq|DELETE FROM auth.session_content
687 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
688 do_query($main::form, $dbh, $query, @ids);
690 $query = qq|DELETE FROM auth.session
691 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
692 do_query($main::form, $dbh, $query, @ids);
698 sub _create_session_id {
700 map { push @data, int(rand() * 255); } (1..32);
702 my $id = md5_hex(pack 'C*', @data);
707 sub create_or_refresh_session {
708 $session_id ||= shift->_create_session_id;
713 my $provided_dbh = shift;
715 my $dbh = $provided_dbh || $self->dbconnect(1);
717 return unless $dbh && $session_id;
719 $dbh->begin_work unless $provided_dbh;
721 # If this fails then the "auth" schema might not exist yet, e.g. if
722 # the admin is just trying to create the auth database.
723 if (!$dbh->do(qq|LOCK auth.session_content|)) {
724 $dbh->rollback unless $provided_dbh;
728 my @unfetched_keys = map { $_->{key} }
729 grep { ! $_->{fetched} }
730 values %{ $self->{SESSION} };
731 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
732 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
733 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
734 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
736 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
738 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
741 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
743 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
746 if ($self->{column_information}->has('api_token', 'session')) {
747 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
748 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
751 my @values_to_save = grep { $_->{fetched} }
752 values %{ $self->{SESSION} };
753 if (@values_to_save) {
754 my ($columns, $placeholders) = ('', '');
755 my $auto_restore = $self->{column_information}->has('auto_restore');
758 $columns .= ', auto_restore';
759 $placeholders .= ', ?';
762 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
763 my $sth = prepare_query($::form, $dbh, $query);
765 foreach my $value (@values_to_save) {
766 my @values = ($value->{key}, $value->get_dumped);
767 push @values, $value->{auto_restore} if $auto_restore;
769 do_statement($::form, $sth, $query, $session_id, @values);
775 $dbh->commit() unless $provided_dbh;
778 sub set_session_value {
782 $self->{SESSION} ||= { };
785 my $key = shift @params;
787 if (ref $key eq 'HASH') {
788 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
789 value => $key->{value},
790 auto_restore => $key->{auto_restore});
793 my $value = shift @params;
794 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
802 sub delete_session_value {
805 $self->{SESSION} ||= { };
806 delete @{ $self->{SESSION} }{ @_ };
811 sub get_session_value {
813 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
818 sub create_unique_sesion_value {
819 my ($self, $value, %params) = @_;
821 $self->{SESSION} ||= { };
823 my @now = gettimeofday();
824 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
825 $self->{unique_counter} ||= 0;
829 $self->{unique_counter}++;
830 $hashed_key = md5_hex($key . $self->{unique_counter});
831 } while (exists $self->{SESSION}->{$hashed_key});
833 $self->set_session_value($hashed_key => $value);
838 sub save_form_in_session {
839 my ($self, %params) = @_;
841 my $form = delete($params{form}) || $::form;
842 my $non_scalars = delete $params{non_scalars};
845 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
847 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
848 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
851 return $self->create_unique_sesion_value($data, %params);
854 sub restore_form_from_session {
855 my ($self, $key, %params) = @_;
857 my $data = $self->get_session_value($key);
858 return $self unless $data;
860 my $form = delete($params{form}) || $::form;
861 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
863 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
868 sub set_cookie_environment_variable {
870 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
873 sub get_session_cookie_name {
874 my ($self, %params) = @_;
876 $params{type} ||= 'id';
877 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
878 $name .= '_api_token' if $params{type} eq 'api_token';
887 sub get_api_token_cookie {
890 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
893 sub is_api_token_cookie_valid {
895 my $provided_api_token = $self->get_api_token_cookie;
896 return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
899 sub session_tables_present {
902 # Only re-check for the presence of auth tables if either the check
903 # hasn't been done before of if they weren't present.
904 if ($self->{session_tables_present}) {
905 return $self->{session_tables_present};
908 my $dbh = $self->dbconnect(1);
917 WHERE (schemaname = 'auth')
918 AND (tablename IN ('session', 'session_content'))|;
920 my ($count) = selectrow_query($main::form, $dbh, $query);
922 $self->{session_tables_present} = 2 == $count;
924 return $self->{session_tables_present};
927 # --------------------------------------
929 sub all_rights_full {
930 my $locale = $main::locale;
933 ["--crm", $locale->text("CRM optional software")],
934 ["crm_search", $locale->text("CRM search")],
935 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
936 ["crm_service", $locale->text("CRM services")],
937 ["crm_admin", $locale->text("CRM admin")],
938 ["crm_adminuser", $locale->text("CRM user")],
939 ["crm_adminstatus", $locale->text("CRM status")],
940 ["crm_email", $locale->text("CRM send email")],
941 ["crm_termin", $locale->text("CRM termin")],
942 ["crm_opportunity", $locale->text("CRM opportunity")],
943 ["crm_knowhow", $locale->text("CRM know how")],
944 ["crm_follow", $locale->text("CRM follow up")],
945 ["crm_notices", $locale->text("CRM notices")],
946 ["crm_other", $locale->text("CRM other")],
947 ["--master_data", $locale->text("Master Data")],
948 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
949 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
950 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
951 ["part_service_assembly_details", $locale->text("Show details and reports of parts, services, assemblies")],
952 ["project_edit", $locale->text("Create and edit projects")],
953 ["--ar", $locale->text("AR")],
954 ["requirement_spec_edit", $locale->text("Create and edit requirement specs")],
955 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
956 ["sales_order_edit", $locale->text("Create and edit sales orders")],
957 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
958 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
959 ["dunning_edit", $locale->text("Create and edit dunnings")],
960 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
961 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
962 ["show_ar_transactions", $locale->text("Show AR transactions as part of AR invoice report")],
963 ["delivery_plan", $locale->text("Show delivery plan")],
964 ["delivery_value_report", $locale->text("Show delivery value report")],
965 ["--ap", $locale->text("AP")],
966 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
967 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
968 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
969 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
970 ["show_ap_transactions", $locale->text("Show AP transactions as part of AP invoice report")],
971 ["--warehouse_management", $locale->text("Warehouse management")],
972 ["warehouse_contents", $locale->text("View warehouse content")],
973 ["warehouse_management", $locale->text("Warehouse management")],
974 ["--general_ledger_cash", $locale->text("General ledger and cash")],
975 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
976 ["datev_export", $locale->text("DATEV Export")],
977 ["cash", $locale->text("Receipt, payment, reconciliation")],
978 ["--reports", $locale->text('Reports')],
979 ["report", $locale->text('All reports')],
980 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
981 ["--batch_printing", $locale->text("Batch Printing")],
982 ["batch_printing", $locale->text("Batch Printing")],
983 ["--configuration", $locale->text("Configuration")],
984 ["config", $locale->text("Change kivitendo installation settings (most entries in the 'System' menu)")],
985 ["admin", $locale->text("Client administration: configuration, editing templates, task server control, background jobs (remaining entries in the 'System' menu)")],
986 ["--others", $locale->text("Others")],
987 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
988 ["productivity", $locale->text("Productivity")],
989 ["display_admin_link", $locale->text("Show administration link")],
996 return grep !/^--/, map { $_->[0] } all_rights_full();
1002 my $form = $main::form;
1004 my $dbh = $self->dbconnect();
1006 my $query = 'SELECT * FROM auth."group"';
1007 my $sth = prepare_execute_query($form, $dbh, $query);
1011 while ($row = $sth->fetchrow_hashref()) {
1012 $groups->{$row->{id}} = $row;
1016 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1017 $sth = prepare_query($form, $dbh, $query);
1019 foreach $group (values %{$groups}) {
1022 do_statement($form, $sth, $query, $group->{id});
1024 while ($row = $sth->fetchrow_hashref()) {
1025 push @members, $row->{user_id};
1027 $group->{members} = [ uniq @members ];
1031 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1032 $sth = prepare_query($form, $dbh, $query);
1034 foreach $group (values %{$groups}) {
1035 $group->{rights} = {};
1037 do_statement($form, $sth, $query, $group->{id});
1039 while ($row = $sth->fetchrow_hashref()) {
1040 $group->{rights}->{$row->{right}} |= $row->{granted};
1043 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1054 my $form = $main::form;
1055 my $dbh = $self->dbconnect();
1059 my ($query, $sth, $row, $rights);
1061 if (!$group->{id}) {
1062 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1064 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1065 do_query($form, $dbh, $query, $group->{id});
1068 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1070 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1072 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1073 $sth = prepare_query($form, $dbh, $query);
1075 foreach my $user_id (uniq @{ $group->{members} }) {
1076 do_statement($form, $sth, $query, $user_id, $group->{id});
1080 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1082 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1083 $sth = prepare_query($form, $dbh, $query);
1085 foreach my $right (keys %{ $group->{rights} }) {
1086 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1097 my $form = $main::form;
1099 my $dbh = $self->dbconnect();
1102 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1103 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1104 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1109 sub evaluate_rights_ary {
1115 foreach my $el (@{$ary}) {
1116 if (ref $el eq "ARRAY") {
1117 if ($action eq '|') {
1118 $value |= evaluate_rights_ary($el);
1120 $value &= evaluate_rights_ary($el);
1123 } elsif (($el eq '&') || ($el eq '|')) {
1126 } elsif ($action eq '|') {
1138 sub _parse_rights_string {
1147 push @stack, $cur_ary;
1149 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1151 substr($access, 0, length $1) = "";
1153 next if ($token =~ /\s/);
1155 if ($token eq "(") {
1156 my $new_cur_ary = [];
1157 push @stack, $new_cur_ary;
1158 push @{$cur_ary}, $new_cur_ary;
1159 $cur_ary = $new_cur_ary;
1161 } elsif ($token eq ")") {
1168 $cur_ary = $stack[-1];
1170 } elsif (($token eq "|") || ($token eq "&")) {
1171 push @{$cur_ary}, $token;
1174 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1178 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1187 my $default = shift;
1189 $self->{FULL_RIGHTS} ||= { };
1190 $self->{FULL_RIGHTS}->{$login} ||= { };
1192 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1193 $self->{RIGHTS} ||= { };
1194 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1196 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1199 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1200 $granted = $default if (!defined $granted);
1206 my ($self, $right, $dont_abort) = @_;
1208 if ($self->check_right($::myconfig{login}, $right)) {
1213 delete $::form->{title};
1214 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1220 sub load_rights_for_user {
1221 my ($self, $login) = @_;
1222 my $dbh = $self->dbconnect;
1223 my ($query, $sth, $row, $rights);
1225 $rights = { map { $_ => 0 } all_rights() };
1227 return $rights if !$self->client || !$login;
1230 qq|SELECT gr."right", gr.granted
1231 FROM auth.group_rights gr
1234 FROM auth.user_group ug
1235 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1239 FROM auth.clients_groups cg
1240 WHERE cg.client_id = ?)|;
1242 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1244 while ($row = $sth->fetchrow_hashref()) {
1245 $rights->{$row->{right}} |= $row->{granted};
1261 SL::Auth - Authentication and session handling
1267 =item C<set_session_value @values>
1269 =item C<set_session_value %values>
1271 Store all values of C<@values> or C<%values> in the session. Each
1272 member of C<@values> is tested if it is a hash reference. If it is
1273 then it must contain the keys C<key> and C<value> and can optionally
1274 contain the key C<auto_restore>. In this case C<value> is associated
1275 with C<key> and restored to C<$::form> upon the next request
1276 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1279 If the current member of C<@values> is not a hash reference then it
1280 will be used as the C<key> and the next entry of C<@values> is used as
1281 the C<value> to store. In this case setting C<auto_restore> is not
1284 Therefore the following two invocations are identical:
1286 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1287 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1289 All of these values are copied back into C<$::form> for the next
1290 request automatically if they're scalar values or if they have
1291 C<auto_restore> set to trueish.
1293 The values can be any Perl structure. They are stored as YAML dumps.
1295 =item C<get_session_value $key>
1297 Retrieve a value from the session. Returns C<undef> if the value
1300 =item C<create_unique_sesion_value $value, %params>
1302 Create a unique key in the session and store C<$value>
1305 Returns the key created in the session.
1307 =item C<save_session>
1309 Stores the session values in the database. This is the only function
1310 that actually stores stuff in the database. Neither the various
1311 setters nor the deleter access the database.
1313 =item C<save_form_in_session %params>
1315 Stores the content of C<$params{form}> (default: C<$::form>) in the
1316 session using L</create_unique_sesion_value>.
1318 If C<$params{non_scalars}> is trueish then non-scalar values will be
1319 stored as well. Default is to only store scalar values.
1321 The following keys will never be saved: C<login>, C<password>,
1322 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1323 can be given as an array ref in C<$params{skip_keys}>.
1325 Returns the unique key under which the form is stored.
1327 =item C<restore_form_from_session $key, %params>
1329 Restores the form from the session into C<$params{form}> (default:
1332 If C<$params{clobber}> is falsish then existing values with the same
1333 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1340 C<reset> deletes every state information from previous requests, but does not
1341 close the database connection.
1343 Creating a new database handle on each request can take up to 30% of the
1344 pre-request startup time, so we want to avoid that for fast ajax calls.
1354 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>