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);
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} };
105 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
106 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
108 if ($self->{module} eq 'DB') {
109 $self->{authenticator} = SL::Auth::DB->new($self);
111 } elsif ($self->{module} eq 'LDAP') {
112 $self->{authenticator} = SL::Auth::LDAP->new($self);
115 if (!$self->{authenticator}) {
116 my $locale = Locale->new('en');
117 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
120 my $cfg = $self->{DB_config};
123 my $locale = Locale->new('en');
124 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
127 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
128 my $locale = Locale->new('en');
129 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
132 $self->{authenticator}->verify_config();
134 $self->{session_timeout} *= 1;
135 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
137 $main::lxdebug->leave_sub();
140 sub authenticate_root {
141 $main::lxdebug->enter_sub();
143 my ($self, $password) = @_;
145 $password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
146 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password});
148 $main::lxdebug->leave_sub();
150 return OK if $password eq $admin_password;
156 $main::lxdebug->enter_sub();
158 my ($self, $login, $password) = @_;
160 $main::lxdebug->leave_sub();
162 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
163 return OK if $result eq OK;
168 sub store_credentials_in_session {
169 my ($self, %params) = @_;
171 if (!$self->{authenticator}->requires_cleartext_password) {
172 $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login},
173 password => $params{password},
174 look_up_algorithm => 1,
178 $self->set_session_value(login => $params{login}, password => $params{password});
181 sub store_root_credentials_in_session {
182 my ($self, $rpw) = @_;
184 $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
187 sub get_stored_password {
188 my ($self, $login) = @_;
190 my $dbh = $self->dbconnect;
192 return undef unless $dbh;
194 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
195 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
197 return $stored_password;
201 $main::lxdebug->enter_sub(2);
204 my $may_fail = shift;
207 $main::lxdebug->leave_sub(2);
211 my $cfg = $self->{DB_config};
212 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
215 $dsn .= ';port=' . $cfg->{port};
218 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
220 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
222 if (!$may_fail && !$self->{dbh}) {
223 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
226 $main::lxdebug->leave_sub(2);
232 $main::lxdebug->enter_sub();
237 $self->{dbh}->disconnect();
241 $main::lxdebug->leave_sub();
245 $main::lxdebug->enter_sub();
249 my $dbh = $self->dbconnect();
250 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
252 my ($count) = $dbh->selectrow_array($query);
254 $main::lxdebug->leave_sub();
260 $main::lxdebug->enter_sub();
264 my $dbh = $self->dbconnect(1);
266 $main::lxdebug->leave_sub();
271 sub create_database {
272 $main::lxdebug->enter_sub();
277 my $cfg = $self->{DB_config};
279 if (!$params{superuser}) {
280 $params{superuser} = $cfg->{user};
281 $params{superuser_password} = $cfg->{password};
284 $params{template} ||= 'template0';
285 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
287 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
290 $dsn .= ';port=' . $cfg->{port};
293 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
295 my $charset = $::lx_office_conf{system}->{dbcharset};
296 $charset ||= Common::DEFAULT_CHARSET;
297 my $encoding = $Common::charset_to_db_encoding{$charset};
298 $encoding ||= 'UNICODE';
300 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
303 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
306 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
308 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
313 my $error = $dbh->errstr();
315 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
316 my ($cluster_encoding) = $dbh->selectrow_array($query);
318 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
319 $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.');
324 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
329 $main::lxdebug->leave_sub();
333 $main::lxdebug->enter_sub();
336 my $dbh = $self->dbconnect();
338 my $charset = $::lx_office_conf{system}->{dbcharset};
339 $charset ||= Common::DEFAULT_CHARSET;
342 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
344 $main::lxdebug->leave_sub();
348 $main::lxdebug->enter_sub();
354 my $form = $main::form;
356 my $dbh = $self->dbconnect();
358 my ($sth, $query, $user_id);
362 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
363 ($user_id) = selectrow_query($form, $dbh, $query, $login);
366 $query = qq|SELECT nextval('auth.user_id_seq')|;
367 ($user_id) = selectrow_query($form, $dbh, $query);
369 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
370 do_query($form, $dbh, $query, $user_id, $login);
373 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
374 do_query($form, $dbh, $query, $user_id);
376 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
377 $sth = prepare_query($form, $dbh, $query);
379 while (my ($cfg_key, $cfg_value) = each %params) {
380 next if ($cfg_key eq 'password');
382 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
387 $main::lxdebug->leave_sub();
390 sub can_change_password {
393 return $self->{authenticator}->can_change_password();
396 sub change_password {
397 $main::lxdebug->enter_sub();
399 my ($self, $login, $new_password) = @_;
401 my $result = $self->{authenticator}->change_password($login, $new_password);
403 $self->store_credentials_in_session(login => $login,
404 password => $new_password,
405 look_up_algorithm => 1,
408 $main::lxdebug->leave_sub();
414 $main::lxdebug->enter_sub();
418 my $dbh = $self->dbconnect();
419 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
420 FROM auth.user_config cfg
421 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
422 my $sth = prepare_execute_query($main::form, $dbh, $query);
426 while (my $ref = $sth->fetchrow_hashref()) {
427 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
428 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
433 $main::lxdebug->leave_sub();
439 $main::lxdebug->enter_sub();
444 my $dbh = $self->dbconnect();
445 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
446 FROM auth.user_config cfg
447 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
448 WHERE (u.login = ?)|;
449 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
453 while (my $ref = $sth->fetchrow_hashref()) {
454 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
455 @user_data{qw(id login)} = @{$ref}{qw(id login)};
460 $main::lxdebug->leave_sub();
466 $main::lxdebug->enter_sub();
471 my $dbh = $self->dbconnect();
472 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
474 $main::lxdebug->leave_sub();
480 $::lxdebug->enter_sub;
485 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
486 my $dbh = $self->dbconnect;
490 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
492 my ($id) = selectrow_query($::form, $dbh, $query, $login);
494 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
496 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
497 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
498 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
501 $u_dbh->commit if $u_dbh;
503 $::lxdebug->leave_sub;
506 # --------------------------------------
510 sub restore_session {
511 $main::lxdebug->enter_sub();
515 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
516 $session_id =~ s|[^0-9a-f]||g if $session_id;
518 $self->{SESSION} = { };
521 $main::lxdebug->leave_sub();
525 my ($dbh, $query, $sth, $cookie, $ref, $form);
529 # Don't fail if the auth DB doesn't yet.
530 if (!( $dbh = $self->dbconnect(1) )) {
531 $::lxdebug->leave_sub;
535 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
536 # admin is creating the session tables at the moment.
537 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
539 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
540 $sth->finish if $sth;
541 $::lxdebug->leave_sub;
545 $cookie = $sth->fetchrow_hashref;
548 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
549 $self->destroy_session();
550 $main::lxdebug->leave_sub();
551 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
554 if ($self->{column_information}->has('auto_restore')) {
555 $self->_load_with_auto_restore_column($dbh, $session_id);
557 $self->_load_without_auto_restore_column($dbh, $session_id);
560 $main::lxdebug->leave_sub();
565 sub _load_without_auto_restore_column {
566 my ($self, $dbh, $session_id) = @_;
569 SELECT sess_key, sess_value
570 FROM auth.session_content
571 WHERE (session_id = ?)
573 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
575 while (my $ref = $sth->fetchrow_hashref) {
576 my $value = SL::Auth::SessionValue->new(auth => $self,
577 key => $ref->{sess_key},
578 value => $ref->{sess_value},
580 $self->{SESSION}->{ $ref->{sess_key} } = $value;
582 next if defined $::form->{$ref->{sess_key}};
584 my $data = $value->get;
585 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
589 sub _load_with_auto_restore_column {
590 my ($self, $dbh, $session_id) = @_;
592 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
595 SELECT sess_key, sess_value, auto_restore
596 FROM auth.session_content
597 WHERE (session_id = ?)
599 OR sess_key IN (${auto_restore_keys}))
601 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
603 while (my $ref = $sth->fetchrow_hashref) {
604 my $value = SL::Auth::SessionValue->new(auth => $self,
605 key => $ref->{sess_key},
606 value => $ref->{sess_value},
607 auto_restore => $ref->{auto_restore},
609 $self->{SESSION}->{ $ref->{sess_key} } = $value;
611 next if defined $::form->{$ref->{sess_key}};
613 my $data = $value->get;
614 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
621 FROM auth.session_content
622 WHERE (session_id = ?)
623 AND NOT COALESCE(auto_restore, FALSE)
624 AND (sess_key NOT IN (${auto_restore_keys}))
626 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
628 while (my $ref = $sth->fetchrow_hashref) {
629 my $value = SL::Auth::SessionValue->new(auth => $self,
630 key => $ref->{sess_key});
631 $self->{SESSION}->{ $ref->{sess_key} } = $value;
635 sub destroy_session {
636 $main::lxdebug->enter_sub();
641 my $dbh = $self->dbconnect();
645 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
646 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
650 SL::SessionFile->destroy_session($session_id);
653 $self->{SESSION} = { };
656 $main::lxdebug->leave_sub();
659 sub expire_sessions {
660 $main::lxdebug->enter_sub();
664 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
666 my $dbh = $self->dbconnect();
668 my $query = qq|SELECT id
670 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
672 my @ids = selectall_array_query($::form, $dbh, $query);
677 SL::SessionFile->destroy_session($_) for @ids;
679 $query = qq|DELETE FROM auth.session_content
680 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
681 do_query($main::form, $dbh, $query, @ids);
683 $query = qq|DELETE FROM auth.session
684 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
685 do_query($main::form, $dbh, $query, @ids);
690 $main::lxdebug->leave_sub();
693 sub _create_session_id {
694 $main::lxdebug->enter_sub();
697 map { push @data, int(rand() * 255); } (1..32);
699 my $id = md5_hex(pack 'C*', @data);
701 $main::lxdebug->leave_sub();
706 sub create_or_refresh_session {
707 $session_id ||= shift->_create_session_id;
711 $::lxdebug->enter_sub;
713 my $provided_dbh = shift;
715 my $dbh = $provided_dbh || $self->dbconnect(1);
717 $::lxdebug->leave_sub && return unless $dbh && $session_id;
719 $dbh->begin_work unless $provided_dbh;
721 # If this fails then the "auth" schema might not exist yet, e.g. if
722 # the admin is just trying to create the auth database.
723 if (!$dbh->do(qq|LOCK auth.session_content|)) {
724 $dbh->rollback unless $provided_dbh;
725 $::lxdebug->leave_sub;
729 my @unfetched_keys = map { $_->{key} }
730 grep { ! $_->{fetched} }
731 values %{ $self->{SESSION} };
732 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
733 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
734 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
735 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
737 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
739 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
742 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
744 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
747 my @values_to_save = grep { $_->{fetched} }
748 values %{ $self->{SESSION} };
749 if (@values_to_save) {
750 my ($columns, $placeholders) = ('', '');
751 my $auto_restore = $self->{column_information}->has('auto_restore');
754 $columns .= ', auto_restore';
755 $placeholders .= ', ?';
758 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
759 my $sth = prepare_query($::form, $dbh, $query);
761 foreach my $value (@values_to_save) {
762 my @values = ($value->{key}, $value->get_dumped);
763 push @values, $value->{auto_restore} if $auto_restore;
765 do_statement($::form, $sth, $query, $session_id, @values);
771 $dbh->commit() unless $provided_dbh;
772 $::lxdebug->leave_sub;
775 sub set_session_value {
776 $main::lxdebug->enter_sub();
781 $self->{SESSION} ||= { };
784 my $key = shift @params;
786 if (ref $key eq 'HASH') {
787 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
788 value => $key->{value},
789 auto_restore => $key->{auto_restore});
792 my $value = shift @params;
793 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
798 $main::lxdebug->leave_sub();
803 sub delete_session_value {
804 $main::lxdebug->enter_sub();
808 $self->{SESSION} ||= { };
809 delete @{ $self->{SESSION} }{ @_ };
811 $main::lxdebug->leave_sub();
816 sub get_session_value {
817 $main::lxdebug->enter_sub();
820 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
822 $main::lxdebug->leave_sub();
827 sub create_unique_sesion_value {
828 my ($self, $value, %params) = @_;
830 $self->{SESSION} ||= { };
832 my @now = gettimeofday();
833 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
834 $self->{unique_counter} ||= 0;
838 $self->{unique_counter}++;
839 $hashed_key = md5_hex($key . $self->{unique_counter});
840 } while (exists $self->{SESSION}->{$hashed_key});
842 $self->set_session_value($hashed_key => $value);
847 sub save_form_in_session {
848 my ($self, %params) = @_;
850 my $form = delete($params{form}) || $::form;
851 my $non_scalars = delete $params{non_scalars};
854 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
856 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
857 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
860 return $self->create_unique_sesion_value($data, %params);
863 sub restore_form_from_session {
864 my ($self, $key, %params) = @_;
866 my $data = $self->get_session_value($key);
867 return $self unless $data;
869 my $form = delete($params{form}) || $::form;
870 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
872 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
877 sub set_cookie_environment_variable {
879 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
882 sub get_session_cookie_name {
885 return $self->{cookie_name} || 'lx_office_erp_session_id';
892 sub session_tables_present {
893 $main::lxdebug->enter_sub();
897 # Only re-check for the presence of auth tables if either the check
898 # hasn't been done before of if they weren't present.
899 if ($self->{session_tables_present}) {
900 $main::lxdebug->leave_sub();
901 return $self->{session_tables_present};
904 my $dbh = $self->dbconnect(1);
907 $main::lxdebug->leave_sub();
914 WHERE (schemaname = 'auth')
915 AND (tablename IN ('session', 'session_content'))|;
917 my ($count) = selectrow_query($main::form, $dbh, $query);
919 $self->{session_tables_present} = 2 == $count;
921 $main::lxdebug->leave_sub();
923 return $self->{session_tables_present};
926 # --------------------------------------
928 sub all_rights_full {
929 my $locale = $main::locale;
932 ["--crm", $locale->text("CRM optional software")],
933 ["crm_search", $locale->text("CRM search")],
934 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
935 ["crm_service", $locale->text("CRM services")],
936 ["crm_admin", $locale->text("CRM admin")],
937 ["crm_adminuser", $locale->text("CRM user")],
938 ["crm_adminstatus", $locale->text("CRM status")],
939 ["crm_email", $locale->text("CRM send email")],
940 ["crm_termin", $locale->text("CRM termin")],
941 ["crm_opportunity", $locale->text("CRM opportunity")],
942 ["crm_knowhow", $locale->text("CRM know how")],
943 ["crm_follow", $locale->text("CRM follow up")],
944 ["crm_notices", $locale->text("CRM notices")],
945 ["crm_other", $locale->text("CRM other")],
946 ["--master_data", $locale->text("Master Data")],
947 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
948 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
949 ["project_edit", $locale->text("Create and edit projects")],
950 ["--ar", $locale->text("AR")],
951 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
952 ["sales_order_edit", $locale->text("Create and edit sales orders")],
953 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
954 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
955 ["dunning_edit", $locale->text("Create and edit dunnings")],
956 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
957 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
958 ["--ap", $locale->text("AP")],
959 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
960 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
961 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
962 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
963 ["--warehouse_management", $locale->text("Warehouse management")],
964 ["warehouse_contents", $locale->text("View warehouse content")],
965 ["warehouse_management", $locale->text("Warehouse management")],
966 ["--general_ledger_cash", $locale->text("General ledger and cash")],
967 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
968 ["datev_export", $locale->text("DATEV Export")],
969 ["cash", $locale->text("Receipt, payment, reconciliation")],
970 ["--reports", $locale->text('Reports')],
971 ["report", $locale->text('All reports')],
972 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
973 ["--batch_printing", $locale->text("Batch Printing")],
974 ["batch_printing", $locale->text("Batch Printing")],
975 ["--others", $locale->text("Others")],
976 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
977 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
984 return grep !/^--/, map { $_->[0] } all_rights_full();
988 $main::lxdebug->enter_sub();
992 my $form = $main::form;
994 my $dbh = $self->dbconnect();
996 my $query = 'SELECT * FROM auth."group"';
997 my $sth = prepare_execute_query($form, $dbh, $query);
1001 while ($row = $sth->fetchrow_hashref()) {
1002 $groups->{$row->{id}} = $row;
1006 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1007 $sth = prepare_query($form, $dbh, $query);
1009 foreach $group (values %{$groups}) {
1012 do_statement($form, $sth, $query, $group->{id});
1014 while ($row = $sth->fetchrow_hashref()) {
1015 push @members, $row->{user_id};
1017 $group->{members} = [ uniq @members ];
1021 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1022 $sth = prepare_query($form, $dbh, $query);
1024 foreach $group (values %{$groups}) {
1025 $group->{rights} = {};
1027 do_statement($form, $sth, $query, $group->{id});
1029 while ($row = $sth->fetchrow_hashref()) {
1030 $group->{rights}->{$row->{right}} |= $row->{granted};
1033 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1037 $main::lxdebug->leave_sub();
1043 $main::lxdebug->enter_sub();
1048 my $form = $main::form;
1049 my $dbh = $self->dbconnect();
1053 my ($query, $sth, $row, $rights);
1055 if (!$group->{id}) {
1056 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1058 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1059 do_query($form, $dbh, $query, $group->{id});
1062 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1064 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1066 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1067 $sth = prepare_query($form, $dbh, $query);
1069 foreach my $user_id (uniq @{ $group->{members} }) {
1070 do_statement($form, $sth, $query, $user_id, $group->{id});
1074 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1076 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1077 $sth = prepare_query($form, $dbh, $query);
1079 foreach my $right (keys %{ $group->{rights} }) {
1080 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1086 $main::lxdebug->leave_sub();
1090 $main::lxdebug->enter_sub();
1095 my $form = $main::form;
1097 my $dbh = $self->dbconnect();
1100 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1101 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1102 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1106 $main::lxdebug->leave_sub();
1109 sub evaluate_rights_ary {
1110 $main::lxdebug->enter_sub(2);
1117 foreach my $el (@{$ary}) {
1118 if (ref $el eq "ARRAY") {
1119 if ($action eq '|') {
1120 $value |= evaluate_rights_ary($el);
1122 $value &= evaluate_rights_ary($el);
1125 } elsif (($el eq '&') || ($el eq '|')) {
1128 } elsif ($action eq '|') {
1137 $main::lxdebug->leave_sub(2);
1142 sub _parse_rights_string {
1143 $main::lxdebug->enter_sub(2);
1153 push @stack, $cur_ary;
1155 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1157 substr($access, 0, length $1) = "";
1159 next if ($token =~ /\s/);
1161 if ($token eq "(") {
1162 my $new_cur_ary = [];
1163 push @stack, $new_cur_ary;
1164 push @{$cur_ary}, $new_cur_ary;
1165 $cur_ary = $new_cur_ary;
1167 } elsif ($token eq ")") {
1171 $main::lxdebug->leave_sub(2);
1175 $cur_ary = $stack[-1];
1177 } elsif (($token eq "|") || ($token eq "&")) {
1178 push @{$cur_ary}, $token;
1181 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1185 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1187 $main::lxdebug->leave_sub(2);
1193 $main::lxdebug->enter_sub(2);
1198 my $default = shift;
1200 $self->{FULL_RIGHTS} ||= { };
1201 $self->{FULL_RIGHTS}->{$login} ||= { };
1203 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1204 $self->{RIGHTS} ||= { };
1205 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1207 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1210 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1211 $granted = $default if (!defined $granted);
1213 $main::lxdebug->leave_sub(2);
1219 $::lxdebug->enter_sub(2);
1220 my ($self, $right, $dont_abort) = @_;
1222 if ($self->check_right($::myconfig{login}, $right)) {
1223 $::lxdebug->leave_sub(2);
1228 delete $::form->{title};
1229 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1232 $::lxdebug->leave_sub(2);
1237 sub load_rights_for_user {
1238 $::lxdebug->enter_sub;
1240 my ($self, $login) = @_;
1241 my $dbh = $self->dbconnect;
1242 my ($query, $sth, $row, $rights);
1244 $rights = { map { $_ => 0 } all_rights() };
1247 qq|SELECT gr."right", gr.granted
1248 FROM auth.group_rights gr
1251 FROM auth.user_group ug
1252 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1253 WHERE u.login = ?)|;
1255 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1257 while ($row = $sth->fetchrow_hashref()) {
1258 $rights->{$row->{right}} |= $row->{granted};
1262 $::lxdebug->leave_sub;
1276 SL::Auth - Authentication and session handling
1282 =item C<set_session_value @values>
1283 =item C<set_session_value %values>
1285 Store all values of C<@values> or C<%values> in the session. Each
1286 member of C<@values> is tested if it is a hash reference. If it is
1287 then it must contain the keys C<key> and C<value> and can optionally
1288 contain the key C<auto_restore>. In this case C<value> is associated
1289 with C<key> and restored to C<$::form> upon the next request
1290 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1293 If the current member of C<@values> is not a hash reference then it
1294 will be used as the C<key> and the next entry of C<@values> is used as
1295 the C<value> to store. In this case setting C<auto_restore> is not
1298 Therefore the following two invocations are identical:
1300 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1301 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1303 All of these values are copied back into C<$::form> for the next
1304 request automatically if they're scalar values or if they have
1305 C<auto_restore> set to trueish.
1307 The values can be any Perl structure. They are stored as YAML dumps.
1309 =item C<get_session_value $key>
1311 Retrieve a value from the session. Returns C<undef> if the value
1314 =item C<create_unique_sesion_value $value, %params>
1316 Create a unique key in the session and store C<$value>
1319 Returns the key created in the session.
1321 =item C<save_session>
1323 Stores the session values in the database. This is the only function
1324 that actually stores stuff in the database. Neither the various
1325 setters nor the deleter access the database.
1327 =item <save_form_in_session %params>
1329 Stores the content of C<$params{form}> (default: C<$::form>) in the
1330 session using L</create_unique_sesion_value>.
1332 If C<$params{non_scalars}> is trueish then non-scalar values will be
1333 stored as well. Default is to only store scalar values.
1335 The following keys will never be saved: C<login>, C<password>,
1336 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1337 can be given as an array ref in C<$params{skip_keys}>.
1339 Returns the unique key under which the form is stored.
1341 =item <restore_form_from_session $key, %params>
1343 Restores the form from the session into C<$params{form}> (default:
1346 If C<$params{clobber}> is falsish then existing values with the same
1347 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1360 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>