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)};
458 # The XUL/XML backed menu has been removed.
459 $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
463 $main::lxdebug->leave_sub();
469 $main::lxdebug->enter_sub();
474 my $dbh = $self->dbconnect();
475 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
477 $main::lxdebug->leave_sub();
483 $::lxdebug->enter_sub;
488 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
489 my $dbh = $self->dbconnect;
493 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
495 my ($id) = selectrow_query($::form, $dbh, $query, $login);
497 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
499 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
500 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
501 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
504 $u_dbh->commit if $u_dbh;
506 $::lxdebug->leave_sub;
509 # --------------------------------------
513 sub restore_session {
514 $main::lxdebug->enter_sub();
518 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
519 $session_id =~ s|[^0-9a-f]||g if $session_id;
521 $self->{SESSION} = { };
524 $main::lxdebug->leave_sub();
528 my ($dbh, $query, $sth, $cookie, $ref, $form);
532 # Don't fail if the auth DB doesn't yet.
533 if (!( $dbh = $self->dbconnect(1) )) {
534 $::lxdebug->leave_sub;
538 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
539 # admin is creating the session tables at the moment.
540 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
542 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
543 $sth->finish if $sth;
544 $::lxdebug->leave_sub;
548 $cookie = $sth->fetchrow_hashref;
551 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
552 $self->destroy_session();
553 $main::lxdebug->leave_sub();
554 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
557 if ($self->{column_information}->has('auto_restore')) {
558 $self->_load_with_auto_restore_column($dbh, $session_id);
560 $self->_load_without_auto_restore_column($dbh, $session_id);
563 $main::lxdebug->leave_sub();
568 sub _load_without_auto_restore_column {
569 my ($self, $dbh, $session_id) = @_;
572 SELECT sess_key, sess_value
573 FROM auth.session_content
574 WHERE (session_id = ?)
576 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
578 while (my $ref = $sth->fetchrow_hashref) {
579 my $value = SL::Auth::SessionValue->new(auth => $self,
580 key => $ref->{sess_key},
581 value => $ref->{sess_value},
583 $self->{SESSION}->{ $ref->{sess_key} } = $value;
585 next if defined $::form->{$ref->{sess_key}};
587 my $data = $value->get;
588 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
592 sub _load_with_auto_restore_column {
593 my ($self, $dbh, $session_id) = @_;
595 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
598 SELECT sess_key, sess_value, auto_restore
599 FROM auth.session_content
600 WHERE (session_id = ?)
602 OR sess_key IN (${auto_restore_keys}))
604 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
606 while (my $ref = $sth->fetchrow_hashref) {
607 my $value = SL::Auth::SessionValue->new(auth => $self,
608 key => $ref->{sess_key},
609 value => $ref->{sess_value},
610 auto_restore => $ref->{auto_restore},
612 $self->{SESSION}->{ $ref->{sess_key} } = $value;
614 next if defined $::form->{$ref->{sess_key}};
616 my $data = $value->get;
617 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
624 FROM auth.session_content
625 WHERE (session_id = ?)
626 AND NOT COALESCE(auto_restore, FALSE)
627 AND (sess_key NOT IN (${auto_restore_keys}))
629 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
631 while (my $ref = $sth->fetchrow_hashref) {
632 my $value = SL::Auth::SessionValue->new(auth => $self,
633 key => $ref->{sess_key});
634 $self->{SESSION}->{ $ref->{sess_key} } = $value;
638 sub destroy_session {
639 $main::lxdebug->enter_sub();
644 my $dbh = $self->dbconnect();
648 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
649 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
653 SL::SessionFile->destroy_session($session_id);
656 $self->{SESSION} = { };
659 $main::lxdebug->leave_sub();
662 sub expire_sessions {
663 $main::lxdebug->enter_sub();
667 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
669 my $dbh = $self->dbconnect();
671 my $query = qq|SELECT id
673 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
675 my @ids = selectall_array_query($::form, $dbh, $query);
680 SL::SessionFile->destroy_session($_) for @ids;
682 $query = qq|DELETE FROM auth.session_content
683 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
684 do_query($main::form, $dbh, $query, @ids);
686 $query = qq|DELETE FROM auth.session
687 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
688 do_query($main::form, $dbh, $query, @ids);
693 $main::lxdebug->leave_sub();
696 sub _create_session_id {
697 $main::lxdebug->enter_sub();
700 map { push @data, int(rand() * 255); } (1..32);
702 my $id = md5_hex(pack 'C*', @data);
704 $main::lxdebug->leave_sub();
709 sub create_or_refresh_session {
710 $session_id ||= shift->_create_session_id;
714 $::lxdebug->enter_sub;
716 my $provided_dbh = shift;
718 my $dbh = $provided_dbh || $self->dbconnect(1);
720 $::lxdebug->leave_sub && return unless $dbh && $session_id;
722 $dbh->begin_work unless $provided_dbh;
724 # If this fails then the "auth" schema might not exist yet, e.g. if
725 # the admin is just trying to create the auth database.
726 if (!$dbh->do(qq|LOCK auth.session_content|)) {
727 $dbh->rollback unless $provided_dbh;
728 $::lxdebug->leave_sub;
732 my @unfetched_keys = map { $_->{key} }
733 grep { ! $_->{fetched} }
734 values %{ $self->{SESSION} };
735 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
736 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
737 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
738 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
740 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
742 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
745 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
747 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
750 my @values_to_save = grep { $_->{fetched} }
751 values %{ $self->{SESSION} };
752 if (@values_to_save) {
753 my ($columns, $placeholders) = ('', '');
754 my $auto_restore = $self->{column_information}->has('auto_restore');
757 $columns .= ', auto_restore';
758 $placeholders .= ', ?';
761 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
762 my $sth = prepare_query($::form, $dbh, $query);
764 foreach my $value (@values_to_save) {
765 my @values = ($value->{key}, $value->get_dumped);
766 push @values, $value->{auto_restore} if $auto_restore;
768 do_statement($::form, $sth, $query, $session_id, @values);
774 $dbh->commit() unless $provided_dbh;
775 $::lxdebug->leave_sub;
778 sub set_session_value {
779 $main::lxdebug->enter_sub();
784 $self->{SESSION} ||= { };
787 my $key = shift @params;
789 if (ref $key eq 'HASH') {
790 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
791 value => $key->{value},
792 auto_restore => $key->{auto_restore});
795 my $value = shift @params;
796 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
801 $main::lxdebug->leave_sub();
806 sub delete_session_value {
807 $main::lxdebug->enter_sub();
811 $self->{SESSION} ||= { };
812 delete @{ $self->{SESSION} }{ @_ };
814 $main::lxdebug->leave_sub();
819 sub get_session_value {
820 $main::lxdebug->enter_sub();
823 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
825 $main::lxdebug->leave_sub();
830 sub create_unique_sesion_value {
831 my ($self, $value, %params) = @_;
833 $self->{SESSION} ||= { };
835 my @now = gettimeofday();
836 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
837 $self->{unique_counter} ||= 0;
841 $self->{unique_counter}++;
842 $hashed_key = md5_hex($key . $self->{unique_counter});
843 } while (exists $self->{SESSION}->{$hashed_key});
845 $self->set_session_value($hashed_key => $value);
850 sub save_form_in_session {
851 my ($self, %params) = @_;
853 my $form = delete($params{form}) || $::form;
854 my $non_scalars = delete $params{non_scalars};
857 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
859 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
860 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
863 return $self->create_unique_sesion_value($data, %params);
866 sub restore_form_from_session {
867 my ($self, $key, %params) = @_;
869 my $data = $self->get_session_value($key);
870 return $self unless $data;
872 my $form = delete($params{form}) || $::form;
873 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
875 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
880 sub set_cookie_environment_variable {
882 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
885 sub get_session_cookie_name {
888 return $self->{cookie_name} || 'lx_office_erp_session_id';
895 sub session_tables_present {
896 $main::lxdebug->enter_sub();
900 # Only re-check for the presence of auth tables if either the check
901 # hasn't been done before of if they weren't present.
902 if ($self->{session_tables_present}) {
903 $main::lxdebug->leave_sub();
904 return $self->{session_tables_present};
907 my $dbh = $self->dbconnect(1);
910 $main::lxdebug->leave_sub();
917 WHERE (schemaname = 'auth')
918 AND (tablename IN ('session', 'session_content'))|;
920 my ($count) = selectrow_query($main::form, $dbh, $query);
922 $self->{session_tables_present} = 2 == $count;
924 $main::lxdebug->leave_sub();
926 return $self->{session_tables_present};
929 # --------------------------------------
931 sub all_rights_full {
932 my $locale = $main::locale;
935 ["--crm", $locale->text("CRM optional software")],
936 ["crm_search", $locale->text("CRM search")],
937 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
938 ["crm_service", $locale->text("CRM services")],
939 ["crm_admin", $locale->text("CRM admin")],
940 ["crm_adminuser", $locale->text("CRM user")],
941 ["crm_adminstatus", $locale->text("CRM status")],
942 ["crm_email", $locale->text("CRM send email")],
943 ["crm_termin", $locale->text("CRM termin")],
944 ["crm_opportunity", $locale->text("CRM opportunity")],
945 ["crm_knowhow", $locale->text("CRM know how")],
946 ["crm_follow", $locale->text("CRM follow up")],
947 ["crm_notices", $locale->text("CRM notices")],
948 ["crm_other", $locale->text("CRM other")],
949 ["--master_data", $locale->text("Master Data")],
950 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
951 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
952 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
953 ["project_edit", $locale->text("Create and edit projects")],
954 ["--ar", $locale->text("AR")],
955 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
956 ["sales_order_edit", $locale->text("Create and edit sales orders")],
957 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
958 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
959 ["dunning_edit", $locale->text("Create and edit dunnings")],
960 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
961 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
962 ["--ap", $locale->text("AP")],
963 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
964 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
965 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
966 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
967 ["--warehouse_management", $locale->text("Warehouse management")],
968 ["warehouse_contents", $locale->text("View warehouse content")],
969 ["warehouse_management", $locale->text("Warehouse management")],
970 ["--general_ledger_cash", $locale->text("General ledger and cash")],
971 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
972 ["datev_export", $locale->text("DATEV Export")],
973 ["cash", $locale->text("Receipt, payment, reconciliation")],
974 ["--reports", $locale->text('Reports')],
975 ["report", $locale->text('All reports')],
976 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
977 ["--batch_printing", $locale->text("Batch Printing")],
978 ["batch_printing", $locale->text("Batch Printing")],
979 ["--others", $locale->text("Others")],
980 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
981 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
982 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
989 return grep !/^--/, map { $_->[0] } all_rights_full();
993 $main::lxdebug->enter_sub();
997 my $form = $main::form;
999 my $dbh = $self->dbconnect();
1001 my $query = 'SELECT * FROM auth."group"';
1002 my $sth = prepare_execute_query($form, $dbh, $query);
1006 while ($row = $sth->fetchrow_hashref()) {
1007 $groups->{$row->{id}} = $row;
1011 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1012 $sth = prepare_query($form, $dbh, $query);
1014 foreach $group (values %{$groups}) {
1017 do_statement($form, $sth, $query, $group->{id});
1019 while ($row = $sth->fetchrow_hashref()) {
1020 push @members, $row->{user_id};
1022 $group->{members} = [ uniq @members ];
1026 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1027 $sth = prepare_query($form, $dbh, $query);
1029 foreach $group (values %{$groups}) {
1030 $group->{rights} = {};
1032 do_statement($form, $sth, $query, $group->{id});
1034 while ($row = $sth->fetchrow_hashref()) {
1035 $group->{rights}->{$row->{right}} |= $row->{granted};
1038 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1042 $main::lxdebug->leave_sub();
1048 $main::lxdebug->enter_sub();
1053 my $form = $main::form;
1054 my $dbh = $self->dbconnect();
1058 my ($query, $sth, $row, $rights);
1060 if (!$group->{id}) {
1061 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1063 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1064 do_query($form, $dbh, $query, $group->{id});
1067 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1069 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1071 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1072 $sth = prepare_query($form, $dbh, $query);
1074 foreach my $user_id (uniq @{ $group->{members} }) {
1075 do_statement($form, $sth, $query, $user_id, $group->{id});
1079 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1081 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1082 $sth = prepare_query($form, $dbh, $query);
1084 foreach my $right (keys %{ $group->{rights} }) {
1085 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1091 $main::lxdebug->leave_sub();
1095 $main::lxdebug->enter_sub();
1100 my $form = $main::form;
1102 my $dbh = $self->dbconnect();
1105 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1106 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1107 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1111 $main::lxdebug->leave_sub();
1114 sub evaluate_rights_ary {
1115 $main::lxdebug->enter_sub(2);
1122 foreach my $el (@{$ary}) {
1123 if (ref $el eq "ARRAY") {
1124 if ($action eq '|') {
1125 $value |= evaluate_rights_ary($el);
1127 $value &= evaluate_rights_ary($el);
1130 } elsif (($el eq '&') || ($el eq '|')) {
1133 } elsif ($action eq '|') {
1142 $main::lxdebug->leave_sub(2);
1147 sub _parse_rights_string {
1148 $main::lxdebug->enter_sub(2);
1158 push @stack, $cur_ary;
1160 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1162 substr($access, 0, length $1) = "";
1164 next if ($token =~ /\s/);
1166 if ($token eq "(") {
1167 my $new_cur_ary = [];
1168 push @stack, $new_cur_ary;
1169 push @{$cur_ary}, $new_cur_ary;
1170 $cur_ary = $new_cur_ary;
1172 } elsif ($token eq ")") {
1176 $main::lxdebug->leave_sub(2);
1180 $cur_ary = $stack[-1];
1182 } elsif (($token eq "|") || ($token eq "&")) {
1183 push @{$cur_ary}, $token;
1186 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1190 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1192 $main::lxdebug->leave_sub(2);
1198 $main::lxdebug->enter_sub(2);
1203 my $default = shift;
1205 $self->{FULL_RIGHTS} ||= { };
1206 $self->{FULL_RIGHTS}->{$login} ||= { };
1208 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1209 $self->{RIGHTS} ||= { };
1210 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1212 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1215 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1216 $granted = $default if (!defined $granted);
1218 $main::lxdebug->leave_sub(2);
1224 $::lxdebug->enter_sub(2);
1225 my ($self, $right, $dont_abort) = @_;
1227 if ($self->check_right($::myconfig{login}, $right)) {
1228 $::lxdebug->leave_sub(2);
1233 delete $::form->{title};
1234 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1237 $::lxdebug->leave_sub(2);
1242 sub load_rights_for_user {
1243 $::lxdebug->enter_sub;
1245 my ($self, $login) = @_;
1246 my $dbh = $self->dbconnect;
1247 my ($query, $sth, $row, $rights);
1249 $rights = { map { $_ => 0 } all_rights() };
1252 qq|SELECT gr."right", gr.granted
1253 FROM auth.group_rights gr
1256 FROM auth.user_group ug
1257 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1258 WHERE u.login = ?)|;
1260 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1262 while ($row = $sth->fetchrow_hashref()) {
1263 $rights->{$row->{right}} |= $row->{granted};
1267 $::lxdebug->leave_sub;
1281 SL::Auth - Authentication and session handling
1287 =item C<set_session_value @values>
1288 =item C<set_session_value %values>
1290 Store all values of C<@values> or C<%values> in the session. Each
1291 member of C<@values> is tested if it is a hash reference. If it is
1292 then it must contain the keys C<key> and C<value> and can optionally
1293 contain the key C<auto_restore>. In this case C<value> is associated
1294 with C<key> and restored to C<$::form> upon the next request
1295 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1298 If the current member of C<@values> is not a hash reference then it
1299 will be used as the C<key> and the next entry of C<@values> is used as
1300 the C<value> to store. In this case setting C<auto_restore> is not
1303 Therefore the following two invocations are identical:
1305 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1306 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1308 All of these values are copied back into C<$::form> for the next
1309 request automatically if they're scalar values or if they have
1310 C<auto_restore> set to trueish.
1312 The values can be any Perl structure. They are stored as YAML dumps.
1314 =item C<get_session_value $key>
1316 Retrieve a value from the session. Returns C<undef> if the value
1319 =item C<create_unique_sesion_value $value, %params>
1321 Create a unique key in the session and store C<$value>
1324 Returns the key created in the session.
1326 =item C<save_session>
1328 Stores the session values in the database. This is the only function
1329 that actually stores stuff in the database. Neither the various
1330 setters nor the deleter access the database.
1332 =item <save_form_in_session %params>
1334 Stores the content of C<$params{form}> (default: C<$::form>) in the
1335 session using L</create_unique_sesion_value>.
1337 If C<$params{non_scalars}> is trueish then non-scalar values will be
1338 stored as well. Default is to only store scalar values.
1340 The following keys will never be saved: C<login>, C<password>,
1341 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1342 can be given as an array ref in C<$params{skip_keys}>.
1344 Returns the unique key under which the form is stored.
1346 =item <restore_form_from_session $key, %params>
1348 Restores the form from the session into C<$params{form}> (default:
1351 If C<$params{clobber}> is falsish then existing values with the same
1352 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1365 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>