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 my $cgi = $main::cgi;
515 $cgi ||= CGI->new('');
517 $session_id = $cgi->cookie($self->get_session_cookie_name());
518 $session_id =~ s|[^0-9a-f]||g;
520 $self->{SESSION} = { };
523 $main::lxdebug->leave_sub();
527 my ($dbh, $query, $sth, $cookie, $ref, $form);
531 $dbh = $self->dbconnect();
532 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
534 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
536 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
537 $self->destroy_session();
538 $main::lxdebug->leave_sub();
539 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
542 if ($self->{column_information}->has('auto_restore')) {
543 $self->_load_with_auto_restore_column($dbh, $session_id);
545 $self->_load_without_auto_restore_column($dbh, $session_id);
548 $main::lxdebug->leave_sub();
553 sub _load_without_auto_restore_column {
554 my ($self, $dbh, $session_id) = @_;
557 SELECT sess_key, sess_value
558 FROM auth.session_content
559 WHERE (session_id = ?)
561 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
563 while (my $ref = $sth->fetchrow_hashref) {
564 my $value = SL::Auth::SessionValue->new(auth => $self,
565 key => $ref->{sess_key},
566 value => $ref->{sess_value},
568 $self->{SESSION}->{ $ref->{sess_key} } = $value;
570 next if defined $::form->{$ref->{sess_key}};
572 my $data = $value->get;
573 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
577 sub _load_with_auto_restore_column {
578 my ($self, $dbh, $session_id) = @_;
580 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
583 SELECT sess_key, sess_value, auto_restore
584 FROM auth.session_content
585 WHERE (session_id = ?)
587 OR sess_key IN (${auto_restore_keys}))
589 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
591 while (my $ref = $sth->fetchrow_hashref) {
592 my $value = SL::Auth::SessionValue->new(auth => $self,
593 key => $ref->{sess_key},
594 value => $ref->{sess_value},
595 auto_restore => $ref->{auto_restore},
597 $self->{SESSION}->{ $ref->{sess_key} } = $value;
599 next if defined $::form->{$ref->{sess_key}};
601 my $data = $value->get;
602 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
609 FROM auth.session_content
610 WHERE (session_id = ?)
611 AND NOT COALESCE(auto_restore, FALSE)
612 AND (sess_key NOT IN (${auto_restore_keys}))
614 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
616 while (my $ref = $sth->fetchrow_hashref) {
617 my $value = SL::Auth::SessionValue->new(auth => $self,
618 key => $ref->{sess_key});
619 $self->{SESSION}->{ $ref->{sess_key} } = $value;
623 sub destroy_session {
624 $main::lxdebug->enter_sub();
629 my $dbh = $self->dbconnect();
633 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
634 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
638 SL::SessionFile->destroy_session($session_id);
641 $self->{SESSION} = { };
644 $main::lxdebug->leave_sub();
647 sub expire_sessions {
648 $main::lxdebug->enter_sub();
652 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
654 my $dbh = $self->dbconnect();
656 my $query = qq|SELECT id
658 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
660 my @ids = selectall_array_query($::form, $dbh, $query);
665 SL::SessionFile->destroy_session($_) for @ids;
667 $query = qq|DELETE FROM auth.session_content
668 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
669 do_query($main::form, $dbh, $query, @ids);
671 $query = qq|DELETE FROM auth.session
672 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
673 do_query($main::form, $dbh, $query, @ids);
678 $main::lxdebug->leave_sub();
681 sub _create_session_id {
682 $main::lxdebug->enter_sub();
685 map { push @data, int(rand() * 255); } (1..32);
687 my $id = md5_hex(pack 'C*', @data);
689 $main::lxdebug->leave_sub();
694 sub create_or_refresh_session {
695 $session_id ||= shift->_create_session_id;
699 $::lxdebug->enter_sub;
701 my $provided_dbh = shift;
703 my $dbh = $provided_dbh || $self->dbconnect(1);
705 $::lxdebug->leave_sub && return unless $dbh && $session_id;
707 $dbh->begin_work unless $provided_dbh;
709 do_query($::form, $dbh, qq|LOCK auth.session_content|);
711 my @unfetched_keys = map { $_->{key} }
712 grep { ! $_->{fetched} }
713 values %{ $self->{SESSION} };
714 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
715 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
716 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
717 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
719 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
721 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
724 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
726 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
729 my @values_to_save = grep { $_->{fetched} }
730 values %{ $self->{SESSION} };
731 if (@values_to_save) {
732 my ($columns, $placeholders) = ('', '');
733 my $auto_restore = $self->{column_information}->has('auto_restore');
736 $columns .= ', auto_restore';
737 $placeholders .= ', ?';
740 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
741 my $sth = prepare_query($::form, $dbh, $query);
743 foreach my $value (@values_to_save) {
744 my @values = ($value->{key}, $value->get_dumped);
745 push @values, $value->{auto_restore} if $auto_restore;
747 do_statement($::form, $sth, $query, $session_id, @values);
753 $dbh->commit() unless $provided_dbh;
754 $::lxdebug->leave_sub;
757 sub set_session_value {
758 $main::lxdebug->enter_sub();
763 $self->{SESSION} ||= { };
766 my $key = shift @params;
768 if (ref $key eq 'HASH') {
769 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
770 value => $key->{value},
771 auto_restore => $key->{auto_restore});
774 my $value = shift @params;
775 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
780 $main::lxdebug->leave_sub();
785 sub delete_session_value {
786 $main::lxdebug->enter_sub();
790 $self->{SESSION} ||= { };
791 delete @{ $self->{SESSION} }{ @_ };
793 $main::lxdebug->leave_sub();
798 sub get_session_value {
799 $main::lxdebug->enter_sub();
802 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
804 $main::lxdebug->leave_sub();
809 sub create_unique_sesion_value {
810 my ($self, $value, %params) = @_;
812 $self->{SESSION} ||= { };
814 my @now = gettimeofday();
815 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
816 $self->{unique_counter} ||= 0;
820 $self->{unique_counter}++;
821 $hashed_key = md5_hex($key . $self->{unique_counter});
822 } while (exists $self->{SESSION}->{$hashed_key});
824 $self->set_session_value($hashed_key => $value);
829 sub save_form_in_session {
830 my ($self, %params) = @_;
832 my $form = delete($params{form}) || $::form;
833 my $non_scalars = delete $params{non_scalars};
836 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
838 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
839 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
842 return $self->create_unique_sesion_value($data, %params);
845 sub restore_form_from_session {
846 my ($self, $key, %params) = @_;
848 my $data = $self->get_session_value($key);
849 return $self unless $data;
851 my $form = delete($params{form}) || $::form;
852 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
854 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
859 sub set_cookie_environment_variable {
861 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
864 sub get_session_cookie_name {
867 return $self->{cookie_name} || 'lx_office_erp_session_id';
874 sub session_tables_present {
875 $main::lxdebug->enter_sub();
879 # Only re-check for the presence of auth tables if either the check
880 # hasn't been done before of if they weren't present.
881 if ($self->{session_tables_present}) {
882 $main::lxdebug->leave_sub();
883 return $self->{session_tables_present};
886 my $dbh = $self->dbconnect(1);
889 $main::lxdebug->leave_sub();
896 WHERE (schemaname = 'auth')
897 AND (tablename IN ('session', 'session_content'))|;
899 my ($count) = selectrow_query($main::form, $dbh, $query);
901 $self->{session_tables_present} = 2 == $count;
903 $main::lxdebug->leave_sub();
905 return $self->{session_tables_present};
908 # --------------------------------------
910 sub all_rights_full {
911 my $locale = $main::locale;
914 ["--crm", $locale->text("CRM optional software")],
915 ["crm_search", $locale->text("CRM search")],
916 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
917 ["crm_service", $locale->text("CRM services")],
918 ["crm_admin", $locale->text("CRM admin")],
919 ["crm_adminuser", $locale->text("CRM user")],
920 ["crm_adminstatus", $locale->text("CRM status")],
921 ["crm_email", $locale->text("CRM send email")],
922 ["crm_termin", $locale->text("CRM termin")],
923 ["crm_opportunity", $locale->text("CRM opportunity")],
924 ["crm_knowhow", $locale->text("CRM know how")],
925 ["crm_follow", $locale->text("CRM follow up")],
926 ["crm_notices", $locale->text("CRM notices")],
927 ["crm_other", $locale->text("CRM other")],
928 ["--master_data", $locale->text("Master Data")],
929 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
930 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
931 ["project_edit", $locale->text("Create and edit projects")],
932 ["--ar", $locale->text("AR")],
933 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
934 ["sales_order_edit", $locale->text("Create and edit sales orders")],
935 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
936 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
937 ["dunning_edit", $locale->text("Create and edit dunnings")],
938 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
939 ["--ap", $locale->text("AP")],
940 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
941 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
942 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
943 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
944 ["--warehouse_management", $locale->text("Warehouse management")],
945 ["warehouse_contents", $locale->text("View warehouse content")],
946 ["warehouse_management", $locale->text("Warehouse management")],
947 ["--general_ledger_cash", $locale->text("General ledger and cash")],
948 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
949 ["datev_export", $locale->text("DATEV Export")],
950 ["cash", $locale->text("Receipt, payment, reconciliation")],
951 ["--reports", $locale->text('Reports')],
952 ["report", $locale->text('All reports')],
953 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
954 ["--batch_printing", $locale->text("Batch Printing")],
955 ["batch_printing", $locale->text("Batch Printing")],
956 ["--others", $locale->text("Others")],
957 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
958 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
965 return grep !/^--/, map { $_->[0] } all_rights_full();
969 $main::lxdebug->enter_sub();
973 my $form = $main::form;
975 my $dbh = $self->dbconnect();
977 my $query = 'SELECT * FROM auth."group"';
978 my $sth = prepare_execute_query($form, $dbh, $query);
982 while ($row = $sth->fetchrow_hashref()) {
983 $groups->{$row->{id}} = $row;
987 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
988 $sth = prepare_query($form, $dbh, $query);
990 foreach $group (values %{$groups}) {
993 do_statement($form, $sth, $query, $group->{id});
995 while ($row = $sth->fetchrow_hashref()) {
996 push @members, $row->{user_id};
998 $group->{members} = [ uniq @members ];
1002 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1003 $sth = prepare_query($form, $dbh, $query);
1005 foreach $group (values %{$groups}) {
1006 $group->{rights} = {};
1008 do_statement($form, $sth, $query, $group->{id});
1010 while ($row = $sth->fetchrow_hashref()) {
1011 $group->{rights}->{$row->{right}} |= $row->{granted};
1014 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1018 $main::lxdebug->leave_sub();
1024 $main::lxdebug->enter_sub();
1029 my $form = $main::form;
1030 my $dbh = $self->dbconnect();
1034 my ($query, $sth, $row, $rights);
1036 if (!$group->{id}) {
1037 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1039 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1040 do_query($form, $dbh, $query, $group->{id});
1043 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1045 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1047 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1048 $sth = prepare_query($form, $dbh, $query);
1050 foreach my $user_id (uniq @{ $group->{members} }) {
1051 do_statement($form, $sth, $query, $user_id, $group->{id});
1055 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1057 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1058 $sth = prepare_query($form, $dbh, $query);
1060 foreach my $right (keys %{ $group->{rights} }) {
1061 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1067 $main::lxdebug->leave_sub();
1071 $main::lxdebug->enter_sub();
1076 my $form = $main::form;
1078 my $dbh = $self->dbconnect();
1081 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1082 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1083 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1087 $main::lxdebug->leave_sub();
1090 sub evaluate_rights_ary {
1091 $main::lxdebug->enter_sub(2);
1098 foreach my $el (@{$ary}) {
1099 if (ref $el eq "ARRAY") {
1100 if ($action eq '|') {
1101 $value |= evaluate_rights_ary($el);
1103 $value &= evaluate_rights_ary($el);
1106 } elsif (($el eq '&') || ($el eq '|')) {
1109 } elsif ($action eq '|') {
1118 $main::lxdebug->leave_sub(2);
1123 sub _parse_rights_string {
1124 $main::lxdebug->enter_sub(2);
1134 push @stack, $cur_ary;
1136 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1138 substr($access, 0, length $1) = "";
1140 next if ($token =~ /\s/);
1142 if ($token eq "(") {
1143 my $new_cur_ary = [];
1144 push @stack, $new_cur_ary;
1145 push @{$cur_ary}, $new_cur_ary;
1146 $cur_ary = $new_cur_ary;
1148 } elsif ($token eq ")") {
1152 $main::lxdebug->leave_sub(2);
1156 $cur_ary = $stack[-1];
1158 } elsif (($token eq "|") || ($token eq "&")) {
1159 push @{$cur_ary}, $token;
1162 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1166 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1168 $main::lxdebug->leave_sub(2);
1174 $main::lxdebug->enter_sub(2);
1179 my $default = shift;
1181 $self->{FULL_RIGHTS} ||= { };
1182 $self->{FULL_RIGHTS}->{$login} ||= { };
1184 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1185 $self->{RIGHTS} ||= { };
1186 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1188 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1191 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1192 $granted = $default if (!defined $granted);
1194 $main::lxdebug->leave_sub(2);
1200 $::lxdebug->enter_sub(2);
1201 my ($self, $right, $dont_abort) = @_;
1203 if ($self->check_right($::myconfig{login}, $right)) {
1204 $::lxdebug->leave_sub(2);
1209 delete $::form->{title};
1210 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1213 $::lxdebug->leave_sub(2);
1218 sub load_rights_for_user {
1219 $::lxdebug->enter_sub;
1221 my ($self, $login) = @_;
1222 my $dbh = $self->dbconnect;
1223 my ($query, $sth, $row, $rights);
1225 $rights = { map { $_ => 0 } all_rights() };
1228 qq|SELECT gr."right", gr.granted
1229 FROM auth.group_rights gr
1232 FROM auth.user_group ug
1233 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1234 WHERE u.login = ?)|;
1236 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1238 while ($row = $sth->fetchrow_hashref()) {
1239 $rights->{$row->{right}} |= $row->{granted};
1243 $::lxdebug->leave_sub;
1257 SL::Auth - Authentication and session handling
1263 =item C<set_session_value @values>
1264 =item C<set_session_value %values>
1266 Store all values of C<@values> or C<%values> in the session. Each
1267 member of C<@values> is tested if it is a hash reference. If it is
1268 then it must contain the keys C<key> and C<value> and can optionally
1269 contain the key C<auto_restore>. In this case C<value> is associated
1270 with C<key> and restored to C<$::form> upon the next request
1271 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1274 If the current member of C<@values> is not a hash reference then it
1275 will be used as the C<key> and the next entry of C<@values> is used as
1276 the C<value> to store. In this case setting C<auto_restore> is not
1279 Therefore the following two invocations are identical:
1281 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1282 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1284 All of these values are copied back into C<$::form> for the next
1285 request automatically if they're scalar values or if they have
1286 C<auto_restore> set to trueish.
1288 The values can be any Perl structure. They are stored as YAML dumps.
1290 =item C<get_session_value $key>
1292 Retrieve a value from the session. Returns C<undef> if the value
1295 =item C<create_unique_sesion_value $value, %params>
1297 Create a unique key in the session and store C<$value>
1300 Returns the key created in the session.
1302 =item C<save_session>
1304 Stores the session values in the database. This is the only function
1305 that actually stores stuff in the database. Neither the various
1306 setters nor the deleter access the database.
1308 =item <save_form_in_session %params>
1310 Stores the content of C<$params{form}> (default: C<$::form>) in the
1311 session using L</create_unique_sesion_value>.
1313 If C<$params{non_scalars}> is trueish then non-scalar values will be
1314 stored as well. Default is to only store scalar values.
1316 The following keys will never be saved: C<login>, C<password>,
1317 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1318 can be given as an array ref in C<$params{skip_keys}>.
1320 Returns the unique key under which the form is stored.
1322 =item <restore_form_from_session $key, %params>
1324 Restores the form from the session into C<$params{form}> (default:
1327 If C<$params{clobber}> is falsish then existing values with the same
1328 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1341 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>