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';
30 $main::lxdebug->enter_sub();
37 $self->_read_auth_config();
40 $main::lxdebug->leave_sub();
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;
57 my ($self, $login, %params) = @_;
58 my $may_fail = delete $params{may_fail};
60 my %user = $self->read_user(login => $login);
61 my $dbh = SL::DBConnect->connect(
66 pg_enable_utf8 => $::locale->is_utf8,
71 if (!$may_fail && !$dbh) {
72 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
75 if ($user{dboptions} && $dbh) {
76 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
85 $self->{dbh}->disconnect() if ($self->{dbh});
88 # form isn't loaded yet, so auth needs it's own error.
90 $::lxdebug->show_backtrace();
92 my ($self, @msg) = @_;
93 if ($ENV{HTTP_USER_AGENT}) {
94 print Form->create_http_response(content_type => 'text/html');
95 print "<pre>", join ('<br>', @msg), "</pre>";
97 print STDERR "Error: @msg\n";
102 sub _read_auth_config {
103 $main::lxdebug->enter_sub();
107 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
109 # Prevent password leakage to log files when dumping Auth instances.
110 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
112 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
113 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
115 if ($self->{module} eq 'DB') {
116 $self->{authenticator} = SL::Auth::DB->new($self);
118 } elsif ($self->{module} eq 'LDAP') {
119 $self->{authenticator} = SL::Auth::LDAP->new($self);
122 if (!$self->{authenticator}) {
123 my $locale = Locale->new('en');
124 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
127 my $cfg = $self->{DB_config};
130 my $locale = Locale->new('en');
131 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
134 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
135 my $locale = Locale->new('en');
136 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
139 $self->{authenticator}->verify_config();
141 $self->{session_timeout} *= 1;
142 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
144 $main::lxdebug->leave_sub();
147 sub authenticate_root {
148 $main::lxdebug->enter_sub();
150 my ($self, $password) = @_;
152 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
153 if (defined $session_root_auth && $session_root_auth == OK) {
154 $::lxdebug->leave_sub;
158 if (!defined $password) {
159 $::lxdebug->leave_sub;
163 $password = SL::Auth::Password->hash(login => 'root', password => $password);
164 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
166 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
167 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
169 $::lxdebug->leave_sub;
174 $main::lxdebug->enter_sub();
176 my ($self, $login, $password) = @_;
178 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
179 if (defined $session_auth && $session_auth == OK) {
180 $::lxdebug->leave_sub;
184 if (!defined $password) {
185 $::lxdebug->leave_sub;
189 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
190 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login);
192 $::lxdebug->leave_sub;
196 sub punish_wrong_login {
197 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
198 sleep $failed_login_penalty if $failed_login_penalty;
201 sub get_stored_password {
202 my ($self, $login) = @_;
204 my $dbh = $self->dbconnect;
206 return undef unless $dbh;
208 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
209 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
211 return $stored_password;
215 $main::lxdebug->enter_sub(2);
218 my $may_fail = shift;
221 $main::lxdebug->leave_sub(2);
225 my $cfg = $self->{DB_config};
226 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
229 $dsn .= ';port=' . $cfg->{port};
232 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
234 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
236 if (!$may_fail && !$self->{dbh}) {
237 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
240 $main::lxdebug->leave_sub(2);
246 $main::lxdebug->enter_sub();
251 $self->{dbh}->disconnect();
255 $main::lxdebug->leave_sub();
259 $main::lxdebug->enter_sub();
261 my ($self, $dbh) = @_;
263 $dbh ||= $self->dbconnect();
264 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
266 my ($count) = $dbh->selectrow_array($query);
268 $main::lxdebug->leave_sub();
274 $main::lxdebug->enter_sub();
278 my $dbh = $self->dbconnect(1);
280 $main::lxdebug->leave_sub();
285 sub create_database {
286 $main::lxdebug->enter_sub();
291 my $cfg = $self->{DB_config};
293 if (!$params{superuser}) {
294 $params{superuser} = $cfg->{user};
295 $params{superuser_password} = $cfg->{password};
298 $params{template} ||= 'template0';
299 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
301 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
304 $dsn .= ';port=' . $cfg->{port};
307 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
309 my $charset = $::lx_office_conf{system}->{dbcharset};
310 $charset ||= Common::DEFAULT_CHARSET;
311 my $encoding = $Common::charset_to_db_encoding{$charset};
312 $encoding ||= 'UNICODE';
314 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
317 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
320 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
322 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
327 my $error = $dbh->errstr();
329 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
330 my ($cluster_encoding) = $dbh->selectrow_array($query);
332 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
333 $error = $main::locale->text('Your PostgreSQL installationen uses UTF-8 as its encoding. Therefore you have to configure Lx-Office to use UTF-8 as well.');
338 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
343 $main::lxdebug->leave_sub();
347 $main::lxdebug->enter_sub();
350 my $dbh = $self->dbconnect();
352 my $charset = $::lx_office_conf{system}->{dbcharset};
353 $charset ||= Common::DEFAULT_CHARSET;
356 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
358 $main::lxdebug->leave_sub();
362 $main::lxdebug->enter_sub();
368 my $form = $main::form;
370 my $dbh = $self->dbconnect();
372 my ($sth, $query, $user_id);
376 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
377 ($user_id) = selectrow_query($form, $dbh, $query, $login);
380 $query = qq|SELECT nextval('auth.user_id_seq')|;
381 ($user_id) = selectrow_query($form, $dbh, $query);
383 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
384 do_query($form, $dbh, $query, $user_id, $login);
387 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
388 do_query($form, $dbh, $query, $user_id);
390 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
391 $sth = prepare_query($form, $dbh, $query);
393 while (my ($cfg_key, $cfg_value) = each %params) {
394 next if ($cfg_key eq 'password');
396 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
401 $main::lxdebug->leave_sub();
404 sub can_change_password {
407 return $self->{authenticator}->can_change_password();
410 sub change_password {
411 $main::lxdebug->enter_sub();
413 my ($self, $login, $new_password) = @_;
415 my $result = $self->{authenticator}->change_password($login, $new_password);
417 $main::lxdebug->leave_sub();
423 $main::lxdebug->enter_sub();
427 my $dbh = $self->dbconnect();
428 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
430 FROM auth."user" AS u
432 LEFT JOIN auth.user_config AS cfg
433 ON (cfg.user_id = u.id)
435 LEFT JOIN auth.session_content AS sc_login
436 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
438 LEFT JOIN auth.session AS s
439 ON (s.id = sc_login.session_id)
441 my $sth = prepare_execute_query($main::form, $dbh, $query);
445 while (my $ref = $sth->fetchrow_hashref()) {
447 $users{$ref->{login}} ||= {
448 'login' => $ref->{login},
450 'last_action' => $ref->{last_action},
452 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
457 $main::lxdebug->leave_sub();
463 $main::lxdebug->enter_sub();
465 my ($self, %params) = @_;
467 my $dbh = $self->dbconnect();
469 my (@where, @values);
470 if ($params{login}) {
471 push @where, 'u.login = ?';
472 push @values, $params{login};
475 push @where, 'u.id = ?';
476 push @values, $params{id};
478 my $where = join ' AND ', '1 = 1', @where;
479 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
480 FROM auth.user_config cfg
481 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
483 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
487 while (my $ref = $sth->fetchrow_hashref()) {
488 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
489 @user_data{qw(id login)} = @{$ref}{qw(id login)};
492 # The XUL/XML & 'CSS new' backed menus have been removed.
493 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
494 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
496 # The 'Win2000.css' stylesheet has been removed.
497 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
499 # Set default language if selected language does not exist (anymore).
500 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
504 $main::lxdebug->leave_sub();
510 $main::lxdebug->enter_sub();
515 my $dbh = $self->dbconnect();
516 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
518 $main::lxdebug->leave_sub();
524 $::lxdebug->enter_sub;
529 my $dbh = $self->dbconnect;
530 my $id = $self->get_user_id($login);
533 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
535 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
536 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
538 $u_dbh->begin_work if $u_dbh && $user_db_exists;
542 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
543 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
544 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
545 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
548 $u_dbh->commit if $u_dbh && $user_db_exists;
550 $::lxdebug->leave_sub;
553 # --------------------------------------
557 sub restore_session {
558 $main::lxdebug->enter_sub();
562 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
563 $session_id =~ s|[^0-9a-f]||g if $session_id;
565 $self->{SESSION} = { };
568 $main::lxdebug->leave_sub();
572 my ($dbh, $query, $sth, $cookie, $ref, $form);
576 # Don't fail if the auth DB doesn't yet.
577 if (!( $dbh = $self->dbconnect(1) )) {
578 $::lxdebug->leave_sub;
582 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
583 # admin is creating the session tables at the moment.
584 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
586 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
587 $sth->finish if $sth;
588 $::lxdebug->leave_sub;
592 $cookie = $sth->fetchrow_hashref;
595 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
596 $self->destroy_session();
597 $main::lxdebug->leave_sub();
598 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
601 if ($self->{column_information}->has('auto_restore')) {
602 $self->_load_with_auto_restore_column($dbh, $session_id);
604 $self->_load_without_auto_restore_column($dbh, $session_id);
607 $main::lxdebug->leave_sub();
612 sub _load_without_auto_restore_column {
613 my ($self, $dbh, $session_id) = @_;
616 SELECT sess_key, sess_value
617 FROM auth.session_content
618 WHERE (session_id = ?)
620 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
622 while (my $ref = $sth->fetchrow_hashref) {
623 my $value = SL::Auth::SessionValue->new(auth => $self,
624 key => $ref->{sess_key},
625 value => $ref->{sess_value},
627 $self->{SESSION}->{ $ref->{sess_key} } = $value;
629 next if defined $::form->{$ref->{sess_key}};
631 my $data = $value->get;
632 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
636 sub _load_with_auto_restore_column {
637 my ($self, $dbh, $session_id) = @_;
639 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
642 SELECT sess_key, sess_value, auto_restore
643 FROM auth.session_content
644 WHERE (session_id = ?)
646 OR sess_key IN (${auto_restore_keys}))
648 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
650 while (my $ref = $sth->fetchrow_hashref) {
651 my $value = SL::Auth::SessionValue->new(auth => $self,
652 key => $ref->{sess_key},
653 value => $ref->{sess_value},
654 auto_restore => $ref->{auto_restore},
656 $self->{SESSION}->{ $ref->{sess_key} } = $value;
658 next if defined $::form->{$ref->{sess_key}};
660 my $data = $value->get;
661 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
668 FROM auth.session_content
669 WHERE (session_id = ?)
670 AND NOT COALESCE(auto_restore, FALSE)
671 AND (sess_key NOT IN (${auto_restore_keys}))
673 $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 $self->{SESSION}->{ $ref->{sess_key} } = $value;
682 sub destroy_session {
683 $main::lxdebug->enter_sub();
688 my $dbh = $self->dbconnect();
692 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
693 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
697 SL::SessionFile->destroy_session($session_id);
700 $self->{SESSION} = { };
703 $main::lxdebug->leave_sub();
706 sub expire_sessions {
707 $main::lxdebug->enter_sub();
711 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
713 my $dbh = $self->dbconnect();
715 my $query = qq|SELECT id
717 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
719 my @ids = selectall_array_query($::form, $dbh, $query);
724 SL::SessionFile->destroy_session($_) for @ids;
726 $query = qq|DELETE FROM auth.session_content
727 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
728 do_query($main::form, $dbh, $query, @ids);
730 $query = qq|DELETE FROM auth.session
731 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
732 do_query($main::form, $dbh, $query, @ids);
737 $main::lxdebug->leave_sub();
740 sub _create_session_id {
741 $main::lxdebug->enter_sub();
744 map { push @data, int(rand() * 255); } (1..32);
746 my $id = md5_hex(pack 'C*', @data);
748 $main::lxdebug->leave_sub();
753 sub create_or_refresh_session {
754 $session_id ||= shift->_create_session_id;
758 $::lxdebug->enter_sub;
760 my $provided_dbh = shift;
762 my $dbh = $provided_dbh || $self->dbconnect(1);
764 $::lxdebug->leave_sub && return unless $dbh && $session_id;
766 $dbh->begin_work unless $provided_dbh;
768 # If this fails then the "auth" schema might not exist yet, e.g. if
769 # the admin is just trying to create the auth database.
770 if (!$dbh->do(qq|LOCK auth.session_content|)) {
771 $dbh->rollback unless $provided_dbh;
772 $::lxdebug->leave_sub;
776 my @unfetched_keys = map { $_->{key} }
777 grep { ! $_->{fetched} }
778 values %{ $self->{SESSION} };
779 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
780 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
781 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
782 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
784 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
786 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
789 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
791 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
794 my @values_to_save = grep { $_->{fetched} }
795 values %{ $self->{SESSION} };
796 if (@values_to_save) {
797 my ($columns, $placeholders) = ('', '');
798 my $auto_restore = $self->{column_information}->has('auto_restore');
801 $columns .= ', auto_restore';
802 $placeholders .= ', ?';
805 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
806 my $sth = prepare_query($::form, $dbh, $query);
808 foreach my $value (@values_to_save) {
809 my @values = ($value->{key}, $value->get_dumped);
810 push @values, $value->{auto_restore} if $auto_restore;
812 do_statement($::form, $sth, $query, $session_id, @values);
818 $dbh->commit() unless $provided_dbh;
819 $::lxdebug->leave_sub;
822 sub set_session_value {
823 $main::lxdebug->enter_sub();
828 $self->{SESSION} ||= { };
831 my $key = shift @params;
833 if (ref $key eq 'HASH') {
834 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
835 value => $key->{value},
836 auto_restore => $key->{auto_restore});
839 my $value = shift @params;
840 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
845 $main::lxdebug->leave_sub();
850 sub delete_session_value {
851 $main::lxdebug->enter_sub();
855 $self->{SESSION} ||= { };
856 delete @{ $self->{SESSION} }{ @_ };
858 $main::lxdebug->leave_sub();
863 sub get_session_value {
864 $main::lxdebug->enter_sub();
867 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
869 $main::lxdebug->leave_sub();
874 sub create_unique_sesion_value {
875 my ($self, $value, %params) = @_;
877 $self->{SESSION} ||= { };
879 my @now = gettimeofday();
880 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
881 $self->{unique_counter} ||= 0;
885 $self->{unique_counter}++;
886 $hashed_key = md5_hex($key . $self->{unique_counter});
887 } while (exists $self->{SESSION}->{$hashed_key});
889 $self->set_session_value($hashed_key => $value);
894 sub save_form_in_session {
895 my ($self, %params) = @_;
897 my $form = delete($params{form}) || $::form;
898 my $non_scalars = delete $params{non_scalars};
901 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
903 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
904 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
907 return $self->create_unique_sesion_value($data, %params);
910 sub restore_form_from_session {
911 my ($self, $key, %params) = @_;
913 my $data = $self->get_session_value($key);
914 return $self unless $data;
916 my $form = delete($params{form}) || $::form;
917 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
919 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
924 sub set_cookie_environment_variable {
926 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
929 sub get_session_cookie_name {
932 return $self->{cookie_name} || 'lx_office_erp_session_id';
939 sub session_tables_present {
940 $main::lxdebug->enter_sub();
944 # Only re-check for the presence of auth tables if either the check
945 # hasn't been done before of if they weren't present.
946 if ($self->{session_tables_present}) {
947 $main::lxdebug->leave_sub();
948 return $self->{session_tables_present};
951 my $dbh = $self->dbconnect(1);
954 $main::lxdebug->leave_sub();
961 WHERE (schemaname = 'auth')
962 AND (tablename IN ('session', 'session_content'))|;
964 my ($count) = selectrow_query($main::form, $dbh, $query);
966 $self->{session_tables_present} = 2 == $count;
968 $main::lxdebug->leave_sub();
970 return $self->{session_tables_present};
973 # --------------------------------------
975 sub all_rights_full {
976 my $locale = $main::locale;
979 ["--crm", $locale->text("CRM optional software")],
980 ["crm_search", $locale->text("CRM search")],
981 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
982 ["crm_service", $locale->text("CRM services")],
983 ["crm_admin", $locale->text("CRM admin")],
984 ["crm_adminuser", $locale->text("CRM user")],
985 ["crm_adminstatus", $locale->text("CRM status")],
986 ["crm_email", $locale->text("CRM send email")],
987 ["crm_termin", $locale->text("CRM termin")],
988 ["crm_opportunity", $locale->text("CRM opportunity")],
989 ["crm_knowhow", $locale->text("CRM know how")],
990 ["crm_follow", $locale->text("CRM follow up")],
991 ["crm_notices", $locale->text("CRM notices")],
992 ["crm_other", $locale->text("CRM other")],
993 ["--master_data", $locale->text("Master Data")],
994 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
995 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
996 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
997 ["project_edit", $locale->text("Create and edit projects")],
998 ["--ar", $locale->text("AR")],
999 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
1000 ["sales_order_edit", $locale->text("Create and edit sales orders")],
1001 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
1002 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
1003 ["dunning_edit", $locale->text("Create and edit dunnings")],
1004 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
1005 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
1006 ["--ap", $locale->text("AP")],
1007 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1008 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1009 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1010 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1011 ["--warehouse_management", $locale->text("Warehouse management")],
1012 ["warehouse_contents", $locale->text("View warehouse content")],
1013 ["warehouse_management", $locale->text("Warehouse management")],
1014 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1015 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1016 ["datev_export", $locale->text("DATEV Export")],
1017 ["cash", $locale->text("Receipt, payment, reconciliation")],
1018 ["--reports", $locale->text('Reports')],
1019 ["report", $locale->text('All reports')],
1020 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1021 ["--batch_printing", $locale->text("Batch Printing")],
1022 ["batch_printing", $locale->text("Batch Printing")],
1023 ["--others", $locale->text("Others")],
1024 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1025 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
1026 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1033 return grep !/^--/, map { $_->[0] } all_rights_full();
1037 $main::lxdebug->enter_sub();
1041 my $form = $main::form;
1043 my $dbh = $self->dbconnect();
1045 my $query = 'SELECT * FROM auth."group"';
1046 my $sth = prepare_execute_query($form, $dbh, $query);
1050 while ($row = $sth->fetchrow_hashref()) {
1051 $groups->{$row->{id}} = $row;
1055 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1056 $sth = prepare_query($form, $dbh, $query);
1058 foreach $group (values %{$groups}) {
1061 do_statement($form, $sth, $query, $group->{id});
1063 while ($row = $sth->fetchrow_hashref()) {
1064 push @members, $row->{user_id};
1066 $group->{members} = [ uniq @members ];
1070 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1071 $sth = prepare_query($form, $dbh, $query);
1073 foreach $group (values %{$groups}) {
1074 $group->{rights} = {};
1076 do_statement($form, $sth, $query, $group->{id});
1078 while ($row = $sth->fetchrow_hashref()) {
1079 $group->{rights}->{$row->{right}} |= $row->{granted};
1082 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1086 $main::lxdebug->leave_sub();
1092 $main::lxdebug->enter_sub();
1097 my $form = $main::form;
1098 my $dbh = $self->dbconnect();
1102 my ($query, $sth, $row, $rights);
1104 if (!$group->{id}) {
1105 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1107 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1108 do_query($form, $dbh, $query, $group->{id});
1111 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1113 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1115 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1116 $sth = prepare_query($form, $dbh, $query);
1118 foreach my $user_id (uniq @{ $group->{members} }) {
1119 do_statement($form, $sth, $query, $user_id, $group->{id});
1123 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1125 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1126 $sth = prepare_query($form, $dbh, $query);
1128 foreach my $right (keys %{ $group->{rights} }) {
1129 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1135 $main::lxdebug->leave_sub();
1139 $main::lxdebug->enter_sub();
1144 my $form = $main::form;
1146 my $dbh = $self->dbconnect();
1149 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1150 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1151 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1155 $main::lxdebug->leave_sub();
1158 sub evaluate_rights_ary {
1159 $main::lxdebug->enter_sub(2);
1166 foreach my $el (@{$ary}) {
1167 if (ref $el eq "ARRAY") {
1168 if ($action eq '|') {
1169 $value |= evaluate_rights_ary($el);
1171 $value &= evaluate_rights_ary($el);
1174 } elsif (($el eq '&') || ($el eq '|')) {
1177 } elsif ($action eq '|') {
1186 $main::lxdebug->leave_sub(2);
1191 sub _parse_rights_string {
1192 $main::lxdebug->enter_sub(2);
1202 push @stack, $cur_ary;
1204 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1206 substr($access, 0, length $1) = "";
1208 next if ($token =~ /\s/);
1210 if ($token eq "(") {
1211 my $new_cur_ary = [];
1212 push @stack, $new_cur_ary;
1213 push @{$cur_ary}, $new_cur_ary;
1214 $cur_ary = $new_cur_ary;
1216 } elsif ($token eq ")") {
1220 $main::lxdebug->leave_sub(2);
1224 $cur_ary = $stack[-1];
1226 } elsif (($token eq "|") || ($token eq "&")) {
1227 push @{$cur_ary}, $token;
1230 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1234 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1236 $main::lxdebug->leave_sub(2);
1242 $main::lxdebug->enter_sub(2);
1247 my $default = shift;
1249 $self->{FULL_RIGHTS} ||= { };
1250 $self->{FULL_RIGHTS}->{$login} ||= { };
1252 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1253 $self->{RIGHTS} ||= { };
1254 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1256 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1259 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1260 $granted = $default if (!defined $granted);
1262 $main::lxdebug->leave_sub(2);
1268 $::lxdebug->enter_sub(2);
1269 my ($self, $right, $dont_abort) = @_;
1271 if ($self->check_right($::myconfig{login}, $right)) {
1272 $::lxdebug->leave_sub(2);
1277 delete $::form->{title};
1278 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1281 $::lxdebug->leave_sub(2);
1286 sub load_rights_for_user {
1287 $::lxdebug->enter_sub;
1289 my ($self, $login) = @_;
1290 my $dbh = $self->dbconnect;
1291 my ($query, $sth, $row, $rights);
1293 $rights = { map { $_ => 0 } all_rights() };
1296 qq|SELECT gr."right", gr.granted
1297 FROM auth.group_rights gr
1300 FROM auth.user_group ug
1301 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1302 WHERE u.login = ?)|;
1304 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1306 while ($row = $sth->fetchrow_hashref()) {
1307 $rights->{$row->{right}} |= $row->{granted};
1311 $::lxdebug->leave_sub;
1325 SL::Auth - Authentication and session handling
1331 =item C<set_session_value @values>
1333 =item C<set_session_value %values>
1335 Store all values of C<@values> or C<%values> in the session. Each
1336 member of C<@values> is tested if it is a hash reference. If it is
1337 then it must contain the keys C<key> and C<value> and can optionally
1338 contain the key C<auto_restore>. In this case C<value> is associated
1339 with C<key> and restored to C<$::form> upon the next request
1340 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1343 If the current member of C<@values> is not a hash reference then it
1344 will be used as the C<key> and the next entry of C<@values> is used as
1345 the C<value> to store. In this case setting C<auto_restore> is not
1348 Therefore the following two invocations are identical:
1350 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1351 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1353 All of these values are copied back into C<$::form> for the next
1354 request automatically if they're scalar values or if they have
1355 C<auto_restore> set to trueish.
1357 The values can be any Perl structure. They are stored as YAML dumps.
1359 =item C<get_session_value $key>
1361 Retrieve a value from the session. Returns C<undef> if the value
1364 =item C<create_unique_sesion_value $value, %params>
1366 Create a unique key in the session and store C<$value>
1369 Returns the key created in the session.
1371 =item C<save_session>
1373 Stores the session values in the database. This is the only function
1374 that actually stores stuff in the database. Neither the various
1375 setters nor the deleter access the database.
1377 =item <save_form_in_session %params>
1379 Stores the content of C<$params{form}> (default: C<$::form>) in the
1380 session using L</create_unique_sesion_value>.
1382 If C<$params{non_scalars}> is trueish then non-scalar values will be
1383 stored as well. Default is to only store scalar values.
1385 The following keys will never be saved: C<login>, C<password>,
1386 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1387 can be given as an array ref in C<$params{skip_keys}>.
1389 Returns the unique key under which the form is stored.
1391 =item <restore_form_from_session $key, %params>
1393 Restores the form from the session into C<$params{form}> (default:
1396 If C<$params{clobber}> is falsish then existing values with the same
1397 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1410 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>