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 $dbh = $self->dbconnect();
529 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
531 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
533 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
534 $self->destroy_session();
535 $main::lxdebug->leave_sub();
536 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
539 if ($self->{column_information}->has('auto_restore')) {
540 $self->_load_with_auto_restore_column($dbh, $session_id);
542 $self->_load_without_auto_restore_column($dbh, $session_id);
545 $main::lxdebug->leave_sub();
550 sub _load_without_auto_restore_column {
551 my ($self, $dbh, $session_id) = @_;
554 SELECT sess_key, sess_value
555 FROM auth.session_content
556 WHERE (session_id = ?)
558 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
560 while (my $ref = $sth->fetchrow_hashref) {
561 my $value = SL::Auth::SessionValue->new(auth => $self,
562 key => $ref->{sess_key},
563 value => $ref->{sess_value},
565 $self->{SESSION}->{ $ref->{sess_key} } = $value;
567 next if defined $::form->{$ref->{sess_key}};
569 my $data = $value->get;
570 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
574 sub _load_with_auto_restore_column {
575 my ($self, $dbh, $session_id) = @_;
577 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
580 SELECT sess_key, sess_value, auto_restore
581 FROM auth.session_content
582 WHERE (session_id = ?)
584 OR sess_key IN (${auto_restore_keys}))
586 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
588 while (my $ref = $sth->fetchrow_hashref) {
589 my $value = SL::Auth::SessionValue->new(auth => $self,
590 key => $ref->{sess_key},
591 value => $ref->{sess_value},
592 auto_restore => $ref->{auto_restore},
594 $self->{SESSION}->{ $ref->{sess_key} } = $value;
596 next if defined $::form->{$ref->{sess_key}};
598 my $data = $value->get;
599 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
606 FROM auth.session_content
607 WHERE (session_id = ?)
608 AND NOT COALESCE(auto_restore, FALSE)
609 AND (sess_key NOT IN (${auto_restore_keys}))
611 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
613 while (my $ref = $sth->fetchrow_hashref) {
614 my $value = SL::Auth::SessionValue->new(auth => $self,
615 key => $ref->{sess_key});
616 $self->{SESSION}->{ $ref->{sess_key} } = $value;
620 sub destroy_session {
621 $main::lxdebug->enter_sub();
626 my $dbh = $self->dbconnect();
630 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
631 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
635 SL::SessionFile->destroy_session($session_id);
638 $self->{SESSION} = { };
641 $main::lxdebug->leave_sub();
644 sub expire_sessions {
645 $main::lxdebug->enter_sub();
649 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
651 my $dbh = $self->dbconnect();
653 my $query = qq|SELECT id
655 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
657 my @ids = selectall_array_query($::form, $dbh, $query);
662 SL::SessionFile->destroy_session($_) for @ids;
664 $query = qq|DELETE FROM auth.session_content
665 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
666 do_query($main::form, $dbh, $query, @ids);
668 $query = qq|DELETE FROM auth.session
669 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
670 do_query($main::form, $dbh, $query, @ids);
675 $main::lxdebug->leave_sub();
678 sub _create_session_id {
679 $main::lxdebug->enter_sub();
682 map { push @data, int(rand() * 255); } (1..32);
684 my $id = md5_hex(pack 'C*', @data);
686 $main::lxdebug->leave_sub();
691 sub create_or_refresh_session {
692 $session_id ||= shift->_create_session_id;
696 $::lxdebug->enter_sub;
698 my $provided_dbh = shift;
700 my $dbh = $provided_dbh || $self->dbconnect(1);
702 $::lxdebug->leave_sub && return unless $dbh && $session_id;
704 $dbh->begin_work unless $provided_dbh;
706 do_query($::form, $dbh, qq|LOCK auth.session_content|);
708 my @unfetched_keys = map { $_->{key} }
709 grep { ! $_->{fetched} }
710 values %{ $self->{SESSION} };
711 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
712 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
713 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
714 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
716 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
718 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
721 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
723 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
726 my @values_to_save = grep { $_->{fetched} }
727 values %{ $self->{SESSION} };
728 if (@values_to_save) {
729 my ($columns, $placeholders) = ('', '');
730 my $auto_restore = $self->{column_information}->has('auto_restore');
733 $columns .= ', auto_restore';
734 $placeholders .= ', ?';
737 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
738 my $sth = prepare_query($::form, $dbh, $query);
740 foreach my $value (@values_to_save) {
741 my @values = ($value->{key}, $value->get_dumped);
742 push @values, $value->{auto_restore} if $auto_restore;
744 do_statement($::form, $sth, $query, $session_id, @values);
750 $dbh->commit() unless $provided_dbh;
751 $::lxdebug->leave_sub;
754 sub set_session_value {
755 $main::lxdebug->enter_sub();
760 $self->{SESSION} ||= { };
763 my $key = shift @params;
765 if (ref $key eq 'HASH') {
766 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
767 value => $key->{value},
768 auto_restore => $key->{auto_restore});
771 my $value = shift @params;
772 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
777 $main::lxdebug->leave_sub();
782 sub delete_session_value {
783 $main::lxdebug->enter_sub();
787 $self->{SESSION} ||= { };
788 delete @{ $self->{SESSION} }{ @_ };
790 $main::lxdebug->leave_sub();
795 sub get_session_value {
796 $main::lxdebug->enter_sub();
799 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
801 $main::lxdebug->leave_sub();
806 sub create_unique_sesion_value {
807 my ($self, $value, %params) = @_;
809 $self->{SESSION} ||= { };
811 my @now = gettimeofday();
812 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
813 $self->{unique_counter} ||= 0;
817 $self->{unique_counter}++;
818 $hashed_key = md5_hex($key . $self->{unique_counter});
819 } while (exists $self->{SESSION}->{$hashed_key});
821 $self->set_session_value($hashed_key => $value);
826 sub save_form_in_session {
827 my ($self, %params) = @_;
829 my $form = delete($params{form}) || $::form;
830 my $non_scalars = delete $params{non_scalars};
833 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
835 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
836 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
839 return $self->create_unique_sesion_value($data, %params);
842 sub restore_form_from_session {
843 my ($self, $key, %params) = @_;
845 my $data = $self->get_session_value($key);
846 return $self unless $data;
848 my $form = delete($params{form}) || $::form;
849 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
851 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
856 sub set_cookie_environment_variable {
858 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
861 sub get_session_cookie_name {
864 return $self->{cookie_name} || 'lx_office_erp_session_id';
871 sub session_tables_present {
872 $main::lxdebug->enter_sub();
876 # Only re-check for the presence of auth tables if either the check
877 # hasn't been done before of if they weren't present.
878 if ($self->{session_tables_present}) {
879 $main::lxdebug->leave_sub();
880 return $self->{session_tables_present};
883 my $dbh = $self->dbconnect(1);
886 $main::lxdebug->leave_sub();
893 WHERE (schemaname = 'auth')
894 AND (tablename IN ('session', 'session_content'))|;
896 my ($count) = selectrow_query($main::form, $dbh, $query);
898 $self->{session_tables_present} = 2 == $count;
900 $main::lxdebug->leave_sub();
902 return $self->{session_tables_present};
905 # --------------------------------------
907 sub all_rights_full {
908 my $locale = $main::locale;
911 ["--crm", $locale->text("CRM optional software")],
912 ["crm_search", $locale->text("CRM search")],
913 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
914 ["crm_service", $locale->text("CRM services")],
915 ["crm_admin", $locale->text("CRM admin")],
916 ["crm_adminuser", $locale->text("CRM user")],
917 ["crm_adminstatus", $locale->text("CRM status")],
918 ["crm_email", $locale->text("CRM send email")],
919 ["crm_termin", $locale->text("CRM termin")],
920 ["crm_opportunity", $locale->text("CRM opportunity")],
921 ["crm_knowhow", $locale->text("CRM know how")],
922 ["crm_follow", $locale->text("CRM follow up")],
923 ["crm_notices", $locale->text("CRM notices")],
924 ["crm_other", $locale->text("CRM other")],
925 ["--master_data", $locale->text("Master Data")],
926 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
927 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
928 ["project_edit", $locale->text("Create and edit projects")],
929 ["--ar", $locale->text("AR")],
930 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
931 ["sales_order_edit", $locale->text("Create and edit sales orders")],
932 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
933 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
934 ["dunning_edit", $locale->text("Create and edit dunnings")],
935 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
936 ["--ap", $locale->text("AP")],
937 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
938 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
939 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
940 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
941 ["--warehouse_management", $locale->text("Warehouse management")],
942 ["warehouse_contents", $locale->text("View warehouse content")],
943 ["warehouse_management", $locale->text("Warehouse management")],
944 ["--general_ledger_cash", $locale->text("General ledger and cash")],
945 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
946 ["datev_export", $locale->text("DATEV Export")],
947 ["cash", $locale->text("Receipt, payment, reconciliation")],
948 ["--reports", $locale->text('Reports')],
949 ["report", $locale->text('All reports')],
950 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
951 ["--batch_printing", $locale->text("Batch Printing")],
952 ["batch_printing", $locale->text("Batch Printing")],
953 ["--others", $locale->text("Others")],
954 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
955 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
962 return grep !/^--/, map { $_->[0] } all_rights_full();
966 $main::lxdebug->enter_sub();
970 my $form = $main::form;
972 my $dbh = $self->dbconnect();
974 my $query = 'SELECT * FROM auth."group"';
975 my $sth = prepare_execute_query($form, $dbh, $query);
979 while ($row = $sth->fetchrow_hashref()) {
980 $groups->{$row->{id}} = $row;
984 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
985 $sth = prepare_query($form, $dbh, $query);
987 foreach $group (values %{$groups}) {
990 do_statement($form, $sth, $query, $group->{id});
992 while ($row = $sth->fetchrow_hashref()) {
993 push @members, $row->{user_id};
995 $group->{members} = [ uniq @members ];
999 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1000 $sth = prepare_query($form, $dbh, $query);
1002 foreach $group (values %{$groups}) {
1003 $group->{rights} = {};
1005 do_statement($form, $sth, $query, $group->{id});
1007 while ($row = $sth->fetchrow_hashref()) {
1008 $group->{rights}->{$row->{right}} |= $row->{granted};
1011 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1015 $main::lxdebug->leave_sub();
1021 $main::lxdebug->enter_sub();
1026 my $form = $main::form;
1027 my $dbh = $self->dbconnect();
1031 my ($query, $sth, $row, $rights);
1033 if (!$group->{id}) {
1034 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1036 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1037 do_query($form, $dbh, $query, $group->{id});
1040 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1042 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1044 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1045 $sth = prepare_query($form, $dbh, $query);
1047 foreach my $user_id (uniq @{ $group->{members} }) {
1048 do_statement($form, $sth, $query, $user_id, $group->{id});
1052 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1054 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1055 $sth = prepare_query($form, $dbh, $query);
1057 foreach my $right (keys %{ $group->{rights} }) {
1058 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1064 $main::lxdebug->leave_sub();
1068 $main::lxdebug->enter_sub();
1073 my $form = $main::form;
1075 my $dbh = $self->dbconnect();
1078 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1079 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1080 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1084 $main::lxdebug->leave_sub();
1087 sub evaluate_rights_ary {
1088 $main::lxdebug->enter_sub(2);
1095 foreach my $el (@{$ary}) {
1096 if (ref $el eq "ARRAY") {
1097 if ($action eq '|') {
1098 $value |= evaluate_rights_ary($el);
1100 $value &= evaluate_rights_ary($el);
1103 } elsif (($el eq '&') || ($el eq '|')) {
1106 } elsif ($action eq '|') {
1115 $main::lxdebug->leave_sub(2);
1120 sub _parse_rights_string {
1121 $main::lxdebug->enter_sub(2);
1131 push @stack, $cur_ary;
1133 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1135 substr($access, 0, length $1) = "";
1137 next if ($token =~ /\s/);
1139 if ($token eq "(") {
1140 my $new_cur_ary = [];
1141 push @stack, $new_cur_ary;
1142 push @{$cur_ary}, $new_cur_ary;
1143 $cur_ary = $new_cur_ary;
1145 } elsif ($token eq ")") {
1149 $main::lxdebug->leave_sub(2);
1153 $cur_ary = $stack[-1];
1155 } elsif (($token eq "|") || ($token eq "&")) {
1156 push @{$cur_ary}, $token;
1159 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1163 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1165 $main::lxdebug->leave_sub(2);
1171 $main::lxdebug->enter_sub(2);
1176 my $default = shift;
1178 $self->{FULL_RIGHTS} ||= { };
1179 $self->{FULL_RIGHTS}->{$login} ||= { };
1181 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1182 $self->{RIGHTS} ||= { };
1183 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1185 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1188 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1189 $granted = $default if (!defined $granted);
1191 $main::lxdebug->leave_sub(2);
1197 $::lxdebug->enter_sub(2);
1198 my ($self, $right, $dont_abort) = @_;
1200 if ($self->check_right($::myconfig{login}, $right)) {
1201 $::lxdebug->leave_sub(2);
1206 delete $::form->{title};
1207 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1210 $::lxdebug->leave_sub(2);
1215 sub load_rights_for_user {
1216 $::lxdebug->enter_sub;
1218 my ($self, $login) = @_;
1219 my $dbh = $self->dbconnect;
1220 my ($query, $sth, $row, $rights);
1222 $rights = { map { $_ => 0 } all_rights() };
1225 qq|SELECT gr."right", gr.granted
1226 FROM auth.group_rights gr
1229 FROM auth.user_group ug
1230 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1231 WHERE u.login = ?)|;
1233 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1235 while ($row = $sth->fetchrow_hashref()) {
1236 $rights->{$row->{right}} |= $row->{granted};
1240 $::lxdebug->leave_sub;
1254 SL::Auth - Authentication and session handling
1260 =item C<set_session_value @values>
1261 =item C<set_session_value %values>
1263 Store all values of C<@values> or C<%values> in the session. Each
1264 member of C<@values> is tested if it is a hash reference. If it is
1265 then it must contain the keys C<key> and C<value> and can optionally
1266 contain the key C<auto_restore>. In this case C<value> is associated
1267 with C<key> and restored to C<$::form> upon the next request
1268 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1271 If the current member of C<@values> is not a hash reference then it
1272 will be used as the C<key> and the next entry of C<@values> is used as
1273 the C<value> to store. In this case setting C<auto_restore> is not
1276 Therefore the following two invocations are identical:
1278 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1279 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1281 All of these values are copied back into C<$::form> for the next
1282 request automatically if they're scalar values or if they have
1283 C<auto_restore> set to trueish.
1285 The values can be any Perl structure. They are stored as YAML dumps.
1287 =item C<get_session_value $key>
1289 Retrieve a value from the session. Returns C<undef> if the value
1292 =item C<create_unique_sesion_value $value, %params>
1294 Create a unique key in the session and store C<$value>
1297 Returns the key created in the session.
1299 =item C<save_session>
1301 Stores the session values in the database. This is the only function
1302 that actually stores stuff in the database. Neither the various
1303 setters nor the deleter access the database.
1305 =item <save_form_in_session %params>
1307 Stores the content of C<$params{form}> (default: C<$::form>) in the
1308 session using L</create_unique_sesion_value>.
1310 If C<$params{non_scalars}> is trueish then non-scalar values will be
1311 stored as well. Default is to only store scalar values.
1313 The following keys will never be saved: C<login>, C<password>,
1314 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1315 can be given as an array ref in C<$params{skip_keys}>.
1317 Returns the unique key under which the form is stored.
1319 =item <restore_form_from_session $key, %params>
1321 Restores the form from the session into C<$params{form}> (default:
1324 If C<$params{clobber}> is falsish then existing values with the same
1325 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1338 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>