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 # Set default language if selected language does not exist (anymore).
497 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
501 $main::lxdebug->leave_sub();
507 $main::lxdebug->enter_sub();
512 my $dbh = $self->dbconnect();
513 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
515 $main::lxdebug->leave_sub();
521 $::lxdebug->enter_sub;
526 my $dbh = $self->dbconnect;
527 my $id = $self->get_user_id($login);
530 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
532 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
533 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
535 $u_dbh->begin_work if $u_dbh && $user_db_exists;
539 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
540 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
541 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
542 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
545 $u_dbh->commit if $u_dbh && $user_db_exists;
547 $::lxdebug->leave_sub;
550 # --------------------------------------
554 sub restore_session {
555 $main::lxdebug->enter_sub();
559 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
560 $session_id =~ s|[^0-9a-f]||g if $session_id;
562 $self->{SESSION} = { };
565 $main::lxdebug->leave_sub();
569 my ($dbh, $query, $sth, $cookie, $ref, $form);
573 # Don't fail if the auth DB doesn't yet.
574 if (!( $dbh = $self->dbconnect(1) )) {
575 $::lxdebug->leave_sub;
579 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
580 # admin is creating the session tables at the moment.
581 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
583 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
584 $sth->finish if $sth;
585 $::lxdebug->leave_sub;
589 $cookie = $sth->fetchrow_hashref;
592 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
593 $self->destroy_session();
594 $main::lxdebug->leave_sub();
595 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
598 if ($self->{column_information}->has('auto_restore')) {
599 $self->_load_with_auto_restore_column($dbh, $session_id);
601 $self->_load_without_auto_restore_column($dbh, $session_id);
604 $main::lxdebug->leave_sub();
609 sub _load_without_auto_restore_column {
610 my ($self, $dbh, $session_id) = @_;
613 SELECT sess_key, sess_value
614 FROM auth.session_content
615 WHERE (session_id = ?)
617 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
619 while (my $ref = $sth->fetchrow_hashref) {
620 my $value = SL::Auth::SessionValue->new(auth => $self,
621 key => $ref->{sess_key},
622 value => $ref->{sess_value},
624 $self->{SESSION}->{ $ref->{sess_key} } = $value;
626 next if defined $::form->{$ref->{sess_key}};
628 my $data = $value->get;
629 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
633 sub _load_with_auto_restore_column {
634 my ($self, $dbh, $session_id) = @_;
636 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
639 SELECT sess_key, sess_value, auto_restore
640 FROM auth.session_content
641 WHERE (session_id = ?)
643 OR sess_key IN (${auto_restore_keys}))
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},
651 auto_restore => $ref->{auto_restore},
653 $self->{SESSION}->{ $ref->{sess_key} } = $value;
655 next if defined $::form->{$ref->{sess_key}};
657 my $data = $value->get;
658 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
665 FROM auth.session_content
666 WHERE (session_id = ?)
667 AND NOT COALESCE(auto_restore, FALSE)
668 AND (sess_key NOT IN (${auto_restore_keys}))
670 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
672 while (my $ref = $sth->fetchrow_hashref) {
673 my $value = SL::Auth::SessionValue->new(auth => $self,
674 key => $ref->{sess_key});
675 $self->{SESSION}->{ $ref->{sess_key} } = $value;
679 sub destroy_session {
680 $main::lxdebug->enter_sub();
685 my $dbh = $self->dbconnect();
689 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
690 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
694 SL::SessionFile->destroy_session($session_id);
697 $self->{SESSION} = { };
700 $main::lxdebug->leave_sub();
703 sub expire_sessions {
704 $main::lxdebug->enter_sub();
708 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
710 my $dbh = $self->dbconnect();
712 my $query = qq|SELECT id
714 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
716 my @ids = selectall_array_query($::form, $dbh, $query);
721 SL::SessionFile->destroy_session($_) for @ids;
723 $query = qq|DELETE FROM auth.session_content
724 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
725 do_query($main::form, $dbh, $query, @ids);
727 $query = qq|DELETE FROM auth.session
728 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
729 do_query($main::form, $dbh, $query, @ids);
734 $main::lxdebug->leave_sub();
737 sub _create_session_id {
738 $main::lxdebug->enter_sub();
741 map { push @data, int(rand() * 255); } (1..32);
743 my $id = md5_hex(pack 'C*', @data);
745 $main::lxdebug->leave_sub();
750 sub create_or_refresh_session {
751 $session_id ||= shift->_create_session_id;
755 $::lxdebug->enter_sub;
757 my $provided_dbh = shift;
759 my $dbh = $provided_dbh || $self->dbconnect(1);
761 $::lxdebug->leave_sub && return unless $dbh && $session_id;
763 $dbh->begin_work unless $provided_dbh;
765 # If this fails then the "auth" schema might not exist yet, e.g. if
766 # the admin is just trying to create the auth database.
767 if (!$dbh->do(qq|LOCK auth.session_content|)) {
768 $dbh->rollback unless $provided_dbh;
769 $::lxdebug->leave_sub;
773 my @unfetched_keys = map { $_->{key} }
774 grep { ! $_->{fetched} }
775 values %{ $self->{SESSION} };
776 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
777 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
778 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
779 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
781 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
783 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
786 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
788 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
791 my @values_to_save = grep { $_->{fetched} }
792 values %{ $self->{SESSION} };
793 if (@values_to_save) {
794 my ($columns, $placeholders) = ('', '');
795 my $auto_restore = $self->{column_information}->has('auto_restore');
798 $columns .= ', auto_restore';
799 $placeholders .= ', ?';
802 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
803 my $sth = prepare_query($::form, $dbh, $query);
805 foreach my $value (@values_to_save) {
806 my @values = ($value->{key}, $value->get_dumped);
807 push @values, $value->{auto_restore} if $auto_restore;
809 do_statement($::form, $sth, $query, $session_id, @values);
815 $dbh->commit() unless $provided_dbh;
816 $::lxdebug->leave_sub;
819 sub set_session_value {
820 $main::lxdebug->enter_sub();
825 $self->{SESSION} ||= { };
828 my $key = shift @params;
830 if (ref $key eq 'HASH') {
831 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
832 value => $key->{value},
833 auto_restore => $key->{auto_restore});
836 my $value = shift @params;
837 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
842 $main::lxdebug->leave_sub();
847 sub delete_session_value {
848 $main::lxdebug->enter_sub();
852 $self->{SESSION} ||= { };
853 delete @{ $self->{SESSION} }{ @_ };
855 $main::lxdebug->leave_sub();
860 sub get_session_value {
861 $main::lxdebug->enter_sub();
864 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
866 $main::lxdebug->leave_sub();
871 sub create_unique_sesion_value {
872 my ($self, $value, %params) = @_;
874 $self->{SESSION} ||= { };
876 my @now = gettimeofday();
877 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
878 $self->{unique_counter} ||= 0;
882 $self->{unique_counter}++;
883 $hashed_key = md5_hex($key . $self->{unique_counter});
884 } while (exists $self->{SESSION}->{$hashed_key});
886 $self->set_session_value($hashed_key => $value);
891 sub save_form_in_session {
892 my ($self, %params) = @_;
894 my $form = delete($params{form}) || $::form;
895 my $non_scalars = delete $params{non_scalars};
898 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
900 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
901 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
904 return $self->create_unique_sesion_value($data, %params);
907 sub restore_form_from_session {
908 my ($self, $key, %params) = @_;
910 my $data = $self->get_session_value($key);
911 return $self unless $data;
913 my $form = delete($params{form}) || $::form;
914 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
916 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
921 sub set_cookie_environment_variable {
923 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
926 sub get_session_cookie_name {
929 return $self->{cookie_name} || 'lx_office_erp_session_id';
936 sub session_tables_present {
937 $main::lxdebug->enter_sub();
941 # Only re-check for the presence of auth tables if either the check
942 # hasn't been done before of if they weren't present.
943 if ($self->{session_tables_present}) {
944 $main::lxdebug->leave_sub();
945 return $self->{session_tables_present};
948 my $dbh = $self->dbconnect(1);
951 $main::lxdebug->leave_sub();
958 WHERE (schemaname = 'auth')
959 AND (tablename IN ('session', 'session_content'))|;
961 my ($count) = selectrow_query($main::form, $dbh, $query);
963 $self->{session_tables_present} = 2 == $count;
965 $main::lxdebug->leave_sub();
967 return $self->{session_tables_present};
970 # --------------------------------------
972 sub all_rights_full {
973 my $locale = $main::locale;
976 ["--crm", $locale->text("CRM optional software")],
977 ["crm_search", $locale->text("CRM search")],
978 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
979 ["crm_service", $locale->text("CRM services")],
980 ["crm_admin", $locale->text("CRM admin")],
981 ["crm_adminuser", $locale->text("CRM user")],
982 ["crm_adminstatus", $locale->text("CRM status")],
983 ["crm_email", $locale->text("CRM send email")],
984 ["crm_termin", $locale->text("CRM termin")],
985 ["crm_opportunity", $locale->text("CRM opportunity")],
986 ["crm_knowhow", $locale->text("CRM know how")],
987 ["crm_follow", $locale->text("CRM follow up")],
988 ["crm_notices", $locale->text("CRM notices")],
989 ["crm_other", $locale->text("CRM other")],
990 ["--master_data", $locale->text("Master Data")],
991 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
992 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
993 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
994 ["project_edit", $locale->text("Create and edit projects")],
995 ["--ar", $locale->text("AR")],
996 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
997 ["sales_order_edit", $locale->text("Create and edit sales orders")],
998 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
999 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
1000 ["dunning_edit", $locale->text("Create and edit dunnings")],
1001 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
1002 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
1003 ["--ap", $locale->text("AP")],
1004 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1005 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1006 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1007 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1008 ["--warehouse_management", $locale->text("Warehouse management")],
1009 ["warehouse_contents", $locale->text("View warehouse content")],
1010 ["warehouse_management", $locale->text("Warehouse management")],
1011 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1012 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1013 ["datev_export", $locale->text("DATEV Export")],
1014 ["cash", $locale->text("Receipt, payment, reconciliation")],
1015 ["--reports", $locale->text('Reports')],
1016 ["report", $locale->text('All reports')],
1017 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1018 ["--batch_printing", $locale->text("Batch Printing")],
1019 ["batch_printing", $locale->text("Batch Printing")],
1020 ["--others", $locale->text("Others")],
1021 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1022 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
1023 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1030 return grep !/^--/, map { $_->[0] } all_rights_full();
1034 $main::lxdebug->enter_sub();
1038 my $form = $main::form;
1040 my $dbh = $self->dbconnect();
1042 my $query = 'SELECT * FROM auth."group"';
1043 my $sth = prepare_execute_query($form, $dbh, $query);
1047 while ($row = $sth->fetchrow_hashref()) {
1048 $groups->{$row->{id}} = $row;
1052 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1053 $sth = prepare_query($form, $dbh, $query);
1055 foreach $group (values %{$groups}) {
1058 do_statement($form, $sth, $query, $group->{id});
1060 while ($row = $sth->fetchrow_hashref()) {
1061 push @members, $row->{user_id};
1063 $group->{members} = [ uniq @members ];
1067 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1068 $sth = prepare_query($form, $dbh, $query);
1070 foreach $group (values %{$groups}) {
1071 $group->{rights} = {};
1073 do_statement($form, $sth, $query, $group->{id});
1075 while ($row = $sth->fetchrow_hashref()) {
1076 $group->{rights}->{$row->{right}} |= $row->{granted};
1079 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1083 $main::lxdebug->leave_sub();
1089 $main::lxdebug->enter_sub();
1094 my $form = $main::form;
1095 my $dbh = $self->dbconnect();
1099 my ($query, $sth, $row, $rights);
1101 if (!$group->{id}) {
1102 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1104 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1105 do_query($form, $dbh, $query, $group->{id});
1108 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1110 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1112 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1113 $sth = prepare_query($form, $dbh, $query);
1115 foreach my $user_id (uniq @{ $group->{members} }) {
1116 do_statement($form, $sth, $query, $user_id, $group->{id});
1120 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1122 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1123 $sth = prepare_query($form, $dbh, $query);
1125 foreach my $right (keys %{ $group->{rights} }) {
1126 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1132 $main::lxdebug->leave_sub();
1136 $main::lxdebug->enter_sub();
1141 my $form = $main::form;
1143 my $dbh = $self->dbconnect();
1146 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1147 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1148 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1152 $main::lxdebug->leave_sub();
1155 sub evaluate_rights_ary {
1156 $main::lxdebug->enter_sub(2);
1163 foreach my $el (@{$ary}) {
1164 if (ref $el eq "ARRAY") {
1165 if ($action eq '|') {
1166 $value |= evaluate_rights_ary($el);
1168 $value &= evaluate_rights_ary($el);
1171 } elsif (($el eq '&') || ($el eq '|')) {
1174 } elsif ($action eq '|') {
1183 $main::lxdebug->leave_sub(2);
1188 sub _parse_rights_string {
1189 $main::lxdebug->enter_sub(2);
1199 push @stack, $cur_ary;
1201 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1203 substr($access, 0, length $1) = "";
1205 next if ($token =~ /\s/);
1207 if ($token eq "(") {
1208 my $new_cur_ary = [];
1209 push @stack, $new_cur_ary;
1210 push @{$cur_ary}, $new_cur_ary;
1211 $cur_ary = $new_cur_ary;
1213 } elsif ($token eq ")") {
1217 $main::lxdebug->leave_sub(2);
1221 $cur_ary = $stack[-1];
1223 } elsif (($token eq "|") || ($token eq "&")) {
1224 push @{$cur_ary}, $token;
1227 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1231 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1233 $main::lxdebug->leave_sub(2);
1239 $main::lxdebug->enter_sub(2);
1244 my $default = shift;
1246 $self->{FULL_RIGHTS} ||= { };
1247 $self->{FULL_RIGHTS}->{$login} ||= { };
1249 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1250 $self->{RIGHTS} ||= { };
1251 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1253 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1256 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1257 $granted = $default if (!defined $granted);
1259 $main::lxdebug->leave_sub(2);
1265 $::lxdebug->enter_sub(2);
1266 my ($self, $right, $dont_abort) = @_;
1268 if ($self->check_right($::myconfig{login}, $right)) {
1269 $::lxdebug->leave_sub(2);
1274 delete $::form->{title};
1275 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1278 $::lxdebug->leave_sub(2);
1283 sub load_rights_for_user {
1284 $::lxdebug->enter_sub;
1286 my ($self, $login) = @_;
1287 my $dbh = $self->dbconnect;
1288 my ($query, $sth, $row, $rights);
1290 $rights = { map { $_ => 0 } all_rights() };
1293 qq|SELECT gr."right", gr.granted
1294 FROM auth.group_rights gr
1297 FROM auth.user_group ug
1298 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1299 WHERE u.login = ?)|;
1301 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1303 while ($row = $sth->fetchrow_hashref()) {
1304 $rights->{$row->{right}} |= $row->{granted};
1308 $::lxdebug->leave_sub;
1322 SL::Auth - Authentication and session handling
1328 =item C<set_session_value @values>
1330 =item C<set_session_value %values>
1332 Store all values of C<@values> or C<%values> in the session. Each
1333 member of C<@values> is tested if it is a hash reference. If it is
1334 then it must contain the keys C<key> and C<value> and can optionally
1335 contain the key C<auto_restore>. In this case C<value> is associated
1336 with C<key> and restored to C<$::form> upon the next request
1337 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1340 If the current member of C<@values> is not a hash reference then it
1341 will be used as the C<key> and the next entry of C<@values> is used as
1342 the C<value> to store. In this case setting C<auto_restore> is not
1345 Therefore the following two invocations are identical:
1347 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1348 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1350 All of these values are copied back into C<$::form> for the next
1351 request automatically if they're scalar values or if they have
1352 C<auto_restore> set to trueish.
1354 The values can be any Perl structure. They are stored as YAML dumps.
1356 =item C<get_session_value $key>
1358 Retrieve a value from the session. Returns C<undef> if the value
1361 =item C<create_unique_sesion_value $value, %params>
1363 Create a unique key in the session and store C<$value>
1366 Returns the key created in the session.
1368 =item C<save_session>
1370 Stores the session values in the database. This is the only function
1371 that actually stores stuff in the database. Neither the various
1372 setters nor the deleter access the database.
1374 =item <save_form_in_session %params>
1376 Stores the content of C<$params{form}> (default: C<$::form>) in the
1377 session using L</create_unique_sesion_value>.
1379 If C<$params{non_scalars}> is trueish then non-scalar values will be
1380 stored as well. Default is to only store scalar values.
1382 The following keys will never be saved: C<login>, C<password>,
1383 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1384 can be given as an array ref in C<$params{skip_keys}>.
1386 Returns the unique key under which the form is stored.
1388 =item <restore_form_from_session $key, %params>
1390 Restores the form from the session into C<$params{form}> (default:
1393 If C<$params{clobber}> is falsish then existing values with the same
1394 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1407 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>