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 $main::lxdebug->enter_sub();
42 $self->_read_auth_config();
45 $main::lxdebug->leave_sub();
51 my ($self, %params) = @_;
53 $self->{SESSION} = { };
54 $self->{FULL_RIGHTS} = { };
55 $self->{RIGHTS} = { };
56 $self->{unique_counter} = 0;
57 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
58 $self->{authenticator}->reset;
64 my ($self, $id_or_name) = @_;
68 return undef unless $id_or_name;
70 my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
71 my $dbh = $self->dbconnect;
73 return undef unless $dbh;
75 $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
83 $self->{dbh}->disconnect() if ($self->{dbh});
86 # form isn't loaded yet, so auth needs it's own error.
88 $::lxdebug->show_backtrace();
90 my ($self, @msg) = @_;
91 if ($ENV{HTTP_USER_AGENT}) {
92 print Form->create_http_response(content_type => 'text/html');
93 print "<pre>", join ('<br>', @msg), "</pre>";
95 print STDERR "Error: @msg\n";
100 sub _read_auth_config {
101 $main::lxdebug->enter_sub();
105 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
107 # Prevent password leakage to log files when dumping Auth instances.
108 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
110 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
111 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
113 if ($self->{module} eq 'DB') {
114 $self->{authenticator} = SL::Auth::DB->new($self);
116 } elsif ($self->{module} eq 'LDAP') {
117 $self->{authenticator} = SL::Auth::LDAP->new($self);
120 if (!$self->{authenticator}) {
121 my $locale = Locale->new('en');
122 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
125 my $cfg = $self->{DB_config};
128 my $locale = Locale->new('en');
129 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
132 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
133 my $locale = Locale->new('en');
134 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
137 $self->{authenticator}->verify_config();
139 $self->{session_timeout} *= 1;
140 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
142 $main::lxdebug->leave_sub();
145 sub has_access_to_client {
146 my ($self, $login) = @_;
148 return 0 if !$self->client || !$self->client->{id};
152 FROM auth.clients_users cu
153 LEFT JOIN auth."user" u ON (cu.user_id = u.id)
155 AND (cu.client_id = ?)
158 my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
162 sub authenticate_root {
163 $main::lxdebug->enter_sub();
165 my ($self, $password) = @_;
167 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
168 if (defined $session_root_auth && $session_root_auth == OK) {
169 $::lxdebug->leave_sub;
173 if (!defined $password) {
174 $::lxdebug->leave_sub;
178 $password = SL::Auth::Password->hash(login => 'root', password => $password);
179 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
181 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
182 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
184 $::lxdebug->leave_sub;
189 $main::lxdebug->enter_sub();
191 my ($self, $login, $password) = @_;
193 if (!$self->client || !$self->has_access_to_client($login)) {
194 $::lxdebug->leave_sub;
198 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
199 if (defined $session_auth && $session_auth == OK) {
200 $::lxdebug->leave_sub;
204 if (!defined $password) {
205 $::lxdebug->leave_sub;
209 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
210 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
212 $::lxdebug->leave_sub;
216 sub punish_wrong_login {
217 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
218 sleep $failed_login_penalty if $failed_login_penalty;
221 sub get_stored_password {
222 my ($self, $login) = @_;
224 my $dbh = $self->dbconnect;
226 return undef unless $dbh;
228 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
229 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
231 return $stored_password;
235 $main::lxdebug->enter_sub(2);
238 my $may_fail = shift;
241 $main::lxdebug->leave_sub(2);
245 my $cfg = $self->{DB_config};
246 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
249 $dsn .= ';port=' . $cfg->{port};
252 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
254 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
256 if (!$may_fail && !$self->{dbh}) {
257 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
260 $main::lxdebug->leave_sub(2);
266 $main::lxdebug->enter_sub();
271 $self->{dbh}->disconnect();
275 $main::lxdebug->leave_sub();
279 $main::lxdebug->enter_sub();
281 my ($self, $dbh) = @_;
283 $dbh ||= $self->dbconnect();
284 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
286 my ($count) = $dbh->selectrow_array($query);
288 $main::lxdebug->leave_sub();
294 $main::lxdebug->enter_sub();
298 my $dbh = $self->dbconnect(1);
300 $main::lxdebug->leave_sub();
305 sub create_database {
306 $main::lxdebug->enter_sub();
311 my $cfg = $self->{DB_config};
313 if (!$params{superuser}) {
314 $params{superuser} = $cfg->{user};
315 $params{superuser_password} = $cfg->{password};
318 $params{template} ||= 'template0';
319 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
321 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
324 $dsn .= ';port=' . $cfg->{port};
327 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
329 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
332 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
335 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
337 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
342 my $error = $dbh->errstr();
344 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
345 my ($cluster_encoding) = $dbh->selectrow_array($query);
347 if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
348 $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
353 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
358 $main::lxdebug->leave_sub();
362 $main::lxdebug->enter_sub();
365 my $dbh = $self->dbconnect();
368 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
370 $main::lxdebug->leave_sub();
374 $main::lxdebug->enter_sub();
380 my $form = $main::form;
382 my $dbh = $self->dbconnect();
384 my ($sth, $query, $user_id);
388 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
389 ($user_id) = selectrow_query($form, $dbh, $query, $login);
392 $query = qq|SELECT nextval('auth.user_id_seq')|;
393 ($user_id) = selectrow_query($form, $dbh, $query);
395 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
396 do_query($form, $dbh, $query, $user_id, $login);
399 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
400 do_query($form, $dbh, $query, $user_id);
402 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
403 $sth = prepare_query($form, $dbh, $query);
405 while (my ($cfg_key, $cfg_value) = each %params) {
406 next if ($cfg_key eq 'password');
408 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
413 $main::lxdebug->leave_sub();
416 sub can_change_password {
419 return $self->{authenticator}->can_change_password();
422 sub change_password {
423 $main::lxdebug->enter_sub();
425 my ($self, $login, $new_password) = @_;
427 my $result = $self->{authenticator}->change_password($login, $new_password);
429 $main::lxdebug->leave_sub();
435 $main::lxdebug->enter_sub();
439 my $dbh = $self->dbconnect();
440 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
442 FROM auth."user" AS u
444 LEFT JOIN auth.user_config AS cfg
445 ON (cfg.user_id = u.id)
447 LEFT JOIN auth.session_content AS sc_login
448 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
450 LEFT JOIN auth.session AS s
451 ON (s.id = sc_login.session_id)
453 my $sth = prepare_execute_query($main::form, $dbh, $query);
457 while (my $ref = $sth->fetchrow_hashref()) {
459 $users{$ref->{login}} ||= {
460 'login' => $ref->{login},
462 'last_action' => $ref->{last_action},
464 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
469 $main::lxdebug->leave_sub();
475 $main::lxdebug->enter_sub();
477 my ($self, %params) = @_;
479 my $dbh = $self->dbconnect();
481 my (@where, @values);
482 if ($params{login}) {
483 push @where, 'u.login = ?';
484 push @values, $params{login};
487 push @where, 'u.id = ?';
488 push @values, $params{id};
490 my $where = join ' AND ', '1 = 1', @where;
491 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
492 FROM auth.user_config cfg
493 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
495 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
499 while (my $ref = $sth->fetchrow_hashref()) {
500 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
501 @user_data{qw(id login)} = @{$ref}{qw(id login)};
504 # The XUL/XML & 'CSS new' backed menus have been removed.
505 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
506 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
508 # The 'Win2000.css' stylesheet has been removed.
509 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
511 # Set default language if selected language does not exist (anymore).
512 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
516 $main::lxdebug->leave_sub();
522 $main::lxdebug->enter_sub();
527 my $dbh = $self->dbconnect();
528 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
530 $main::lxdebug->leave_sub();
536 $::lxdebug->enter_sub;
541 my $dbh = $self->dbconnect;
542 my $id = $self->get_user_id($login);
544 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
548 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
549 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
550 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
552 # TODO: SL::Auth::delete_user
553 # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
557 $::lxdebug->leave_sub;
560 # --------------------------------------
564 sub restore_session {
565 $main::lxdebug->enter_sub();
569 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
570 $session_id =~ s|[^0-9a-f]||g if $session_id;
572 $self->{SESSION} = { };
575 $main::lxdebug->leave_sub();
576 return $self->session_restore_result(SESSION_NONE());
579 my ($dbh, $query, $sth, $cookie, $ref, $form);
583 # Don't fail if the auth DB doesn't yet.
584 if (!( $dbh = $self->dbconnect(1) )) {
585 $::lxdebug->leave_sub;
586 return $self->session_restore_result(SESSION_NONE());
589 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
590 # admin is creating the session tables at the moment.
591 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
593 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
594 $sth->finish if $sth;
595 $::lxdebug->leave_sub;
596 return $self->session_restore_result(SESSION_NONE());
599 $cookie = $sth->fetchrow_hashref;
602 # The session ID provided is valid in the following cases:
603 # 1. session ID exists in the database
604 # 2. hasn't expired yet
605 # 3. if form field '{AUTH}api_token' is given: form field must equal database column 'auth.session.api_token' for the session ID
606 # 4. if form field '{AUTH}api_token' is NOT given then: the requestee's IP address must match the stored IP address
607 $self->{api_token} = $cookie->{api_token} if $cookie;
608 my $api_token_cookie = $self->get_api_token_cookie;
609 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
610 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
611 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie;
612 if ($cookie_is_bad) {
613 $self->destroy_session();
614 $main::lxdebug->leave_sub();
615 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
618 if ($self->{column_information}->has('auto_restore')) {
619 $self->_load_with_auto_restore_column($dbh, $session_id);
621 $self->_load_without_auto_restore_column($dbh, $session_id);
624 $main::lxdebug->leave_sub();
626 return $self->session_restore_result(SESSION_OK());
629 sub session_restore_result {
632 $self->{session_restore_result} = $_[0];
634 return $self->{session_restore_result};
637 sub _load_without_auto_restore_column {
638 my ($self, $dbh, $session_id) = @_;
641 SELECT sess_key, sess_value
642 FROM auth.session_content
643 WHERE (session_id = ?)
645 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
647 while (my $ref = $sth->fetchrow_hashref) {
648 my $value = SL::Auth::SessionValue->new(auth => $self,
649 key => $ref->{sess_key},
650 value => $ref->{sess_value},
652 $self->{SESSION}->{ $ref->{sess_key} } = $value;
654 next if defined $::form->{$ref->{sess_key}};
656 my $data = $value->get;
657 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
661 sub _load_with_auto_restore_column {
662 my ($self, $dbh, $session_id) = @_;
664 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
667 SELECT sess_key, sess_value, auto_restore
668 FROM auth.session_content
669 WHERE (session_id = ?)
671 OR sess_key IN (${auto_restore_keys}))
673 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
675 while (my $ref = $sth->fetchrow_hashref) {
676 my $value = SL::Auth::SessionValue->new(auth => $self,
677 key => $ref->{sess_key},
678 value => $ref->{sess_value},
679 auto_restore => $ref->{auto_restore},
681 $self->{SESSION}->{ $ref->{sess_key} } = $value;
683 next if defined $::form->{$ref->{sess_key}};
685 my $data = $value->get;
686 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
693 FROM auth.session_content
694 WHERE (session_id = ?)
695 AND NOT COALESCE(auto_restore, FALSE)
696 AND (sess_key NOT IN (${auto_restore_keys}))
698 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
700 while (my $ref = $sth->fetchrow_hashref) {
701 my $value = SL::Auth::SessionValue->new(auth => $self,
702 key => $ref->{sess_key});
703 $self->{SESSION}->{ $ref->{sess_key} } = $value;
707 sub destroy_session {
708 $main::lxdebug->enter_sub();
713 my $dbh = $self->dbconnect();
717 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
718 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
722 SL::SessionFile->destroy_session($session_id);
725 $self->{SESSION} = { };
728 $main::lxdebug->leave_sub();
731 sub active_session_ids {
733 my $dbh = $self->dbconnect;
735 my $query = qq|SELECT id FROM auth.session|;
737 my @ids = selectall_array_query($::form, $dbh, $query);
742 sub expire_sessions {
743 $main::lxdebug->enter_sub();
747 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
749 my $dbh = $self->dbconnect();
751 my $query = qq|SELECT id
753 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
755 my @ids = selectall_array_query($::form, $dbh, $query);
760 SL::SessionFile->destroy_session($_) for @ids;
762 $query = qq|DELETE FROM auth.session_content
763 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
764 do_query($main::form, $dbh, $query, @ids);
766 $query = qq|DELETE FROM auth.session
767 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
768 do_query($main::form, $dbh, $query, @ids);
773 $main::lxdebug->leave_sub();
776 sub _create_session_id {
777 $main::lxdebug->enter_sub();
780 map { push @data, int(rand() * 255); } (1..32);
782 my $id = md5_hex(pack 'C*', @data);
784 $main::lxdebug->leave_sub();
789 sub create_or_refresh_session {
790 $session_id ||= shift->_create_session_id;
794 $::lxdebug->enter_sub;
796 my $provided_dbh = shift;
798 my $dbh = $provided_dbh || $self->dbconnect(1);
800 $::lxdebug->leave_sub && return unless $dbh && $session_id;
802 $dbh->begin_work unless $provided_dbh;
804 # If this fails then the "auth" schema might not exist yet, e.g. if
805 # the admin is just trying to create the auth database.
806 if (!$dbh->do(qq|LOCK auth.session_content|)) {
807 $dbh->rollback unless $provided_dbh;
808 $::lxdebug->leave_sub;
812 my @unfetched_keys = map { $_->{key} }
813 grep { ! $_->{fetched} }
814 values %{ $self->{SESSION} };
815 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
816 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
817 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
818 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
820 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
822 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
825 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
827 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
830 if ($self->{column_information}->has('api_token', 'session')) {
831 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
832 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
835 my @values_to_save = grep { $_->{fetched} }
836 values %{ $self->{SESSION} };
837 if (@values_to_save) {
838 my ($columns, $placeholders) = ('', '');
839 my $auto_restore = $self->{column_information}->has('auto_restore');
842 $columns .= ', auto_restore';
843 $placeholders .= ', ?';
846 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
847 my $sth = prepare_query($::form, $dbh, $query);
849 foreach my $value (@values_to_save) {
850 my @values = ($value->{key}, $value->get_dumped);
851 push @values, $value->{auto_restore} if $auto_restore;
853 do_statement($::form, $sth, $query, $session_id, @values);
859 $dbh->commit() unless $provided_dbh;
860 $::lxdebug->leave_sub;
863 sub set_session_value {
864 $main::lxdebug->enter_sub();
869 $self->{SESSION} ||= { };
872 my $key = shift @params;
874 if (ref $key eq 'HASH') {
875 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
876 value => $key->{value},
877 auto_restore => $key->{auto_restore});
880 my $value = shift @params;
881 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
886 $main::lxdebug->leave_sub();
891 sub delete_session_value {
892 $main::lxdebug->enter_sub();
896 $self->{SESSION} ||= { };
897 delete @{ $self->{SESSION} }{ @_ };
899 $main::lxdebug->leave_sub();
904 sub get_session_value {
905 $main::lxdebug->enter_sub();
908 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
910 $main::lxdebug->leave_sub();
915 sub create_unique_sesion_value {
916 my ($self, $value, %params) = @_;
918 $self->{SESSION} ||= { };
920 my @now = gettimeofday();
921 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
922 $self->{unique_counter} ||= 0;
926 $self->{unique_counter}++;
927 $hashed_key = md5_hex($key . $self->{unique_counter});
928 } while (exists $self->{SESSION}->{$hashed_key});
930 $self->set_session_value($hashed_key => $value);
935 sub save_form_in_session {
936 my ($self, %params) = @_;
938 my $form = delete($params{form}) || $::form;
939 my $non_scalars = delete $params{non_scalars};
942 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
944 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
945 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
948 return $self->create_unique_sesion_value($data, %params);
951 sub restore_form_from_session {
952 my ($self, $key, %params) = @_;
954 my $data = $self->get_session_value($key);
955 return $self unless $data;
957 my $form = delete($params{form}) || $::form;
958 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
960 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
965 sub set_cookie_environment_variable {
967 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
970 sub get_session_cookie_name {
971 my ($self, %params) = @_;
973 $params{type} ||= 'id';
974 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
975 $name .= '_api_token' if $params{type} eq 'api_token';
984 sub get_api_token_cookie {
987 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
990 sub session_tables_present {
991 $main::lxdebug->enter_sub();
995 # Only re-check for the presence of auth tables if either the check
996 # hasn't been done before of if they weren't present.
997 if ($self->{session_tables_present}) {
998 $main::lxdebug->leave_sub();
999 return $self->{session_tables_present};
1002 my $dbh = $self->dbconnect(1);
1005 $main::lxdebug->leave_sub();
1012 WHERE (schemaname = 'auth')
1013 AND (tablename IN ('session', 'session_content'))|;
1015 my ($count) = selectrow_query($main::form, $dbh, $query);
1017 $self->{session_tables_present} = 2 == $count;
1019 $main::lxdebug->leave_sub();
1021 return $self->{session_tables_present};
1024 # --------------------------------------
1026 sub all_rights_full {
1027 my $locale = $main::locale;
1030 ["--crm", $locale->text("CRM optional software")],
1031 ["crm_search", $locale->text("CRM search")],
1032 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
1033 ["crm_service", $locale->text("CRM services")],
1034 ["crm_admin", $locale->text("CRM admin")],
1035 ["crm_adminuser", $locale->text("CRM user")],
1036 ["crm_adminstatus", $locale->text("CRM status")],
1037 ["crm_email", $locale->text("CRM send email")],
1038 ["crm_termin", $locale->text("CRM termin")],
1039 ["crm_opportunity", $locale->text("CRM opportunity")],
1040 ["crm_knowhow", $locale->text("CRM know how")],
1041 ["crm_follow", $locale->text("CRM follow up")],
1042 ["crm_notices", $locale->text("CRM notices")],
1043 ["crm_other", $locale->text("CRM other")],
1044 ["--master_data", $locale->text("Master Data")],
1045 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
1046 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
1047 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
1048 ["project_edit", $locale->text("Create and edit projects")],
1049 ["--ar", $locale->text("AR")],
1050 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
1051 ["sales_order_edit", $locale->text("Create and edit sales orders")],
1052 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
1053 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
1054 ["dunning_edit", $locale->text("Create and edit dunnings")],
1055 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
1056 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
1057 ["--ap", $locale->text("AP")],
1058 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1059 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1060 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1061 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1062 ["--warehouse_management", $locale->text("Warehouse management")],
1063 ["warehouse_contents", $locale->text("View warehouse content")],
1064 ["warehouse_management", $locale->text("Warehouse management")],
1065 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1066 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1067 ["datev_export", $locale->text("DATEV Export")],
1068 ["cash", $locale->text("Receipt, payment, reconciliation")],
1069 ["--reports", $locale->text('Reports')],
1070 ["report", $locale->text('All reports')],
1071 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1072 ["--batch_printing", $locale->text("Batch Printing")],
1073 ["batch_printing", $locale->text("Batch Printing")],
1074 ["--configuration", $locale->text("Configuration")],
1075 ["config", $locale->text("Change kivitendo installation settings (most entries in the 'System' menu)")],
1076 ["admin", $locale->text("Client administration: configuration, editing templates, task server control, background jobs (remaining entries in the 'System' menu)")],
1077 ["--others", $locale->text("Others")],
1078 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1079 ["productivity", $locale->text("Productivity")],
1080 ["display_admin_link", $locale->text("Show administration link")],
1087 return grep !/^--/, map { $_->[0] } all_rights_full();
1091 $main::lxdebug->enter_sub();
1095 my $form = $main::form;
1097 my $dbh = $self->dbconnect();
1099 my $query = 'SELECT * FROM auth."group"';
1100 my $sth = prepare_execute_query($form, $dbh, $query);
1104 while ($row = $sth->fetchrow_hashref()) {
1105 $groups->{$row->{id}} = $row;
1109 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1110 $sth = prepare_query($form, $dbh, $query);
1112 foreach $group (values %{$groups}) {
1115 do_statement($form, $sth, $query, $group->{id});
1117 while ($row = $sth->fetchrow_hashref()) {
1118 push @members, $row->{user_id};
1120 $group->{members} = [ uniq @members ];
1124 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1125 $sth = prepare_query($form, $dbh, $query);
1127 foreach $group (values %{$groups}) {
1128 $group->{rights} = {};
1130 do_statement($form, $sth, $query, $group->{id});
1132 while ($row = $sth->fetchrow_hashref()) {
1133 $group->{rights}->{$row->{right}} |= $row->{granted};
1136 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1140 $main::lxdebug->leave_sub();
1146 $main::lxdebug->enter_sub();
1151 my $form = $main::form;
1152 my $dbh = $self->dbconnect();
1156 my ($query, $sth, $row, $rights);
1158 if (!$group->{id}) {
1159 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1161 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1162 do_query($form, $dbh, $query, $group->{id});
1165 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1167 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1169 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1170 $sth = prepare_query($form, $dbh, $query);
1172 foreach my $user_id (uniq @{ $group->{members} }) {
1173 do_statement($form, $sth, $query, $user_id, $group->{id});
1177 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1179 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1180 $sth = prepare_query($form, $dbh, $query);
1182 foreach my $right (keys %{ $group->{rights} }) {
1183 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1189 $main::lxdebug->leave_sub();
1193 $main::lxdebug->enter_sub();
1198 my $form = $main::form;
1200 my $dbh = $self->dbconnect();
1203 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1204 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1205 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1209 $main::lxdebug->leave_sub();
1212 sub evaluate_rights_ary {
1213 $main::lxdebug->enter_sub(2);
1220 foreach my $el (@{$ary}) {
1221 if (ref $el eq "ARRAY") {
1222 if ($action eq '|') {
1223 $value |= evaluate_rights_ary($el);
1225 $value &= evaluate_rights_ary($el);
1228 } elsif (($el eq '&') || ($el eq '|')) {
1231 } elsif ($action eq '|') {
1240 $main::lxdebug->leave_sub(2);
1245 sub _parse_rights_string {
1246 $main::lxdebug->enter_sub(2);
1256 push @stack, $cur_ary;
1258 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1260 substr($access, 0, length $1) = "";
1262 next if ($token =~ /\s/);
1264 if ($token eq "(") {
1265 my $new_cur_ary = [];
1266 push @stack, $new_cur_ary;
1267 push @{$cur_ary}, $new_cur_ary;
1268 $cur_ary = $new_cur_ary;
1270 } elsif ($token eq ")") {
1274 $main::lxdebug->leave_sub(2);
1278 $cur_ary = $stack[-1];
1280 } elsif (($token eq "|") || ($token eq "&")) {
1281 push @{$cur_ary}, $token;
1284 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1288 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1290 $main::lxdebug->leave_sub(2);
1296 $main::lxdebug->enter_sub(2);
1301 my $default = shift;
1303 $self->{FULL_RIGHTS} ||= { };
1304 $self->{FULL_RIGHTS}->{$login} ||= { };
1306 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1307 $self->{RIGHTS} ||= { };
1308 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1310 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1313 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1314 $granted = $default if (!defined $granted);
1316 $main::lxdebug->leave_sub(2);
1322 $::lxdebug->enter_sub(2);
1323 my ($self, $right, $dont_abort) = @_;
1325 if ($self->check_right($::myconfig{login}, $right)) {
1326 $::lxdebug->leave_sub(2);
1331 delete $::form->{title};
1332 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1335 $::lxdebug->leave_sub(2);
1340 sub load_rights_for_user {
1341 $::lxdebug->enter_sub;
1343 my ($self, $login) = @_;
1344 my $dbh = $self->dbconnect;
1345 my ($query, $sth, $row, $rights);
1347 $rights = { map { $_ => 0 } all_rights() };
1350 qq|SELECT gr."right", gr.granted
1351 FROM auth.group_rights gr
1354 FROM auth.user_group ug
1355 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1359 FROM auth.clients_groups cg
1360 WHERE cg.client_id = ?)|;
1362 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1364 while ($row = $sth->fetchrow_hashref()) {
1365 $rights->{$row->{right}} |= $row->{granted};
1369 $::lxdebug->leave_sub;
1383 SL::Auth - Authentication and session handling
1389 =item C<set_session_value @values>
1391 =item C<set_session_value %values>
1393 Store all values of C<@values> or C<%values> in the session. Each
1394 member of C<@values> is tested if it is a hash reference. If it is
1395 then it must contain the keys C<key> and C<value> and can optionally
1396 contain the key C<auto_restore>. In this case C<value> is associated
1397 with C<key> and restored to C<$::form> upon the next request
1398 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1401 If the current member of C<@values> is not a hash reference then it
1402 will be used as the C<key> and the next entry of C<@values> is used as
1403 the C<value> to store. In this case setting C<auto_restore> is not
1406 Therefore the following two invocations are identical:
1408 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1409 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1411 All of these values are copied back into C<$::form> for the next
1412 request automatically if they're scalar values or if they have
1413 C<auto_restore> set to trueish.
1415 The values can be any Perl structure. They are stored as YAML dumps.
1417 =item C<get_session_value $key>
1419 Retrieve a value from the session. Returns C<undef> if the value
1422 =item C<create_unique_sesion_value $value, %params>
1424 Create a unique key in the session and store C<$value>
1427 Returns the key created in the session.
1429 =item C<save_session>
1431 Stores the session values in the database. This is the only function
1432 that actually stores stuff in the database. Neither the various
1433 setters nor the deleter access the database.
1435 =item <save_form_in_session %params>
1437 Stores the content of C<$params{form}> (default: C<$::form>) in the
1438 session using L</create_unique_sesion_value>.
1440 If C<$params{non_scalars}> is trueish then non-scalar values will be
1441 stored as well. Default is to only store scalar values.
1443 The following keys will never be saved: C<login>, C<password>,
1444 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1445 can be given as an array ref in C<$params{skip_keys}>.
1447 Returns the unique key under which the form is stored.
1449 =item <restore_form_from_session $key, %params>
1451 Restores the form from the session into C<$params{form}> (default:
1454 If C<$params{clobber}> is falsish then existing values with the same
1455 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1468 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>