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 backed menu has been removed.
493 $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
497 $main::lxdebug->leave_sub();
503 $main::lxdebug->enter_sub();
508 my $dbh = $self->dbconnect();
509 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
511 $main::lxdebug->leave_sub();
517 $::lxdebug->enter_sub;
522 my $dbh = $self->dbconnect;
523 my $id = $self->get_user_id($login);
526 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
528 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
529 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
531 $u_dbh->begin_work if $u_dbh && $user_db_exists;
535 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
536 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
537 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
538 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
541 $u_dbh->commit if $u_dbh && $user_db_exists;
543 $::lxdebug->leave_sub;
546 # --------------------------------------
550 sub restore_session {
551 $main::lxdebug->enter_sub();
555 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
556 $session_id =~ s|[^0-9a-f]||g if $session_id;
558 $self->{SESSION} = { };
561 $main::lxdebug->leave_sub();
565 my ($dbh, $query, $sth, $cookie, $ref, $form);
569 # Don't fail if the auth DB doesn't yet.
570 if (!( $dbh = $self->dbconnect(1) )) {
571 $::lxdebug->leave_sub;
575 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
576 # admin is creating the session tables at the moment.
577 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
579 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
580 $sth->finish if $sth;
581 $::lxdebug->leave_sub;
585 $cookie = $sth->fetchrow_hashref;
588 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
589 $self->destroy_session();
590 $main::lxdebug->leave_sub();
591 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
594 if ($self->{column_information}->has('auto_restore')) {
595 $self->_load_with_auto_restore_column($dbh, $session_id);
597 $self->_load_without_auto_restore_column($dbh, $session_id);
600 $main::lxdebug->leave_sub();
605 sub _load_without_auto_restore_column {
606 my ($self, $dbh, $session_id) = @_;
609 SELECT sess_key, sess_value
610 FROM auth.session_content
611 WHERE (session_id = ?)
613 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
615 while (my $ref = $sth->fetchrow_hashref) {
616 my $value = SL::Auth::SessionValue->new(auth => $self,
617 key => $ref->{sess_key},
618 value => $ref->{sess_value},
620 $self->{SESSION}->{ $ref->{sess_key} } = $value;
622 next if defined $::form->{$ref->{sess_key}};
624 my $data = $value->get;
625 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
629 sub _load_with_auto_restore_column {
630 my ($self, $dbh, $session_id) = @_;
632 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
635 SELECT sess_key, sess_value, auto_restore
636 FROM auth.session_content
637 WHERE (session_id = ?)
639 OR sess_key IN (${auto_restore_keys}))
641 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
643 while (my $ref = $sth->fetchrow_hashref) {
644 my $value = SL::Auth::SessionValue->new(auth => $self,
645 key => $ref->{sess_key},
646 value => $ref->{sess_value},
647 auto_restore => $ref->{auto_restore},
649 $self->{SESSION}->{ $ref->{sess_key} } = $value;
651 next if defined $::form->{$ref->{sess_key}};
653 my $data = $value->get;
654 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
661 FROM auth.session_content
662 WHERE (session_id = ?)
663 AND NOT COALESCE(auto_restore, FALSE)
664 AND (sess_key NOT IN (${auto_restore_keys}))
666 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
668 while (my $ref = $sth->fetchrow_hashref) {
669 my $value = SL::Auth::SessionValue->new(auth => $self,
670 key => $ref->{sess_key});
671 $self->{SESSION}->{ $ref->{sess_key} } = $value;
675 sub destroy_session {
676 $main::lxdebug->enter_sub();
681 my $dbh = $self->dbconnect();
685 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
686 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
690 SL::SessionFile->destroy_session($session_id);
693 $self->{SESSION} = { };
696 $main::lxdebug->leave_sub();
699 sub expire_sessions {
700 $main::lxdebug->enter_sub();
704 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
706 my $dbh = $self->dbconnect();
708 my $query = qq|SELECT id
710 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
712 my @ids = selectall_array_query($::form, $dbh, $query);
717 SL::SessionFile->destroy_session($_) for @ids;
719 $query = qq|DELETE FROM auth.session_content
720 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
721 do_query($main::form, $dbh, $query, @ids);
723 $query = qq|DELETE FROM auth.session
724 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
725 do_query($main::form, $dbh, $query, @ids);
730 $main::lxdebug->leave_sub();
733 sub _create_session_id {
734 $main::lxdebug->enter_sub();
737 map { push @data, int(rand() * 255); } (1..32);
739 my $id = md5_hex(pack 'C*', @data);
741 $main::lxdebug->leave_sub();
746 sub create_or_refresh_session {
747 $session_id ||= shift->_create_session_id;
751 $::lxdebug->enter_sub;
753 my $provided_dbh = shift;
755 my $dbh = $provided_dbh || $self->dbconnect(1);
757 $::lxdebug->leave_sub && return unless $dbh && $session_id;
759 $dbh->begin_work unless $provided_dbh;
761 # If this fails then the "auth" schema might not exist yet, e.g. if
762 # the admin is just trying to create the auth database.
763 if (!$dbh->do(qq|LOCK auth.session_content|)) {
764 $dbh->rollback unless $provided_dbh;
765 $::lxdebug->leave_sub;
769 my @unfetched_keys = map { $_->{key} }
770 grep { ! $_->{fetched} }
771 values %{ $self->{SESSION} };
772 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
773 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
774 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
775 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
777 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
779 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
782 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
784 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
787 my @values_to_save = grep { $_->{fetched} }
788 values %{ $self->{SESSION} };
789 if (@values_to_save) {
790 my ($columns, $placeholders) = ('', '');
791 my $auto_restore = $self->{column_information}->has('auto_restore');
794 $columns .= ', auto_restore';
795 $placeholders .= ', ?';
798 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
799 my $sth = prepare_query($::form, $dbh, $query);
801 foreach my $value (@values_to_save) {
802 my @values = ($value->{key}, $value->get_dumped);
803 push @values, $value->{auto_restore} if $auto_restore;
805 do_statement($::form, $sth, $query, $session_id, @values);
811 $dbh->commit() unless $provided_dbh;
812 $::lxdebug->leave_sub;
815 sub set_session_value {
816 $main::lxdebug->enter_sub();
821 $self->{SESSION} ||= { };
824 my $key = shift @params;
826 if (ref $key eq 'HASH') {
827 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
828 value => $key->{value},
829 auto_restore => $key->{auto_restore});
832 my $value = shift @params;
833 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
838 $main::lxdebug->leave_sub();
843 sub delete_session_value {
844 $main::lxdebug->enter_sub();
848 $self->{SESSION} ||= { };
849 delete @{ $self->{SESSION} }{ @_ };
851 $main::lxdebug->leave_sub();
856 sub get_session_value {
857 $main::lxdebug->enter_sub();
860 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
862 $main::lxdebug->leave_sub();
867 sub create_unique_sesion_value {
868 my ($self, $value, %params) = @_;
870 $self->{SESSION} ||= { };
872 my @now = gettimeofday();
873 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
874 $self->{unique_counter} ||= 0;
878 $self->{unique_counter}++;
879 $hashed_key = md5_hex($key . $self->{unique_counter});
880 } while (exists $self->{SESSION}->{$hashed_key});
882 $self->set_session_value($hashed_key => $value);
887 sub save_form_in_session {
888 my ($self, %params) = @_;
890 my $form = delete($params{form}) || $::form;
891 my $non_scalars = delete $params{non_scalars};
894 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
896 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
897 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
900 return $self->create_unique_sesion_value($data, %params);
903 sub restore_form_from_session {
904 my ($self, $key, %params) = @_;
906 my $data = $self->get_session_value($key);
907 return $self unless $data;
909 my $form = delete($params{form}) || $::form;
910 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
912 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
917 sub set_cookie_environment_variable {
919 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
922 sub get_session_cookie_name {
925 return $self->{cookie_name} || 'lx_office_erp_session_id';
932 sub session_tables_present {
933 $main::lxdebug->enter_sub();
937 # Only re-check for the presence of auth tables if either the check
938 # hasn't been done before of if they weren't present.
939 if ($self->{session_tables_present}) {
940 $main::lxdebug->leave_sub();
941 return $self->{session_tables_present};
944 my $dbh = $self->dbconnect(1);
947 $main::lxdebug->leave_sub();
954 WHERE (schemaname = 'auth')
955 AND (tablename IN ('session', 'session_content'))|;
957 my ($count) = selectrow_query($main::form, $dbh, $query);
959 $self->{session_tables_present} = 2 == $count;
961 $main::lxdebug->leave_sub();
963 return $self->{session_tables_present};
966 # --------------------------------------
968 sub all_rights_full {
969 my $locale = $main::locale;
972 ["--crm", $locale->text("CRM optional software")],
973 ["crm_search", $locale->text("CRM search")],
974 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
975 ["crm_service", $locale->text("CRM services")],
976 ["crm_admin", $locale->text("CRM admin")],
977 ["crm_adminuser", $locale->text("CRM user")],
978 ["crm_adminstatus", $locale->text("CRM status")],
979 ["crm_email", $locale->text("CRM send email")],
980 ["crm_termin", $locale->text("CRM termin")],
981 ["crm_opportunity", $locale->text("CRM opportunity")],
982 ["crm_knowhow", $locale->text("CRM know how")],
983 ["crm_follow", $locale->text("CRM follow up")],
984 ["crm_notices", $locale->text("CRM notices")],
985 ["crm_other", $locale->text("CRM other")],
986 ["--master_data", $locale->text("Master Data")],
987 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
988 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
989 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
990 ["project_edit", $locale->text("Create and edit projects")],
991 ["--ar", $locale->text("AR")],
992 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
993 ["sales_order_edit", $locale->text("Create and edit sales orders")],
994 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
995 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
996 ["dunning_edit", $locale->text("Create and edit dunnings")],
997 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
998 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
999 ["--ap", $locale->text("AP")],
1000 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1001 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1002 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1003 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1004 ["--warehouse_management", $locale->text("Warehouse management")],
1005 ["warehouse_contents", $locale->text("View warehouse content")],
1006 ["warehouse_management", $locale->text("Warehouse management")],
1007 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1008 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1009 ["datev_export", $locale->text("DATEV Export")],
1010 ["cash", $locale->text("Receipt, payment, reconciliation")],
1011 ["--reports", $locale->text('Reports')],
1012 ["report", $locale->text('All reports')],
1013 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1014 ["--batch_printing", $locale->text("Batch Printing")],
1015 ["batch_printing", $locale->text("Batch Printing")],
1016 ["--others", $locale->text("Others")],
1017 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1018 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
1019 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1026 return grep !/^--/, map { $_->[0] } all_rights_full();
1030 $main::lxdebug->enter_sub();
1034 my $form = $main::form;
1036 my $dbh = $self->dbconnect();
1038 my $query = 'SELECT * FROM auth."group"';
1039 my $sth = prepare_execute_query($form, $dbh, $query);
1043 while ($row = $sth->fetchrow_hashref()) {
1044 $groups->{$row->{id}} = $row;
1048 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1049 $sth = prepare_query($form, $dbh, $query);
1051 foreach $group (values %{$groups}) {
1054 do_statement($form, $sth, $query, $group->{id});
1056 while ($row = $sth->fetchrow_hashref()) {
1057 push @members, $row->{user_id};
1059 $group->{members} = [ uniq @members ];
1063 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1064 $sth = prepare_query($form, $dbh, $query);
1066 foreach $group (values %{$groups}) {
1067 $group->{rights} = {};
1069 do_statement($form, $sth, $query, $group->{id});
1071 while ($row = $sth->fetchrow_hashref()) {
1072 $group->{rights}->{$row->{right}} |= $row->{granted};
1075 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1079 $main::lxdebug->leave_sub();
1085 $main::lxdebug->enter_sub();
1090 my $form = $main::form;
1091 my $dbh = $self->dbconnect();
1095 my ($query, $sth, $row, $rights);
1097 if (!$group->{id}) {
1098 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1100 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1101 do_query($form, $dbh, $query, $group->{id});
1104 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1106 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1108 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1109 $sth = prepare_query($form, $dbh, $query);
1111 foreach my $user_id (uniq @{ $group->{members} }) {
1112 do_statement($form, $sth, $query, $user_id, $group->{id});
1116 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1118 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1119 $sth = prepare_query($form, $dbh, $query);
1121 foreach my $right (keys %{ $group->{rights} }) {
1122 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1128 $main::lxdebug->leave_sub();
1132 $main::lxdebug->enter_sub();
1137 my $form = $main::form;
1139 my $dbh = $self->dbconnect();
1142 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1143 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1144 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1148 $main::lxdebug->leave_sub();
1151 sub evaluate_rights_ary {
1152 $main::lxdebug->enter_sub(2);
1159 foreach my $el (@{$ary}) {
1160 if (ref $el eq "ARRAY") {
1161 if ($action eq '|') {
1162 $value |= evaluate_rights_ary($el);
1164 $value &= evaluate_rights_ary($el);
1167 } elsif (($el eq '&') || ($el eq '|')) {
1170 } elsif ($action eq '|') {
1179 $main::lxdebug->leave_sub(2);
1184 sub _parse_rights_string {
1185 $main::lxdebug->enter_sub(2);
1195 push @stack, $cur_ary;
1197 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1199 substr($access, 0, length $1) = "";
1201 next if ($token =~ /\s/);
1203 if ($token eq "(") {
1204 my $new_cur_ary = [];
1205 push @stack, $new_cur_ary;
1206 push @{$cur_ary}, $new_cur_ary;
1207 $cur_ary = $new_cur_ary;
1209 } elsif ($token eq ")") {
1213 $main::lxdebug->leave_sub(2);
1217 $cur_ary = $stack[-1];
1219 } elsif (($token eq "|") || ($token eq "&")) {
1220 push @{$cur_ary}, $token;
1223 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1227 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1229 $main::lxdebug->leave_sub(2);
1235 $main::lxdebug->enter_sub(2);
1240 my $default = shift;
1242 $self->{FULL_RIGHTS} ||= { };
1243 $self->{FULL_RIGHTS}->{$login} ||= { };
1245 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1246 $self->{RIGHTS} ||= { };
1247 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1249 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1252 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1253 $granted = $default if (!defined $granted);
1255 $main::lxdebug->leave_sub(2);
1261 $::lxdebug->enter_sub(2);
1262 my ($self, $right, $dont_abort) = @_;
1264 if ($self->check_right($::myconfig{login}, $right)) {
1265 $::lxdebug->leave_sub(2);
1270 delete $::form->{title};
1271 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1274 $::lxdebug->leave_sub(2);
1279 sub load_rights_for_user {
1280 $::lxdebug->enter_sub;
1282 my ($self, $login) = @_;
1283 my $dbh = $self->dbconnect;
1284 my ($query, $sth, $row, $rights);
1286 $rights = { map { $_ => 0 } all_rights() };
1289 qq|SELECT gr."right", gr.granted
1290 FROM auth.group_rights gr
1293 FROM auth.user_group ug
1294 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1295 WHERE u.login = ?)|;
1297 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1299 while ($row = $sth->fetchrow_hashref()) {
1300 $rights->{$row->{right}} |= $row->{granted};
1304 $::lxdebug->leave_sub;
1318 SL::Auth - Authentication and session handling
1324 =item C<set_session_value @values>
1326 =item C<set_session_value %values>
1328 Store all values of C<@values> or C<%values> in the session. Each
1329 member of C<@values> is tested if it is a hash reference. If it is
1330 then it must contain the keys C<key> and C<value> and can optionally
1331 contain the key C<auto_restore>. In this case C<value> is associated
1332 with C<key> and restored to C<$::form> upon the next request
1333 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1336 If the current member of C<@values> is not a hash reference then it
1337 will be used as the C<key> and the next entry of C<@values> is used as
1338 the C<value> to store. In this case setting C<auto_restore> is not
1341 Therefore the following two invocations are identical:
1343 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1344 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1346 All of these values are copied back into C<$::form> for the next
1347 request automatically if they're scalar values or if they have
1348 C<auto_restore> set to trueish.
1350 The values can be any Perl structure. They are stored as YAML dumps.
1352 =item C<get_session_value $key>
1354 Retrieve a value from the session. Returns C<undef> if the value
1357 =item C<create_unique_sesion_value $value, %params>
1359 Create a unique key in the session and store C<$value>
1362 Returns the key created in the session.
1364 =item C<save_session>
1366 Stores the session values in the database. This is the only function
1367 that actually stores stuff in the database. Neither the various
1368 setters nor the deleter access the database.
1370 =item <save_form_in_session %params>
1372 Stores the content of C<$params{form}> (default: C<$::form>) in the
1373 session using L</create_unique_sesion_value>.
1375 If C<$params{non_scalars}> is trueish then non-scalar values will be
1376 stored as well. Default is to only store scalar values.
1378 The following keys will never be saved: C<login>, C<password>,
1379 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1380 can be given as an array ref in C<$params{skip_keys}>.
1382 Returns the unique key under which the form is stored.
1384 =item <restore_form_from_session $key, %params>
1386 Restores the form from the session into C<$params{form}> (default:
1389 If C<$params{clobber}> is falsish then existing values with the same
1390 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1403 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>