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 => $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();
247 my ($self, $dbh) = @_;
249 $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();
441 my ($self, %params) = @_;
443 my $dbh = $self->dbconnect();
445 my (@where, @values);
446 if ($params{login}) {
447 push @where, 'u.login = ?';
448 push @values, $params{login};
451 push @where, 'u.id = ?';
452 push @values, $params{id};
454 my $where = join ' AND ', '1 = 1', @where;
455 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
456 FROM auth.user_config cfg
457 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
459 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
463 while (my $ref = $sth->fetchrow_hashref()) {
464 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
465 @user_data{qw(id login)} = @{$ref}{qw(id login)};
468 # The XUL/XML backed menu has been removed.
469 $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
473 $main::lxdebug->leave_sub();
479 $main::lxdebug->enter_sub();
484 my $dbh = $self->dbconnect();
485 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
487 $main::lxdebug->leave_sub();
493 $::lxdebug->enter_sub;
498 my $dbh = $self->dbconnect;
499 my $id = $self->get_user_id($login);
502 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
504 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
505 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
507 $u_dbh->begin_work if $u_dbh && $user_db_exists;
511 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
512 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
513 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
514 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
517 $u_dbh->commit if $u_dbh && $user_db_exists;
519 $::lxdebug->leave_sub;
522 # --------------------------------------
526 sub restore_session {
527 $main::lxdebug->enter_sub();
531 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
532 $session_id =~ s|[^0-9a-f]||g if $session_id;
534 $self->{SESSION} = { };
537 $main::lxdebug->leave_sub();
541 my ($dbh, $query, $sth, $cookie, $ref, $form);
545 # Don't fail if the auth DB doesn't yet.
546 if (!( $dbh = $self->dbconnect(1) )) {
547 $::lxdebug->leave_sub;
551 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
552 # admin is creating the session tables at the moment.
553 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
555 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
556 $sth->finish if $sth;
557 $::lxdebug->leave_sub;
561 $cookie = $sth->fetchrow_hashref;
564 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
565 $self->destroy_session();
566 $main::lxdebug->leave_sub();
567 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
570 if ($self->{column_information}->has('auto_restore')) {
571 $self->_load_with_auto_restore_column($dbh, $session_id);
573 $self->_load_without_auto_restore_column($dbh, $session_id);
576 $main::lxdebug->leave_sub();
581 sub _load_without_auto_restore_column {
582 my ($self, $dbh, $session_id) = @_;
585 SELECT sess_key, sess_value
586 FROM auth.session_content
587 WHERE (session_id = ?)
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},
596 $self->{SESSION}->{ $ref->{sess_key} } = $value;
598 next if defined $::form->{$ref->{sess_key}};
600 my $data = $value->get;
601 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
605 sub _load_with_auto_restore_column {
606 my ($self, $dbh, $session_id) = @_;
608 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
611 SELECT sess_key, sess_value, auto_restore
612 FROM auth.session_content
613 WHERE (session_id = ?)
615 OR sess_key IN (${auto_restore_keys}))
617 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
619 while (my $ref = $sth->fetchrow_hashref) {
620 my $value = SL::Auth::SessionValue->new(auth => $self,
621 key => $ref->{sess_key},
622 value => $ref->{sess_value},
623 auto_restore => $ref->{auto_restore},
625 $self->{SESSION}->{ $ref->{sess_key} } = $value;
627 next if defined $::form->{$ref->{sess_key}};
629 my $data = $value->get;
630 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
637 FROM auth.session_content
638 WHERE (session_id = ?)
639 AND NOT COALESCE(auto_restore, FALSE)
640 AND (sess_key NOT IN (${auto_restore_keys}))
642 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
644 while (my $ref = $sth->fetchrow_hashref) {
645 my $value = SL::Auth::SessionValue->new(auth => $self,
646 key => $ref->{sess_key});
647 $self->{SESSION}->{ $ref->{sess_key} } = $value;
651 sub destroy_session {
652 $main::lxdebug->enter_sub();
657 my $dbh = $self->dbconnect();
661 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
662 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
666 SL::SessionFile->destroy_session($session_id);
669 $self->{SESSION} = { };
672 $main::lxdebug->leave_sub();
675 sub expire_sessions {
676 $main::lxdebug->enter_sub();
680 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
682 my $dbh = $self->dbconnect();
684 my $query = qq|SELECT id
686 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
688 my @ids = selectall_array_query($::form, $dbh, $query);
693 SL::SessionFile->destroy_session($_) for @ids;
695 $query = qq|DELETE FROM auth.session_content
696 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
697 do_query($main::form, $dbh, $query, @ids);
699 $query = qq|DELETE FROM auth.session
700 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
701 do_query($main::form, $dbh, $query, @ids);
706 $main::lxdebug->leave_sub();
709 sub _create_session_id {
710 $main::lxdebug->enter_sub();
713 map { push @data, int(rand() * 255); } (1..32);
715 my $id = md5_hex(pack 'C*', @data);
717 $main::lxdebug->leave_sub();
722 sub create_or_refresh_session {
723 $session_id ||= shift->_create_session_id;
727 $::lxdebug->enter_sub;
729 my $provided_dbh = shift;
731 my $dbh = $provided_dbh || $self->dbconnect(1);
733 $::lxdebug->leave_sub && return unless $dbh && $session_id;
735 $dbh->begin_work unless $provided_dbh;
737 # If this fails then the "auth" schema might not exist yet, e.g. if
738 # the admin is just trying to create the auth database.
739 if (!$dbh->do(qq|LOCK auth.session_content|)) {
740 $dbh->rollback unless $provided_dbh;
741 $::lxdebug->leave_sub;
745 my @unfetched_keys = map { $_->{key} }
746 grep { ! $_->{fetched} }
747 values %{ $self->{SESSION} };
748 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
749 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
750 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
751 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
753 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
755 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
758 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
760 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
763 my @values_to_save = grep { $_->{fetched} }
764 values %{ $self->{SESSION} };
765 if (@values_to_save) {
766 my ($columns, $placeholders) = ('', '');
767 my $auto_restore = $self->{column_information}->has('auto_restore');
770 $columns .= ', auto_restore';
771 $placeholders .= ', ?';
774 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
775 my $sth = prepare_query($::form, $dbh, $query);
777 foreach my $value (@values_to_save) {
778 my @values = ($value->{key}, $value->get_dumped);
779 push @values, $value->{auto_restore} if $auto_restore;
781 do_statement($::form, $sth, $query, $session_id, @values);
787 $dbh->commit() unless $provided_dbh;
788 $::lxdebug->leave_sub;
791 sub set_session_value {
792 $main::lxdebug->enter_sub();
797 $self->{SESSION} ||= { };
800 my $key = shift @params;
802 if (ref $key eq 'HASH') {
803 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
804 value => $key->{value},
805 auto_restore => $key->{auto_restore});
808 my $value = shift @params;
809 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
814 $main::lxdebug->leave_sub();
819 sub delete_session_value {
820 $main::lxdebug->enter_sub();
824 $self->{SESSION} ||= { };
825 delete @{ $self->{SESSION} }{ @_ };
827 $main::lxdebug->leave_sub();
832 sub get_session_value {
833 $main::lxdebug->enter_sub();
836 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
838 $main::lxdebug->leave_sub();
843 sub create_unique_sesion_value {
844 my ($self, $value, %params) = @_;
846 $self->{SESSION} ||= { };
848 my @now = gettimeofday();
849 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
850 $self->{unique_counter} ||= 0;
854 $self->{unique_counter}++;
855 $hashed_key = md5_hex($key . $self->{unique_counter});
856 } while (exists $self->{SESSION}->{$hashed_key});
858 $self->set_session_value($hashed_key => $value);
863 sub save_form_in_session {
864 my ($self, %params) = @_;
866 my $form = delete($params{form}) || $::form;
867 my $non_scalars = delete $params{non_scalars};
870 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
872 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
873 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
876 return $self->create_unique_sesion_value($data, %params);
879 sub restore_form_from_session {
880 my ($self, $key, %params) = @_;
882 my $data = $self->get_session_value($key);
883 return $self unless $data;
885 my $form = delete($params{form}) || $::form;
886 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
888 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
893 sub set_cookie_environment_variable {
895 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
898 sub get_session_cookie_name {
901 return $self->{cookie_name} || 'lx_office_erp_session_id';
908 sub session_tables_present {
909 $main::lxdebug->enter_sub();
913 # Only re-check for the presence of auth tables if either the check
914 # hasn't been done before of if they weren't present.
915 if ($self->{session_tables_present}) {
916 $main::lxdebug->leave_sub();
917 return $self->{session_tables_present};
920 my $dbh = $self->dbconnect(1);
923 $main::lxdebug->leave_sub();
930 WHERE (schemaname = 'auth')
931 AND (tablename IN ('session', 'session_content'))|;
933 my ($count) = selectrow_query($main::form, $dbh, $query);
935 $self->{session_tables_present} = 2 == $count;
937 $main::lxdebug->leave_sub();
939 return $self->{session_tables_present};
942 # --------------------------------------
944 sub all_rights_full {
945 my $locale = $main::locale;
948 ["--crm", $locale->text("CRM optional software")],
949 ["crm_search", $locale->text("CRM search")],
950 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
951 ["crm_service", $locale->text("CRM services")],
952 ["crm_admin", $locale->text("CRM admin")],
953 ["crm_adminuser", $locale->text("CRM user")],
954 ["crm_adminstatus", $locale->text("CRM status")],
955 ["crm_email", $locale->text("CRM send email")],
956 ["crm_termin", $locale->text("CRM termin")],
957 ["crm_opportunity", $locale->text("CRM opportunity")],
958 ["crm_knowhow", $locale->text("CRM know how")],
959 ["crm_follow", $locale->text("CRM follow up")],
960 ["crm_notices", $locale->text("CRM notices")],
961 ["crm_other", $locale->text("CRM other")],
962 ["--master_data", $locale->text("Master Data")],
963 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
964 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
965 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
966 ["project_edit", $locale->text("Create and edit projects")],
967 ["--ar", $locale->text("AR")],
968 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
969 ["sales_order_edit", $locale->text("Create and edit sales orders")],
970 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
971 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
972 ["dunning_edit", $locale->text("Create and edit dunnings")],
973 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
974 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
975 ["--ap", $locale->text("AP")],
976 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
977 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
978 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
979 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
980 ["--warehouse_management", $locale->text("Warehouse management")],
981 ["warehouse_contents", $locale->text("View warehouse content")],
982 ["warehouse_management", $locale->text("Warehouse management")],
983 ["--general_ledger_cash", $locale->text("General ledger and cash")],
984 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
985 ["datev_export", $locale->text("DATEV Export")],
986 ["cash", $locale->text("Receipt, payment, reconciliation")],
987 ["--reports", $locale->text('Reports')],
988 ["report", $locale->text('All reports')],
989 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
990 ["--batch_printing", $locale->text("Batch Printing")],
991 ["batch_printing", $locale->text("Batch Printing")],
992 ["--others", $locale->text("Others")],
993 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
994 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
995 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1002 return grep !/^--/, map { $_->[0] } all_rights_full();
1006 $main::lxdebug->enter_sub();
1010 my $form = $main::form;
1012 my $dbh = $self->dbconnect();
1014 my $query = 'SELECT * FROM auth."group"';
1015 my $sth = prepare_execute_query($form, $dbh, $query);
1019 while ($row = $sth->fetchrow_hashref()) {
1020 $groups->{$row->{id}} = $row;
1024 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1025 $sth = prepare_query($form, $dbh, $query);
1027 foreach $group (values %{$groups}) {
1030 do_statement($form, $sth, $query, $group->{id});
1032 while ($row = $sth->fetchrow_hashref()) {
1033 push @members, $row->{user_id};
1035 $group->{members} = [ uniq @members ];
1039 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1040 $sth = prepare_query($form, $dbh, $query);
1042 foreach $group (values %{$groups}) {
1043 $group->{rights} = {};
1045 do_statement($form, $sth, $query, $group->{id});
1047 while ($row = $sth->fetchrow_hashref()) {
1048 $group->{rights}->{$row->{right}} |= $row->{granted};
1051 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1055 $main::lxdebug->leave_sub();
1061 $main::lxdebug->enter_sub();
1066 my $form = $main::form;
1067 my $dbh = $self->dbconnect();
1071 my ($query, $sth, $row, $rights);
1073 if (!$group->{id}) {
1074 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1076 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1077 do_query($form, $dbh, $query, $group->{id});
1080 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1082 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1084 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1085 $sth = prepare_query($form, $dbh, $query);
1087 foreach my $user_id (uniq @{ $group->{members} }) {
1088 do_statement($form, $sth, $query, $user_id, $group->{id});
1092 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1094 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1095 $sth = prepare_query($form, $dbh, $query);
1097 foreach my $right (keys %{ $group->{rights} }) {
1098 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1104 $main::lxdebug->leave_sub();
1108 $main::lxdebug->enter_sub();
1113 my $form = $main::form;
1115 my $dbh = $self->dbconnect();
1118 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1119 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1120 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1124 $main::lxdebug->leave_sub();
1127 sub evaluate_rights_ary {
1128 $main::lxdebug->enter_sub(2);
1135 foreach my $el (@{$ary}) {
1136 if (ref $el eq "ARRAY") {
1137 if ($action eq '|') {
1138 $value |= evaluate_rights_ary($el);
1140 $value &= evaluate_rights_ary($el);
1143 } elsif (($el eq '&') || ($el eq '|')) {
1146 } elsif ($action eq '|') {
1155 $main::lxdebug->leave_sub(2);
1160 sub _parse_rights_string {
1161 $main::lxdebug->enter_sub(2);
1171 push @stack, $cur_ary;
1173 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1175 substr($access, 0, length $1) = "";
1177 next if ($token =~ /\s/);
1179 if ($token eq "(") {
1180 my $new_cur_ary = [];
1181 push @stack, $new_cur_ary;
1182 push @{$cur_ary}, $new_cur_ary;
1183 $cur_ary = $new_cur_ary;
1185 } elsif ($token eq ")") {
1189 $main::lxdebug->leave_sub(2);
1193 $cur_ary = $stack[-1];
1195 } elsif (($token eq "|") || ($token eq "&")) {
1196 push @{$cur_ary}, $token;
1199 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1203 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1205 $main::lxdebug->leave_sub(2);
1211 $main::lxdebug->enter_sub(2);
1216 my $default = shift;
1218 $self->{FULL_RIGHTS} ||= { };
1219 $self->{FULL_RIGHTS}->{$login} ||= { };
1221 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1222 $self->{RIGHTS} ||= { };
1223 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1225 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1228 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1229 $granted = $default if (!defined $granted);
1231 $main::lxdebug->leave_sub(2);
1237 $::lxdebug->enter_sub(2);
1238 my ($self, $right, $dont_abort) = @_;
1240 if ($self->check_right($::myconfig{login}, $right)) {
1241 $::lxdebug->leave_sub(2);
1246 delete $::form->{title};
1247 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1250 $::lxdebug->leave_sub(2);
1255 sub load_rights_for_user {
1256 $::lxdebug->enter_sub;
1258 my ($self, $login) = @_;
1259 my $dbh = $self->dbconnect;
1260 my ($query, $sth, $row, $rights);
1262 $rights = { map { $_ => 0 } all_rights() };
1265 qq|SELECT gr."right", gr.granted
1266 FROM auth.group_rights gr
1269 FROM auth.user_group ug
1270 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1271 WHERE u.login = ?)|;
1273 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1275 while ($row = $sth->fetchrow_hashref()) {
1276 $rights->{$row->{right}} |= $row->{granted};
1280 $::lxdebug->leave_sub;
1294 SL::Auth - Authentication and session handling
1300 =item C<set_session_value @values>
1301 =item C<set_session_value %values>
1303 Store all values of C<@values> or C<%values> in the session. Each
1304 member of C<@values> is tested if it is a hash reference. If it is
1305 then it must contain the keys C<key> and C<value> and can optionally
1306 contain the key C<auto_restore>. In this case C<value> is associated
1307 with C<key> and restored to C<$::form> upon the next request
1308 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1311 If the current member of C<@values> is not a hash reference then it
1312 will be used as the C<key> and the next entry of C<@values> is used as
1313 the C<value> to store. In this case setting C<auto_restore> is not
1316 Therefore the following two invocations are identical:
1318 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1319 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1321 All of these values are copied back into C<$::form> for the next
1322 request automatically if they're scalar values or if they have
1323 C<auto_restore> set to trueish.
1325 The values can be any Perl structure. They are stored as YAML dumps.
1327 =item C<get_session_value $key>
1329 Retrieve a value from the session. Returns C<undef> if the value
1332 =item C<create_unique_sesion_value $value, %params>
1334 Create a unique key in the session and store C<$value>
1337 Returns the key created in the session.
1339 =item C<save_session>
1341 Stores the session values in the database. This is the only function
1342 that actually stores stuff in the database. Neither the various
1343 setters nor the deleter access the database.
1345 =item <save_form_in_session %params>
1347 Stores the content of C<$params{form}> (default: C<$::form>) in the
1348 session using L</create_unique_sesion_value>.
1350 If C<$params{non_scalars}> is trueish then non-scalar values will be
1351 stored as well. Default is to only store scalar values.
1353 The following keys will never be saved: C<login>, C<password>,
1354 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1355 can be given as an array ref in C<$params{skip_keys}>.
1357 Returns the unique key under which the form is stored.
1359 =item <restore_form_from_session $key, %params>
1361 Restores the form from the session into C<$params{form}> (default:
1364 If C<$params{clobber}> is falsish then existing values with the same
1365 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1378 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>