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);
53 my ($self, $login, %params) = @_;
54 my $may_fail = delete $params{may_fail};
56 my %user = $self->read_user($login);
57 my $dbh = SL::DBConnect->connect(
62 pg_enable_utf8 => $::locale->is_utf8,
67 if (!$may_fail && !$dbh) {
68 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
71 if ($user{dboptions} && $dbh) {
72 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
81 $self->{dbh}->disconnect() if ($self->{dbh});
84 # form isn't loaded yet, so auth needs it's own error.
86 $::lxdebug->show_backtrace();
88 my ($self, @msg) = @_;
89 if ($ENV{HTTP_USER_AGENT}) {
90 print Form->create_http_response(content_type => 'text/html');
91 print "<pre>", join ('<br>', @msg), "</pre>";
93 print STDERR "Error: @msg\n";
98 sub _read_auth_config {
99 $main::lxdebug->enter_sub();
103 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
104 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
105 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
107 if ($self->{module} eq 'DB') {
108 $self->{authenticator} = SL::Auth::DB->new($self);
110 } elsif ($self->{module} eq 'LDAP') {
111 $self->{authenticator} = SL::Auth::LDAP->new($self);
114 if (!$self->{authenticator}) {
115 my $locale = Locale->new('en');
116 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
119 my $cfg = $self->{DB_config};
122 my $locale = Locale->new('en');
123 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
126 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
127 my $locale = Locale->new('en');
128 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
131 $self->{authenticator}->verify_config();
133 $self->{session_timeout} *= 1;
134 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
136 $main::lxdebug->leave_sub();
139 sub authenticate_root {
140 $main::lxdebug->enter_sub();
142 my ($self, $password) = @_;
144 $password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
145 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password});
147 $main::lxdebug->leave_sub();
149 return OK if $password eq $admin_password;
155 $main::lxdebug->enter_sub();
157 my ($self, $login, $password) = @_;
159 $main::lxdebug->leave_sub();
161 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
162 return OK if $result eq OK;
167 sub store_credentials_in_session {
168 my ($self, %params) = @_;
170 if (!$self->{authenticator}->requires_cleartext_password) {
171 $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login},
172 password => $params{password},
173 look_up_algorithm => 1,
177 $self->set_session_value(login => $params{login}, password => $params{password});
180 sub store_root_credentials_in_session {
181 my ($self, $rpw) = @_;
183 $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
186 sub get_stored_password {
187 my ($self, $login) = @_;
189 my $dbh = $self->dbconnect;
191 return undef unless $dbh;
193 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
194 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
196 return $stored_password;
200 $main::lxdebug->enter_sub(2);
203 my $may_fail = shift;
206 $main::lxdebug->leave_sub(2);
210 my $cfg = $self->{DB_config};
211 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
214 $dsn .= ';port=' . $cfg->{port};
217 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
219 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
221 if (!$may_fail && !$self->{dbh}) {
222 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
225 $main::lxdebug->leave_sub(2);
231 $main::lxdebug->enter_sub();
236 $self->{dbh}->disconnect();
240 $main::lxdebug->leave_sub();
244 $main::lxdebug->enter_sub();
248 my $dbh = $self->dbconnect();
249 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
251 my ($count) = $dbh->selectrow_array($query);
253 $main::lxdebug->leave_sub();
259 $main::lxdebug->enter_sub();
263 my $dbh = $self->dbconnect(1);
265 $main::lxdebug->leave_sub();
270 sub create_database {
271 $main::lxdebug->enter_sub();
276 my $cfg = $self->{DB_config};
278 if (!$params{superuser}) {
279 $params{superuser} = $cfg->{user};
280 $params{superuser_password} = $cfg->{password};
283 $params{template} ||= 'template0';
284 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
286 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
289 $dsn .= ';port=' . $cfg->{port};
292 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
294 my $charset = $::lx_office_conf{system}->{dbcharset};
295 $charset ||= Common::DEFAULT_CHARSET;
296 my $encoding = $Common::charset_to_db_encoding{$charset};
297 $encoding ||= 'UNICODE';
299 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
302 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
305 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
307 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
312 my $error = $dbh->errstr();
314 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
315 my ($cluster_encoding) = $dbh->selectrow_array($query);
317 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
318 $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.');
323 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
328 $main::lxdebug->leave_sub();
332 $main::lxdebug->enter_sub();
335 my $dbh = $self->dbconnect();
337 my $charset = $::lx_office_conf{system}->{dbcharset};
338 $charset ||= Common::DEFAULT_CHARSET;
341 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
343 $main::lxdebug->leave_sub();
347 $main::lxdebug->enter_sub();
353 my $form = $main::form;
355 my $dbh = $self->dbconnect();
357 my ($sth, $query, $user_id);
361 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
362 ($user_id) = selectrow_query($form, $dbh, $query, $login);
365 $query = qq|SELECT nextval('auth.user_id_seq')|;
366 ($user_id) = selectrow_query($form, $dbh, $query);
368 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
369 do_query($form, $dbh, $query, $user_id, $login);
372 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
373 do_query($form, $dbh, $query, $user_id);
375 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
376 $sth = prepare_query($form, $dbh, $query);
378 while (my ($cfg_key, $cfg_value) = each %params) {
379 next if ($cfg_key eq 'password');
381 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
386 $main::lxdebug->leave_sub();
389 sub can_change_password {
392 return $self->{authenticator}->can_change_password();
395 sub change_password {
396 $main::lxdebug->enter_sub();
398 my ($self, $login, $new_password) = @_;
400 my $result = $self->{authenticator}->change_password($login, $new_password);
402 $self->store_credentials_in_session(login => $login,
403 password => $new_password,
404 look_up_algorithm => 1,
407 $main::lxdebug->leave_sub();
413 $main::lxdebug->enter_sub();
417 my $dbh = $self->dbconnect();
418 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
419 FROM auth.user_config cfg
420 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
421 my $sth = prepare_execute_query($main::form, $dbh, $query);
425 while (my $ref = $sth->fetchrow_hashref()) {
426 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
427 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
432 $main::lxdebug->leave_sub();
438 $main::lxdebug->enter_sub();
443 my $dbh = $self->dbconnect();
444 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
445 FROM auth.user_config cfg
446 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
447 WHERE (u.login = ?)|;
448 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
452 while (my $ref = $sth->fetchrow_hashref()) {
453 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
454 @user_data{qw(id login)} = @{$ref}{qw(id login)};
459 $main::lxdebug->leave_sub();
465 $main::lxdebug->enter_sub();
470 my $dbh = $self->dbconnect();
471 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
473 $main::lxdebug->leave_sub();
479 $::lxdebug->enter_sub;
484 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
485 my $dbh = $self->dbconnect;
489 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
491 my ($id) = selectrow_query($::form, $dbh, $query, $login);
493 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
495 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
496 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
497 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
500 $u_dbh->commit if $u_dbh;
502 $::lxdebug->leave_sub;
505 # --------------------------------------
509 sub restore_session {
510 $main::lxdebug->enter_sub();
514 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
515 $session_id =~ s|[^0-9a-f]||g if $session_id;
517 $self->{SESSION} = { };
520 $main::lxdebug->leave_sub();
524 my ($dbh, $query, $sth, $cookie, $ref, $form);
528 # Don't fail if the auth DB doesn't yet.
529 if (!( $dbh = $self->dbconnect(1) )) {
530 $::lxdebug->leave_sub;
534 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
535 # admin is creating the session tables at the moment.
536 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
538 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
539 $sth->finish if $sth;
540 $::lxdebug->leave_sub;
544 $cookie = $sth->fetchrow_hashref;
547 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
548 $self->destroy_session();
549 $main::lxdebug->leave_sub();
550 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
553 if ($self->{column_information}->has('auto_restore')) {
554 $self->_load_with_auto_restore_column($dbh, $session_id);
556 $self->_load_without_auto_restore_column($dbh, $session_id);
559 $main::lxdebug->leave_sub();
564 sub _load_without_auto_restore_column {
565 my ($self, $dbh, $session_id) = @_;
568 SELECT sess_key, sess_value
569 FROM auth.session_content
570 WHERE (session_id = ?)
572 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
574 while (my $ref = $sth->fetchrow_hashref) {
575 my $value = SL::Auth::SessionValue->new(auth => $self,
576 key => $ref->{sess_key},
577 value => $ref->{sess_value},
579 $self->{SESSION}->{ $ref->{sess_key} } = $value;
581 next if defined $::form->{$ref->{sess_key}};
583 my $data = $value->get;
584 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
588 sub _load_with_auto_restore_column {
589 my ($self, $dbh, $session_id) = @_;
591 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
594 SELECT sess_key, sess_value, auto_restore
595 FROM auth.session_content
596 WHERE (session_id = ?)
598 OR sess_key IN (${auto_restore_keys}))
600 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
602 while (my $ref = $sth->fetchrow_hashref) {
603 my $value = SL::Auth::SessionValue->new(auth => $self,
604 key => $ref->{sess_key},
605 value => $ref->{sess_value},
606 auto_restore => $ref->{auto_restore},
608 $self->{SESSION}->{ $ref->{sess_key} } = $value;
610 next if defined $::form->{$ref->{sess_key}};
612 my $data = $value->get;
613 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
620 FROM auth.session_content
621 WHERE (session_id = ?)
622 AND NOT COALESCE(auto_restore, FALSE)
623 AND (sess_key NOT IN (${auto_restore_keys}))
625 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
627 while (my $ref = $sth->fetchrow_hashref) {
628 my $value = SL::Auth::SessionValue->new(auth => $self,
629 key => $ref->{sess_key});
630 $self->{SESSION}->{ $ref->{sess_key} } = $value;
634 sub destroy_session {
635 $main::lxdebug->enter_sub();
640 my $dbh = $self->dbconnect();
644 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
645 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
649 SL::SessionFile->destroy_session($session_id);
652 $self->{SESSION} = { };
655 $main::lxdebug->leave_sub();
658 sub expire_sessions {
659 $main::lxdebug->enter_sub();
663 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
665 my $dbh = $self->dbconnect();
667 my $query = qq|SELECT id
669 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
671 my @ids = selectall_array_query($::form, $dbh, $query);
676 SL::SessionFile->destroy_session($_) for @ids;
678 $query = qq|DELETE FROM auth.session_content
679 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
680 do_query($main::form, $dbh, $query, @ids);
682 $query = qq|DELETE FROM auth.session
683 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
684 do_query($main::form, $dbh, $query, @ids);
689 $main::lxdebug->leave_sub();
692 sub _create_session_id {
693 $main::lxdebug->enter_sub();
696 map { push @data, int(rand() * 255); } (1..32);
698 my $id = md5_hex(pack 'C*', @data);
700 $main::lxdebug->leave_sub();
705 sub create_or_refresh_session {
706 $session_id ||= shift->_create_session_id;
710 $::lxdebug->enter_sub;
712 my $provided_dbh = shift;
714 my $dbh = $provided_dbh || $self->dbconnect(1);
716 $::lxdebug->leave_sub && return unless $dbh && $session_id;
718 $dbh->begin_work unless $provided_dbh;
720 # If this fails then the "auth" schema might not exist yet, e.g. if
721 # the admin is just trying to create the auth database.
722 if (!$dbh->do(qq|LOCK auth.session_content|)) {
723 $dbh->rollback unless $provided_dbh;
724 $::lxdebug->leave_sub;
728 my @unfetched_keys = map { $_->{key} }
729 grep { ! $_->{fetched} }
730 values %{ $self->{SESSION} };
731 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
732 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
733 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
734 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
736 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
738 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
741 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
743 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
746 my @values_to_save = grep { $_->{fetched} }
747 values %{ $self->{SESSION} };
748 if (@values_to_save) {
749 my ($columns, $placeholders) = ('', '');
750 my $auto_restore = $self->{column_information}->has('auto_restore');
753 $columns .= ', auto_restore';
754 $placeholders .= ', ?';
757 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
758 my $sth = prepare_query($::form, $dbh, $query);
760 foreach my $value (@values_to_save) {
761 my @values = ($value->{key}, $value->get_dumped);
762 push @values, $value->{auto_restore} if $auto_restore;
764 do_statement($::form, $sth, $query, $session_id, @values);
770 $dbh->commit() unless $provided_dbh;
771 $::lxdebug->leave_sub;
774 sub set_session_value {
775 $main::lxdebug->enter_sub();
780 $self->{SESSION} ||= { };
783 my $key = shift @params;
785 if (ref $key eq 'HASH') {
786 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
787 value => $key->{value},
788 auto_restore => $key->{auto_restore});
791 my $value = shift @params;
792 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
797 $main::lxdebug->leave_sub();
802 sub delete_session_value {
803 $main::lxdebug->enter_sub();
807 $self->{SESSION} ||= { };
808 delete @{ $self->{SESSION} }{ @_ };
810 $main::lxdebug->leave_sub();
815 sub get_session_value {
816 $main::lxdebug->enter_sub();
819 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
821 $main::lxdebug->leave_sub();
826 sub create_unique_sesion_value {
827 my ($self, $value, %params) = @_;
829 $self->{SESSION} ||= { };
831 my @now = gettimeofday();
832 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
833 $self->{unique_counter} ||= 0;
837 $self->{unique_counter}++;
838 $hashed_key = md5_hex($key . $self->{unique_counter});
839 } while (exists $self->{SESSION}->{$hashed_key});
841 $self->set_session_value($hashed_key => $value);
846 sub save_form_in_session {
847 my ($self, %params) = @_;
849 my $form = delete($params{form}) || $::form;
850 my $non_scalars = delete $params{non_scalars};
853 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
855 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
856 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
859 return $self->create_unique_sesion_value($data, %params);
862 sub restore_form_from_session {
863 my ($self, $key, %params) = @_;
865 my $data = $self->get_session_value($key);
866 return $self unless $data;
868 my $form = delete($params{form}) || $::form;
869 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
871 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
876 sub set_cookie_environment_variable {
878 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
881 sub get_session_cookie_name {
884 return $self->{cookie_name} || 'lx_office_erp_session_id';
891 sub session_tables_present {
892 $main::lxdebug->enter_sub();
896 # Only re-check for the presence of auth tables if either the check
897 # hasn't been done before of if they weren't present.
898 if ($self->{session_tables_present}) {
899 $main::lxdebug->leave_sub();
900 return $self->{session_tables_present};
903 my $dbh = $self->dbconnect(1);
906 $main::lxdebug->leave_sub();
913 WHERE (schemaname = 'auth')
914 AND (tablename IN ('session', 'session_content'))|;
916 my ($count) = selectrow_query($main::form, $dbh, $query);
918 $self->{session_tables_present} = 2 == $count;
920 $main::lxdebug->leave_sub();
922 return $self->{session_tables_present};
925 # --------------------------------------
927 sub all_rights_full {
928 my $locale = $main::locale;
931 ["--crm", $locale->text("CRM optional software")],
932 ["crm_search", $locale->text("CRM search")],
933 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
934 ["crm_service", $locale->text("CRM services")],
935 ["crm_admin", $locale->text("CRM admin")],
936 ["crm_adminuser", $locale->text("CRM user")],
937 ["crm_adminstatus", $locale->text("CRM status")],
938 ["crm_email", $locale->text("CRM send email")],
939 ["crm_termin", $locale->text("CRM termin")],
940 ["crm_opportunity", $locale->text("CRM opportunity")],
941 ["crm_knowhow", $locale->text("CRM know how")],
942 ["crm_follow", $locale->text("CRM follow up")],
943 ["crm_notices", $locale->text("CRM notices")],
944 ["crm_other", $locale->text("CRM other")],
945 ["--master_data", $locale->text("Master Data")],
946 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
947 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
948 ["project_edit", $locale->text("Create and edit projects")],
949 ["--ar", $locale->text("AR")],
950 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
951 ["sales_order_edit", $locale->text("Create and edit sales orders")],
952 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
953 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
954 ["dunning_edit", $locale->text("Create and edit dunnings")],
955 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
956 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
957 ["--ap", $locale->text("AP")],
958 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
959 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
960 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
961 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
962 ["--warehouse_management", $locale->text("Warehouse management")],
963 ["warehouse_contents", $locale->text("View warehouse content")],
964 ["warehouse_management", $locale->text("Warehouse management")],
965 ["--general_ledger_cash", $locale->text("General ledger and cash")],
966 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
967 ["datev_export", $locale->text("DATEV Export")],
968 ["cash", $locale->text("Receipt, payment, reconciliation")],
969 ["--reports", $locale->text('Reports')],
970 ["report", $locale->text('All reports')],
971 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
972 ["--batch_printing", $locale->text("Batch Printing")],
973 ["batch_printing", $locale->text("Batch Printing")],
974 ["--others", $locale->text("Others")],
975 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
976 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
983 return grep !/^--/, map { $_->[0] } all_rights_full();
987 $main::lxdebug->enter_sub();
991 my $form = $main::form;
993 my $dbh = $self->dbconnect();
995 my $query = 'SELECT * FROM auth."group"';
996 my $sth = prepare_execute_query($form, $dbh, $query);
1000 while ($row = $sth->fetchrow_hashref()) {
1001 $groups->{$row->{id}} = $row;
1005 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1006 $sth = prepare_query($form, $dbh, $query);
1008 foreach $group (values %{$groups}) {
1011 do_statement($form, $sth, $query, $group->{id});
1013 while ($row = $sth->fetchrow_hashref()) {
1014 push @members, $row->{user_id};
1016 $group->{members} = [ uniq @members ];
1020 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1021 $sth = prepare_query($form, $dbh, $query);
1023 foreach $group (values %{$groups}) {
1024 $group->{rights} = {};
1026 do_statement($form, $sth, $query, $group->{id});
1028 while ($row = $sth->fetchrow_hashref()) {
1029 $group->{rights}->{$row->{right}} |= $row->{granted};
1032 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1036 $main::lxdebug->leave_sub();
1042 $main::lxdebug->enter_sub();
1047 my $form = $main::form;
1048 my $dbh = $self->dbconnect();
1052 my ($query, $sth, $row, $rights);
1054 if (!$group->{id}) {
1055 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1057 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1058 do_query($form, $dbh, $query, $group->{id});
1061 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1063 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1065 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1066 $sth = prepare_query($form, $dbh, $query);
1068 foreach my $user_id (uniq @{ $group->{members} }) {
1069 do_statement($form, $sth, $query, $user_id, $group->{id});
1073 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1075 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1076 $sth = prepare_query($form, $dbh, $query);
1078 foreach my $right (keys %{ $group->{rights} }) {
1079 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1085 $main::lxdebug->leave_sub();
1089 $main::lxdebug->enter_sub();
1094 my $form = $main::form;
1096 my $dbh = $self->dbconnect();
1099 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1100 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1101 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1105 $main::lxdebug->leave_sub();
1108 sub evaluate_rights_ary {
1109 $main::lxdebug->enter_sub(2);
1116 foreach my $el (@{$ary}) {
1117 if (ref $el eq "ARRAY") {
1118 if ($action eq '|') {
1119 $value |= evaluate_rights_ary($el);
1121 $value &= evaluate_rights_ary($el);
1124 } elsif (($el eq '&') || ($el eq '|')) {
1127 } elsif ($action eq '|') {
1136 $main::lxdebug->leave_sub(2);
1141 sub _parse_rights_string {
1142 $main::lxdebug->enter_sub(2);
1152 push @stack, $cur_ary;
1154 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1156 substr($access, 0, length $1) = "";
1158 next if ($token =~ /\s/);
1160 if ($token eq "(") {
1161 my $new_cur_ary = [];
1162 push @stack, $new_cur_ary;
1163 push @{$cur_ary}, $new_cur_ary;
1164 $cur_ary = $new_cur_ary;
1166 } elsif ($token eq ")") {
1170 $main::lxdebug->leave_sub(2);
1174 $cur_ary = $stack[-1];
1176 } elsif (($token eq "|") || ($token eq "&")) {
1177 push @{$cur_ary}, $token;
1180 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1184 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1186 $main::lxdebug->leave_sub(2);
1192 $main::lxdebug->enter_sub(2);
1197 my $default = shift;
1199 $self->{FULL_RIGHTS} ||= { };
1200 $self->{FULL_RIGHTS}->{$login} ||= { };
1202 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1203 $self->{RIGHTS} ||= { };
1204 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1206 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1209 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1210 $granted = $default if (!defined $granted);
1212 $main::lxdebug->leave_sub(2);
1218 $::lxdebug->enter_sub(2);
1219 my ($self, $right, $dont_abort) = @_;
1221 if ($self->check_right($::myconfig{login}, $right)) {
1222 $::lxdebug->leave_sub(2);
1227 delete $::form->{title};
1228 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1231 $::lxdebug->leave_sub(2);
1236 sub load_rights_for_user {
1237 $::lxdebug->enter_sub;
1239 my ($self, $login) = @_;
1240 my $dbh = $self->dbconnect;
1241 my ($query, $sth, $row, $rights);
1243 $rights = { map { $_ => 0 } all_rights() };
1246 qq|SELECT gr."right", gr.granted
1247 FROM auth.group_rights gr
1250 FROM auth.user_group ug
1251 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1252 WHERE u.login = ?)|;
1254 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1256 while ($row = $sth->fetchrow_hashref()) {
1257 $rights->{$row->{right}} |= $row->{granted};
1261 $::lxdebug->leave_sub;
1275 SL::Auth - Authentication and session handling
1281 =item C<set_session_value @values>
1282 =item C<set_session_value %values>
1284 Store all values of C<@values> or C<%values> in the session. Each
1285 member of C<@values> is tested if it is a hash reference. If it is
1286 then it must contain the keys C<key> and C<value> and can optionally
1287 contain the key C<auto_restore>. In this case C<value> is associated
1288 with C<key> and restored to C<$::form> upon the next request
1289 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1292 If the current member of C<@values> is not a hash reference then it
1293 will be used as the C<key> and the next entry of C<@values> is used as
1294 the C<value> to store. In this case setting C<auto_restore> is not
1297 Therefore the following two invocations are identical:
1299 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1300 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1302 All of these values are copied back into C<$::form> for the next
1303 request automatically if they're scalar values or if they have
1304 C<auto_restore> set to trueish.
1306 The values can be any Perl structure. They are stored as YAML dumps.
1308 =item C<get_session_value $key>
1310 Retrieve a value from the session. Returns C<undef> if the value
1313 =item C<create_unique_sesion_value $value, %params>
1315 Create a unique key in the session and store C<$value>
1318 Returns the key created in the session.
1320 =item C<save_session>
1322 Stores the session values in the database. This is the only function
1323 that actually stores stuff in the database. Neither the various
1324 setters nor the deleter access the database.
1326 =item <save_form_in_session %params>
1328 Stores the content of C<$params{form}> (default: C<$::form>) in the
1329 session using L</create_unique_sesion_value>.
1331 If C<$params{non_scalars}> is trueish then non-scalar values will be
1332 stored as well. Default is to only store scalar values.
1334 The following keys will never be saved: C<login>, C<password>,
1335 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1336 can be given as an array ref in C<$params{skip_keys}>.
1338 Returns the unique key under which the form is stored.
1340 =item <restore_form_from_session $key, %params>
1342 Restores the form from the session into C<$params{form}> (default:
1345 If C<$params{clobber}> is falsish then existing values with the same
1346 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1359 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>