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;
27 $main::lxdebug->enter_sub();
34 $self->_read_auth_config();
37 $main::lxdebug->leave_sub();
43 my ($self, %params) = @_;
45 $self->{SESSION} = { };
46 $self->{FULL_RIGHTS} = { };
47 $self->{RIGHTS} = { };
48 $self->{unique_counter} = 0;
49 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
50 $self->{authenticator}->reset;
54 my ($self, $login, %params) = @_;
55 my $may_fail = delete $params{may_fail};
57 my %user = $self->read_user(login => $login);
58 my $dbh = SL::DBConnect->connect(
63 pg_enable_utf8 => $::locale->is_utf8,
68 if (!$may_fail && !$dbh) {
69 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
72 if ($user{dboptions} && $dbh) {
73 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
82 $self->{dbh}->disconnect() if ($self->{dbh});
85 # form isn't loaded yet, so auth needs it's own error.
87 $::lxdebug->show_backtrace();
89 my ($self, @msg) = @_;
90 if ($ENV{HTTP_USER_AGENT}) {
91 print Form->create_http_response(content_type => 'text/html');
92 print "<pre>", join ('<br>', @msg), "</pre>";
94 print STDERR "Error: @msg\n";
99 sub _read_auth_config {
100 $main::lxdebug->enter_sub();
104 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
106 # Prevent password leakage to log files when dumping Auth instances.
107 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
109 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
110 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
112 if ($self->{module} eq 'DB') {
113 $self->{authenticator} = SL::Auth::DB->new($self);
115 } elsif ($self->{module} eq 'LDAP') {
116 $self->{authenticator} = SL::Auth::LDAP->new($self);
119 if (!$self->{authenticator}) {
120 my $locale = Locale->new('en');
121 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
124 my $cfg = $self->{DB_config};
127 my $locale = Locale->new('en');
128 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
131 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
132 my $locale = Locale->new('en');
133 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
136 $self->{authenticator}->verify_config();
138 $self->{session_timeout} *= 1;
139 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
141 $main::lxdebug->leave_sub();
144 sub authenticate_root {
145 $main::lxdebug->enter_sub();
147 my ($self, $password) = @_;
149 $password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
150 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
152 $main::lxdebug->leave_sub();
154 return OK if $password eq $admin_password;
160 $main::lxdebug->enter_sub();
162 my ($self, $login, $password) = @_;
164 $main::lxdebug->leave_sub();
166 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
167 return OK if $result eq OK;
172 sub store_credentials_in_session {
173 my ($self, %params) = @_;
175 if (!$self->{authenticator}->requires_cleartext_password) {
176 $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login},
177 password => $params{password},
178 look_up_algorithm => 1,
182 $self->set_session_value(login => $params{login}, password => $params{password});
185 sub store_root_credentials_in_session {
186 my ($self, $rpw) = @_;
188 $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
191 sub get_stored_password {
192 my ($self, $login) = @_;
194 my $dbh = $self->dbconnect;
196 return undef unless $dbh;
198 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
199 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
201 return $stored_password;
205 $main::lxdebug->enter_sub(2);
208 my $may_fail = shift;
211 $main::lxdebug->leave_sub(2);
215 my $cfg = $self->{DB_config};
216 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
219 $dsn .= ';port=' . $cfg->{port};
222 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
224 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
226 if (!$may_fail && !$self->{dbh}) {
227 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
230 $main::lxdebug->leave_sub(2);
236 $main::lxdebug->enter_sub();
241 $self->{dbh}->disconnect();
245 $main::lxdebug->leave_sub();
249 $main::lxdebug->enter_sub();
251 my ($self, $dbh) = @_;
253 $dbh ||= $self->dbconnect();
254 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
256 my ($count) = $dbh->selectrow_array($query);
258 $main::lxdebug->leave_sub();
264 $main::lxdebug->enter_sub();
268 my $dbh = $self->dbconnect(1);
270 $main::lxdebug->leave_sub();
275 sub create_database {
276 $main::lxdebug->enter_sub();
281 my $cfg = $self->{DB_config};
283 if (!$params{superuser}) {
284 $params{superuser} = $cfg->{user};
285 $params{superuser_password} = $cfg->{password};
288 $params{template} ||= 'template0';
289 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
291 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
294 $dsn .= ';port=' . $cfg->{port};
297 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
299 my $charset = $::lx_office_conf{system}->{dbcharset};
300 $charset ||= Common::DEFAULT_CHARSET;
301 my $encoding = $Common::charset_to_db_encoding{$charset};
302 $encoding ||= 'UNICODE';
304 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
307 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
310 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
312 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
317 my $error = $dbh->errstr();
319 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
320 my ($cluster_encoding) = $dbh->selectrow_array($query);
322 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
323 $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.');
328 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
333 $main::lxdebug->leave_sub();
337 $main::lxdebug->enter_sub();
340 my $dbh = $self->dbconnect();
342 my $charset = $::lx_office_conf{system}->{dbcharset};
343 $charset ||= Common::DEFAULT_CHARSET;
346 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
348 $main::lxdebug->leave_sub();
352 $main::lxdebug->enter_sub();
358 my $form = $main::form;
360 my $dbh = $self->dbconnect();
362 my ($sth, $query, $user_id);
366 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
367 ($user_id) = selectrow_query($form, $dbh, $query, $login);
370 $query = qq|SELECT nextval('auth.user_id_seq')|;
371 ($user_id) = selectrow_query($form, $dbh, $query);
373 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
374 do_query($form, $dbh, $query, $user_id, $login);
377 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
378 do_query($form, $dbh, $query, $user_id);
380 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
381 $sth = prepare_query($form, $dbh, $query);
383 while (my ($cfg_key, $cfg_value) = each %params) {
384 next if ($cfg_key eq 'password');
386 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
391 $main::lxdebug->leave_sub();
394 sub can_change_password {
397 return $self->{authenticator}->can_change_password();
400 sub change_password {
401 $main::lxdebug->enter_sub();
403 my ($self, $login, $new_password) = @_;
405 my $result = $self->{authenticator}->change_password($login, $new_password);
407 $self->store_credentials_in_session(login => $login,
408 password => $new_password,
409 look_up_algorithm => 1,
412 $main::lxdebug->leave_sub();
418 $main::lxdebug->enter_sub();
422 my $dbh = $self->dbconnect();
423 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
424 FROM auth.user_config cfg
425 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
426 my $sth = prepare_execute_query($main::form, $dbh, $query);
430 while (my $ref = $sth->fetchrow_hashref()) {
431 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
432 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
437 $main::lxdebug->leave_sub();
443 $main::lxdebug->enter_sub();
445 my ($self, %params) = @_;
447 my $dbh = $self->dbconnect();
449 my (@where, @values);
450 if ($params{login}) {
451 push @where, 'u.login = ?';
452 push @values, $params{login};
455 push @where, 'u.id = ?';
456 push @values, $params{id};
458 my $where = join ' AND ', '1 = 1', @where;
459 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
460 FROM auth.user_config cfg
461 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
463 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
467 while (my $ref = $sth->fetchrow_hashref()) {
468 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
469 @user_data{qw(id login)} = @{$ref}{qw(id login)};
472 # The XUL/XML backed menu has been removed.
473 $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
477 $main::lxdebug->leave_sub();
483 $main::lxdebug->enter_sub();
488 my $dbh = $self->dbconnect();
489 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
491 $main::lxdebug->leave_sub();
497 $::lxdebug->enter_sub;
502 my $dbh = $self->dbconnect;
503 my $id = $self->get_user_id($login);
506 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
508 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
509 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
511 $u_dbh->begin_work if $u_dbh && $user_db_exists;
515 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
516 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
517 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
518 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
521 $u_dbh->commit if $u_dbh && $user_db_exists;
523 $::lxdebug->leave_sub;
526 # --------------------------------------
530 sub restore_session {
531 $main::lxdebug->enter_sub();
535 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
536 $session_id =~ s|[^0-9a-f]||g if $session_id;
538 $self->{SESSION} = { };
541 $main::lxdebug->leave_sub();
545 my ($dbh, $query, $sth, $cookie, $ref, $form);
549 # Don't fail if the auth DB doesn't yet.
550 if (!( $dbh = $self->dbconnect(1) )) {
551 $::lxdebug->leave_sub;
555 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
556 # admin is creating the session tables at the moment.
557 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
559 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
560 $sth->finish if $sth;
561 $::lxdebug->leave_sub;
565 $cookie = $sth->fetchrow_hashref;
568 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
569 $self->destroy_session();
570 $main::lxdebug->leave_sub();
571 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
574 if ($self->{column_information}->has('auto_restore')) {
575 $self->_load_with_auto_restore_column($dbh, $session_id);
577 $self->_load_without_auto_restore_column($dbh, $session_id);
580 $main::lxdebug->leave_sub();
585 sub _load_without_auto_restore_column {
586 my ($self, $dbh, $session_id) = @_;
589 SELECT sess_key, sess_value
590 FROM auth.session_content
591 WHERE (session_id = ?)
593 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
595 while (my $ref = $sth->fetchrow_hashref) {
596 my $value = SL::Auth::SessionValue->new(auth => $self,
597 key => $ref->{sess_key},
598 value => $ref->{sess_value},
600 $self->{SESSION}->{ $ref->{sess_key} } = $value;
602 next if defined $::form->{$ref->{sess_key}};
604 my $data = $value->get;
605 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
609 sub _load_with_auto_restore_column {
610 my ($self, $dbh, $session_id) = @_;
612 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
615 SELECT sess_key, sess_value, auto_restore
616 FROM auth.session_content
617 WHERE (session_id = ?)
619 OR sess_key IN (${auto_restore_keys}))
621 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
623 while (my $ref = $sth->fetchrow_hashref) {
624 my $value = SL::Auth::SessionValue->new(auth => $self,
625 key => $ref->{sess_key},
626 value => $ref->{sess_value},
627 auto_restore => $ref->{auto_restore},
629 $self->{SESSION}->{ $ref->{sess_key} } = $value;
631 next if defined $::form->{$ref->{sess_key}};
633 my $data = $value->get;
634 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
641 FROM auth.session_content
642 WHERE (session_id = ?)
643 AND NOT COALESCE(auto_restore, FALSE)
644 AND (sess_key NOT IN (${auto_restore_keys}))
646 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
648 while (my $ref = $sth->fetchrow_hashref) {
649 my $value = SL::Auth::SessionValue->new(auth => $self,
650 key => $ref->{sess_key});
651 $self->{SESSION}->{ $ref->{sess_key} } = $value;
655 sub destroy_session {
656 $main::lxdebug->enter_sub();
661 my $dbh = $self->dbconnect();
665 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
666 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
670 SL::SessionFile->destroy_session($session_id);
673 $self->{SESSION} = { };
676 $main::lxdebug->leave_sub();
679 sub expire_sessions {
680 $main::lxdebug->enter_sub();
684 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
686 my $dbh = $self->dbconnect();
688 my $query = qq|SELECT id
690 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
692 my @ids = selectall_array_query($::form, $dbh, $query);
697 SL::SessionFile->destroy_session($_) for @ids;
699 $query = qq|DELETE FROM auth.session_content
700 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
701 do_query($main::form, $dbh, $query, @ids);
703 $query = qq|DELETE FROM auth.session
704 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
705 do_query($main::form, $dbh, $query, @ids);
710 $main::lxdebug->leave_sub();
713 sub _create_session_id {
714 $main::lxdebug->enter_sub();
717 map { push @data, int(rand() * 255); } (1..32);
719 my $id = md5_hex(pack 'C*', @data);
721 $main::lxdebug->leave_sub();
726 sub create_or_refresh_session {
727 $session_id ||= shift->_create_session_id;
731 $::lxdebug->enter_sub;
733 my $provided_dbh = shift;
735 my $dbh = $provided_dbh || $self->dbconnect(1);
737 $::lxdebug->leave_sub && return unless $dbh && $session_id;
739 $dbh->begin_work unless $provided_dbh;
741 # If this fails then the "auth" schema might not exist yet, e.g. if
742 # the admin is just trying to create the auth database.
743 if (!$dbh->do(qq|LOCK auth.session_content|)) {
744 $dbh->rollback unless $provided_dbh;
745 $::lxdebug->leave_sub;
749 my @unfetched_keys = map { $_->{key} }
750 grep { ! $_->{fetched} }
751 values %{ $self->{SESSION} };
752 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
753 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
754 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
755 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
757 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
759 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
762 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
764 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
767 my @values_to_save = grep { $_->{fetched} }
768 values %{ $self->{SESSION} };
769 if (@values_to_save) {
770 my ($columns, $placeholders) = ('', '');
771 my $auto_restore = $self->{column_information}->has('auto_restore');
774 $columns .= ', auto_restore';
775 $placeholders .= ', ?';
778 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
779 my $sth = prepare_query($::form, $dbh, $query);
781 foreach my $value (@values_to_save) {
782 my @values = ($value->{key}, $value->get_dumped);
783 push @values, $value->{auto_restore} if $auto_restore;
785 do_statement($::form, $sth, $query, $session_id, @values);
791 $dbh->commit() unless $provided_dbh;
792 $::lxdebug->leave_sub;
795 sub set_session_value {
796 $main::lxdebug->enter_sub();
801 $self->{SESSION} ||= { };
804 my $key = shift @params;
806 if (ref $key eq 'HASH') {
807 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
808 value => $key->{value},
809 auto_restore => $key->{auto_restore});
812 my $value = shift @params;
813 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
818 $main::lxdebug->leave_sub();
823 sub delete_session_value {
824 $main::lxdebug->enter_sub();
828 $self->{SESSION} ||= { };
829 delete @{ $self->{SESSION} }{ @_ };
831 $main::lxdebug->leave_sub();
836 sub get_session_value {
837 $main::lxdebug->enter_sub();
840 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
842 $main::lxdebug->leave_sub();
847 sub create_unique_sesion_value {
848 my ($self, $value, %params) = @_;
850 $self->{SESSION} ||= { };
852 my @now = gettimeofday();
853 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
854 $self->{unique_counter} ||= 0;
858 $self->{unique_counter}++;
859 $hashed_key = md5_hex($key . $self->{unique_counter});
860 } while (exists $self->{SESSION}->{$hashed_key});
862 $self->set_session_value($hashed_key => $value);
867 sub save_form_in_session {
868 my ($self, %params) = @_;
870 my $form = delete($params{form}) || $::form;
871 my $non_scalars = delete $params{non_scalars};
874 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
876 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
877 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
880 return $self->create_unique_sesion_value($data, %params);
883 sub restore_form_from_session {
884 my ($self, $key, %params) = @_;
886 my $data = $self->get_session_value($key);
887 return $self unless $data;
889 my $form = delete($params{form}) || $::form;
890 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
892 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
897 sub set_cookie_environment_variable {
899 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
902 sub get_session_cookie_name {
905 return $self->{cookie_name} || 'lx_office_erp_session_id';
912 sub session_tables_present {
913 $main::lxdebug->enter_sub();
917 # Only re-check for the presence of auth tables if either the check
918 # hasn't been done before of if they weren't present.
919 if ($self->{session_tables_present}) {
920 $main::lxdebug->leave_sub();
921 return $self->{session_tables_present};
924 my $dbh = $self->dbconnect(1);
927 $main::lxdebug->leave_sub();
934 WHERE (schemaname = 'auth')
935 AND (tablename IN ('session', 'session_content'))|;
937 my ($count) = selectrow_query($main::form, $dbh, $query);
939 $self->{session_tables_present} = 2 == $count;
941 $main::lxdebug->leave_sub();
943 return $self->{session_tables_present};
946 # --------------------------------------
948 sub all_rights_full {
949 my $locale = $main::locale;
952 ["--crm", $locale->text("CRM optional software")],
953 ["crm_search", $locale->text("CRM search")],
954 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
955 ["crm_service", $locale->text("CRM services")],
956 ["crm_admin", $locale->text("CRM admin")],
957 ["crm_adminuser", $locale->text("CRM user")],
958 ["crm_adminstatus", $locale->text("CRM status")],
959 ["crm_email", $locale->text("CRM send email")],
960 ["crm_termin", $locale->text("CRM termin")],
961 ["crm_opportunity", $locale->text("CRM opportunity")],
962 ["crm_knowhow", $locale->text("CRM know how")],
963 ["crm_follow", $locale->text("CRM follow up")],
964 ["crm_notices", $locale->text("CRM notices")],
965 ["crm_other", $locale->text("CRM other")],
966 ["--master_data", $locale->text("Master Data")],
967 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
968 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
969 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
970 ["project_edit", $locale->text("Create and edit projects")],
971 ["--ar", $locale->text("AR")],
972 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
973 ["sales_order_edit", $locale->text("Create and edit sales orders")],
974 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
975 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
976 ["dunning_edit", $locale->text("Create and edit dunnings")],
977 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
978 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
979 ["--ap", $locale->text("AP")],
980 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
981 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
982 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
983 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
984 ["--warehouse_management", $locale->text("Warehouse management")],
985 ["warehouse_contents", $locale->text("View warehouse content")],
986 ["warehouse_management", $locale->text("Warehouse management")],
987 ["--general_ledger_cash", $locale->text("General ledger and cash")],
988 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
989 ["datev_export", $locale->text("DATEV Export")],
990 ["cash", $locale->text("Receipt, payment, reconciliation")],
991 ["--reports", $locale->text('Reports')],
992 ["report", $locale->text('All reports')],
993 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
994 ["--batch_printing", $locale->text("Batch Printing")],
995 ["batch_printing", $locale->text("Batch Printing")],
996 ["--others", $locale->text("Others")],
997 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
998 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
999 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1006 return grep !/^--/, map { $_->[0] } all_rights_full();
1010 $main::lxdebug->enter_sub();
1014 my $form = $main::form;
1016 my $dbh = $self->dbconnect();
1018 my $query = 'SELECT * FROM auth."group"';
1019 my $sth = prepare_execute_query($form, $dbh, $query);
1023 while ($row = $sth->fetchrow_hashref()) {
1024 $groups->{$row->{id}} = $row;
1028 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1029 $sth = prepare_query($form, $dbh, $query);
1031 foreach $group (values %{$groups}) {
1034 do_statement($form, $sth, $query, $group->{id});
1036 while ($row = $sth->fetchrow_hashref()) {
1037 push @members, $row->{user_id};
1039 $group->{members} = [ uniq @members ];
1043 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1044 $sth = prepare_query($form, $dbh, $query);
1046 foreach $group (values %{$groups}) {
1047 $group->{rights} = {};
1049 do_statement($form, $sth, $query, $group->{id});
1051 while ($row = $sth->fetchrow_hashref()) {
1052 $group->{rights}->{$row->{right}} |= $row->{granted};
1055 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1059 $main::lxdebug->leave_sub();
1065 $main::lxdebug->enter_sub();
1070 my $form = $main::form;
1071 my $dbh = $self->dbconnect();
1075 my ($query, $sth, $row, $rights);
1077 if (!$group->{id}) {
1078 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1080 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1081 do_query($form, $dbh, $query, $group->{id});
1084 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1086 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1088 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1089 $sth = prepare_query($form, $dbh, $query);
1091 foreach my $user_id (uniq @{ $group->{members} }) {
1092 do_statement($form, $sth, $query, $user_id, $group->{id});
1096 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1098 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1099 $sth = prepare_query($form, $dbh, $query);
1101 foreach my $right (keys %{ $group->{rights} }) {
1102 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1108 $main::lxdebug->leave_sub();
1112 $main::lxdebug->enter_sub();
1117 my $form = $main::form;
1119 my $dbh = $self->dbconnect();
1122 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1123 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1124 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1128 $main::lxdebug->leave_sub();
1131 sub evaluate_rights_ary {
1132 $main::lxdebug->enter_sub(2);
1139 foreach my $el (@{$ary}) {
1140 if (ref $el eq "ARRAY") {
1141 if ($action eq '|') {
1142 $value |= evaluate_rights_ary($el);
1144 $value &= evaluate_rights_ary($el);
1147 } elsif (($el eq '&') || ($el eq '|')) {
1150 } elsif ($action eq '|') {
1159 $main::lxdebug->leave_sub(2);
1164 sub _parse_rights_string {
1165 $main::lxdebug->enter_sub(2);
1175 push @stack, $cur_ary;
1177 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1179 substr($access, 0, length $1) = "";
1181 next if ($token =~ /\s/);
1183 if ($token eq "(") {
1184 my $new_cur_ary = [];
1185 push @stack, $new_cur_ary;
1186 push @{$cur_ary}, $new_cur_ary;
1187 $cur_ary = $new_cur_ary;
1189 } elsif ($token eq ")") {
1193 $main::lxdebug->leave_sub(2);
1197 $cur_ary = $stack[-1];
1199 } elsif (($token eq "|") || ($token eq "&")) {
1200 push @{$cur_ary}, $token;
1203 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1207 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1209 $main::lxdebug->leave_sub(2);
1215 $main::lxdebug->enter_sub(2);
1220 my $default = shift;
1222 $self->{FULL_RIGHTS} ||= { };
1223 $self->{FULL_RIGHTS}->{$login} ||= { };
1225 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1226 $self->{RIGHTS} ||= { };
1227 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1229 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1232 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1233 $granted = $default if (!defined $granted);
1235 $main::lxdebug->leave_sub(2);
1241 $::lxdebug->enter_sub(2);
1242 my ($self, $right, $dont_abort) = @_;
1244 if ($self->check_right($::myconfig{login}, $right)) {
1245 $::lxdebug->leave_sub(2);
1250 delete $::form->{title};
1251 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1254 $::lxdebug->leave_sub(2);
1259 sub load_rights_for_user {
1260 $::lxdebug->enter_sub;
1262 my ($self, $login) = @_;
1263 my $dbh = $self->dbconnect;
1264 my ($query, $sth, $row, $rights);
1266 $rights = { map { $_ => 0 } all_rights() };
1269 qq|SELECT gr."right", gr.granted
1270 FROM auth.group_rights gr
1273 FROM auth.user_group ug
1274 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1275 WHERE u.login = ?)|;
1277 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1279 while ($row = $sth->fetchrow_hashref()) {
1280 $rights->{$row->{right}} |= $row->{granted};
1284 $::lxdebug->leave_sub;
1298 SL::Auth - Authentication and session handling
1304 =item C<set_session_value @values>
1306 =item C<set_session_value %values>
1308 Store all values of C<@values> or C<%values> in the session. Each
1309 member of C<@values> is tested if it is a hash reference. If it is
1310 then it must contain the keys C<key> and C<value> and can optionally
1311 contain the key C<auto_restore>. In this case C<value> is associated
1312 with C<key> and restored to C<$::form> upon the next request
1313 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1316 If the current member of C<@values> is not a hash reference then it
1317 will be used as the C<key> and the next entry of C<@values> is used as
1318 the C<value> to store. In this case setting C<auto_restore> is not
1321 Therefore the following two invocations are identical:
1323 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1324 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1326 All of these values are copied back into C<$::form> for the next
1327 request automatically if they're scalar values or if they have
1328 C<auto_restore> set to trueish.
1330 The values can be any Perl structure. They are stored as YAML dumps.
1332 =item C<get_session_value $key>
1334 Retrieve a value from the session. Returns C<undef> if the value
1337 =item C<create_unique_sesion_value $value, %params>
1339 Create a unique key in the session and store C<$value>
1342 Returns the key created in the session.
1344 =item C<save_session>
1346 Stores the session values in the database. This is the only function
1347 that actually stores stuff in the database. Neither the various
1348 setters nor the deleter access the database.
1350 =item <save_form_in_session %params>
1352 Stores the content of C<$params{form}> (default: C<$::form>) in the
1353 session using L</create_unique_sesion_value>.
1355 If C<$params{non_scalars}> is trueish then non-scalar values will be
1356 stored as well. Default is to only store scalar values.
1358 The following keys will never be saved: C<login>, C<password>,
1359 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1360 can be given as an array ref in C<$params{skip_keys}>.
1362 Returns the unique key under which the form is stored.
1364 =item <restore_form_from_session $key, %params>
1366 Restores the form from the session into C<$params{form}> (default:
1369 If C<$params{clobber}> is falsish then existing values with the same
1370 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1383 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>