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;
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";
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 $password = SL::Auth::Password->hash(login => 'root', password => $password);
172 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{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 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 = join ', ', map { "'${_}'" } qw(login password rpw);
598 SELECT sess_key, sess_value, auto_restore
599 FROM auth.session_content
600 WHERE (session_id = ?)
602 OR sess_key IN (${auto_restore_keys}))
604 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
606 while (my $ref = $sth->fetchrow_hashref) {
607 my $value = SL::Auth::SessionValue->new(auth => $self,
608 key => $ref->{sess_key},
609 value => $ref->{sess_value},
610 auto_restore => $ref->{auto_restore},
612 $self->{SESSION}->{ $ref->{sess_key} } = $value;
614 next if defined $::form->{$ref->{sess_key}};
616 my $data = $value->get;
617 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
624 FROM auth.session_content
625 WHERE (session_id = ?)
626 AND NOT COALESCE(auto_restore, FALSE)
627 AND (sess_key NOT IN (${auto_restore_keys}))
629 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
631 while (my $ref = $sth->fetchrow_hashref) {
632 my $value = SL::Auth::SessionValue->new(auth => $self,
633 key => $ref->{sess_key});
634 $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 session_tables_present {
903 # Only re-check for the presence of auth tables if either the check
904 # hasn't been done before of if they weren't present.
905 if ($self->{session_tables_present}) {
906 return $self->{session_tables_present};
909 my $dbh = $self->dbconnect(1);
918 WHERE (schemaname = 'auth')
919 AND (tablename IN ('session', 'session_content'))|;
921 my ($count) = selectrow_query($main::form, $dbh, $query);
923 $self->{session_tables_present} = 2 == $count;
925 return $self->{session_tables_present};
928 # --------------------------------------
930 sub all_rights_full {
931 my $locale = $main::locale;
934 ["--master_data", $locale->text("Master Data")],
935 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
936 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
937 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
938 ["part_service_assembly_details", $locale->text("Show details and reports of parts, services, assemblies")],
939 ["project_edit", $locale->text("Create and edit projects")],
940 ["--ar", $locale->text("AR")],
941 ["requirement_spec_edit", $locale->text("Create and edit requirement specs")],
942 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
943 ["sales_order_edit", $locale->text("Create and edit sales orders")],
944 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
945 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
946 ["dunning_edit", $locale->text("Create and edit dunnings")],
947 ["sales_letter_edit", $locale->text("Edit sales letters")],
948 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
949 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
950 ["show_ar_transactions", $locale->text("Show AR transactions as part of AR invoice report")],
951 ["delivery_plan", $locale->text("Show delivery plan")],
952 ["delivery_value_report", $locale->text("Show delivery value report")],
953 ["sales_letter_report", $locale->text("Show sales letters report")],
954 ["--ap", $locale->text("AP")],
955 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
956 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
957 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
958 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
959 ["show_ap_transactions", $locale->text("Show AP transactions as part of AP invoice report")],
960 ["--warehouse_management", $locale->text("Warehouse management")],
961 ["warehouse_contents", $locale->text("View warehouse content")],
962 ["warehouse_management", $locale->text("Warehouse management")],
963 ["--general_ledger_cash", $locale->text("General ledger and cash")],
964 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
965 ["datev_export", $locale->text("DATEV Export")],
966 ["cash", $locale->text("Receipt, payment, reconciliation")],
967 ["bank_transaction", $locale->text("Bank transactions")],
968 ["--reports", $locale->text('Reports')],
969 ["report", $locale->text('All reports')],
970 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
971 ["--batch_printing", $locale->text("Batch Printing")],
972 ["batch_printing", $locale->text("Batch Printing")],
973 ["--configuration", $locale->text("Configuration")],
974 ["config", $locale->text("Change kivitendo installation settings (most entries in the 'System' menu)")],
975 ["admin", $locale->text("Client administration: configuration, editing templates, task server control, background jobs (remaining entries in the 'System' menu)")],
976 ["--others", $locale->text("Others")],
977 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
978 ["productivity", $locale->text("Productivity")],
979 ["display_admin_link", $locale->text("Show administration link")],
986 return grep !/^--/, map { $_->[0] } all_rights_full();
992 my $form = $main::form;
994 my $dbh = $self->dbconnect();
996 my $query = 'SELECT * FROM auth."group"';
997 my $sth = prepare_execute_query($form, $dbh, $query);
1001 while ($row = $sth->fetchrow_hashref()) {
1002 $groups->{$row->{id}} = $row;
1006 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1007 $sth = prepare_query($form, $dbh, $query);
1009 foreach $group (values %{$groups}) {
1012 do_statement($form, $sth, $query, $group->{id});
1014 while ($row = $sth->fetchrow_hashref()) {
1015 push @members, $row->{user_id};
1017 $group->{members} = [ uniq @members ];
1021 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1022 $sth = prepare_query($form, $dbh, $query);
1024 foreach $group (values %{$groups}) {
1025 $group->{rights} = {};
1027 do_statement($form, $sth, $query, $group->{id});
1029 while ($row = $sth->fetchrow_hashref()) {
1030 $group->{rights}->{$row->{right}} |= $row->{granted};
1033 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1044 my $form = $main::form;
1045 my $dbh = $self->dbconnect();
1049 my ($query, $sth, $row, $rights);
1051 if (!$group->{id}) {
1052 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1054 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1055 do_query($form, $dbh, $query, $group->{id});
1058 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1060 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1062 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1063 $sth = prepare_query($form, $dbh, $query);
1065 foreach my $user_id (uniq @{ $group->{members} }) {
1066 do_statement($form, $sth, $query, $user_id, $group->{id});
1070 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1072 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1073 $sth = prepare_query($form, $dbh, $query);
1075 foreach my $right (keys %{ $group->{rights} }) {
1076 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1087 my $form = $main::form;
1089 my $dbh = $self->dbconnect();
1092 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1093 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1094 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1099 sub evaluate_rights_ary {
1105 foreach my $el (@{$ary}) {
1106 if (ref $el eq "ARRAY") {
1107 if ($action eq '|') {
1108 $value |= evaluate_rights_ary($el);
1110 $value &= evaluate_rights_ary($el);
1113 } elsif (($el eq '&') || ($el eq '|')) {
1116 } elsif ($action eq '|') {
1128 sub _parse_rights_string {
1137 push @stack, $cur_ary;
1139 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1141 substr($access, 0, length $1) = "";
1143 next if ($token =~ /\s/);
1145 if ($token eq "(") {
1146 my $new_cur_ary = [];
1147 push @stack, $new_cur_ary;
1148 push @{$cur_ary}, $new_cur_ary;
1149 $cur_ary = $new_cur_ary;
1151 } elsif ($token eq ")") {
1158 $cur_ary = $stack[-1];
1160 } elsif (($token eq "|") || ($token eq "&")) {
1161 push @{$cur_ary}, $token;
1164 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1168 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1177 my $default = shift;
1179 $self->{FULL_RIGHTS} ||= { };
1180 $self->{FULL_RIGHTS}->{$login} ||= { };
1182 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1183 $self->{RIGHTS} ||= { };
1184 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1186 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1189 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1190 $granted = $default if (!defined $granted);
1196 my ($self, $right, $dont_abort) = @_;
1198 if ($self->check_right($::myconfig{login}, $right)) {
1203 delete $::form->{title};
1204 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1210 sub load_rights_for_user {
1211 my ($self, $login) = @_;
1212 my $dbh = $self->dbconnect;
1213 my ($query, $sth, $row, $rights);
1215 $rights = { map { $_ => 0 } all_rights() };
1217 return $rights if !$self->client || !$login;
1220 qq|SELECT gr."right", gr.granted
1221 FROM auth.group_rights gr
1224 FROM auth.user_group ug
1225 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1229 FROM auth.clients_groups cg
1230 WHERE cg.client_id = ?)|;
1232 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1234 while ($row = $sth->fetchrow_hashref()) {
1235 $rights->{$row->{right}} |= $row->{granted};
1251 SL::Auth - Authentication and session handling
1257 =item C<set_session_value @values>
1259 =item C<set_session_value %values>
1261 Store all values of C<@values> or C<%values> in the session. Each
1262 member of C<@values> is tested if it is a hash reference. If it is
1263 then it must contain the keys C<key> and C<value> and can optionally
1264 contain the key C<auto_restore>. In this case C<value> is associated
1265 with C<key> and restored to C<$::form> upon the next request
1266 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1269 If the current member of C<@values> is not a hash reference then it
1270 will be used as the C<key> and the next entry of C<@values> is used as
1271 the C<value> to store. In this case setting C<auto_restore> is not
1274 Therefore the following two invocations are identical:
1276 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1277 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1279 All of these values are copied back into C<$::form> for the next
1280 request automatically if they're scalar values or if they have
1281 C<auto_restore> set to trueish.
1283 The values can be any Perl structure. They are stored as YAML dumps.
1285 =item C<get_session_value $key>
1287 Retrieve a value from the session. Returns C<undef> if the value
1290 =item C<create_unique_sesion_value $value, %params>
1292 Create a unique key in the session and store C<$value>
1295 Returns the key created in the session.
1297 =item C<save_session>
1299 Stores the session values in the database. This is the only function
1300 that actually stores stuff in the database. Neither the various
1301 setters nor the deleter access the database.
1303 =item C<save_form_in_session %params>
1305 Stores the content of C<$params{form}> (default: C<$::form>) in the
1306 session using L</create_unique_sesion_value>.
1308 If C<$params{non_scalars}> is trueish then non-scalar values will be
1309 stored as well. Default is to only store scalar values.
1311 The following keys will never be saved: C<login>, C<password>,
1312 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1313 can be given as an array ref in C<$params{skip_keys}>.
1315 Returns the unique key under which the form is stored.
1317 =item C<restore_form_from_session $key, %params>
1319 Restores the form from the session into C<$params{form}> (default:
1322 If C<$params{clobber}> is falsish then existing values with the same
1323 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1330 C<reset> deletes every state information from previous requests, but does not
1331 close the database connection.
1333 Creating a new database handle on each request can take up to 30% of the
1334 pre-request startup time, so we want to avoid that for fast ajax calls.
1344 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>