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;
26 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
27 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
30 $main::lxdebug->enter_sub();
37 $self->_read_auth_config();
40 $main::lxdebug->leave_sub();
46 my ($self, %params) = @_;
48 $self->{SESSION} = { };
49 $self->{FULL_RIGHTS} = { };
50 $self->{RIGHTS} = { };
51 $self->{unique_counter} = 0;
52 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
53 $self->{authenticator}->reset;
57 my ($self, $login, %params) = @_;
58 my $may_fail = delete $params{may_fail};
60 my %user = $self->read_user(login => $login);
61 my $dbh = SL::DBConnect->connect(
66 pg_enable_utf8 => $::locale->is_utf8,
71 if (!$may_fail && !$dbh) {
72 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
75 if ($user{dboptions} && $dbh) {
76 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
85 $self->{dbh}->disconnect() if ($self->{dbh});
88 # form isn't loaded yet, so auth needs it's own error.
90 $::lxdebug->show_backtrace();
92 my ($self, @msg) = @_;
93 if ($ENV{HTTP_USER_AGENT}) {
94 print Form->create_http_response(content_type => 'text/html');
95 print "<pre>", join ('<br>', @msg), "</pre>";
97 print STDERR "Error: @msg\n";
102 sub _read_auth_config {
103 $main::lxdebug->enter_sub();
107 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
109 # Prevent password leakage to log files when dumping Auth instances.
110 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
112 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
113 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
115 if ($self->{module} eq 'DB') {
116 $self->{authenticator} = SL::Auth::DB->new($self);
118 } elsif ($self->{module} eq 'LDAP') {
119 $self->{authenticator} = SL::Auth::LDAP->new($self);
122 if (!$self->{authenticator}) {
123 my $locale = Locale->new('en');
124 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
127 my $cfg = $self->{DB_config};
130 my $locale = Locale->new('en');
131 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
134 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
135 my $locale = Locale->new('en');
136 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
139 $self->{authenticator}->verify_config();
141 $self->{session_timeout} *= 1;
142 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
144 $main::lxdebug->leave_sub();
147 sub authenticate_root {
148 $main::lxdebug->enter_sub();
150 my ($self, $password) = @_;
152 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH);
153 if (defined $session_root_auth && $session_root_auth == OK) {
154 $::lxdebug->leave_sub;
158 if (!defined $password) {
159 $::lxdebug->leave_sub;
163 $password = SL::Auth::Password->hash(login => 'root', password => $password);
164 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
166 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
167 $self->set_session_value(SESSION_KEY_ROOT_AUTH ,=> $result);
169 sleep 5 if $result != OK;
171 $::lxdebug->leave_sub;
176 $main::lxdebug->enter_sub();
178 my ($self, $login, $password) = @_;
180 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH);
181 if (defined $session_auth && $session_auth == OK) {
182 $::lxdebug->leave_sub;
186 if (!defined $password) {
187 $::lxdebug->leave_sub;
191 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
192 $self->set_session_value(SESSION_KEY_USER_AUTH ,=> $result, login => $login);
194 sleep 5 if $result != OK;
196 $::lxdebug->leave_sub;
200 sub get_stored_password {
201 my ($self, $login) = @_;
203 my $dbh = $self->dbconnect;
205 return undef unless $dbh;
207 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
208 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
210 return $stored_password;
214 $main::lxdebug->enter_sub(2);
217 my $may_fail = shift;
220 $main::lxdebug->leave_sub(2);
224 my $cfg = $self->{DB_config};
225 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
228 $dsn .= ';port=' . $cfg->{port};
231 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
233 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
235 if (!$may_fail && !$self->{dbh}) {
236 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
239 $main::lxdebug->leave_sub(2);
245 $main::lxdebug->enter_sub();
250 $self->{dbh}->disconnect();
254 $main::lxdebug->leave_sub();
258 $main::lxdebug->enter_sub();
260 my ($self, $dbh) = @_;
262 $dbh ||= $self->dbconnect();
263 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
265 my ($count) = $dbh->selectrow_array($query);
267 $main::lxdebug->leave_sub();
273 $main::lxdebug->enter_sub();
277 my $dbh = $self->dbconnect(1);
279 $main::lxdebug->leave_sub();
284 sub create_database {
285 $main::lxdebug->enter_sub();
290 my $cfg = $self->{DB_config};
292 if (!$params{superuser}) {
293 $params{superuser} = $cfg->{user};
294 $params{superuser_password} = $cfg->{password};
297 $params{template} ||= 'template0';
298 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
300 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
303 $dsn .= ';port=' . $cfg->{port};
306 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
308 my $charset = $::lx_office_conf{system}->{dbcharset};
309 $charset ||= Common::DEFAULT_CHARSET;
310 my $encoding = $Common::charset_to_db_encoding{$charset};
311 $encoding ||= 'UNICODE';
313 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
316 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
319 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
321 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
326 my $error = $dbh->errstr();
328 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
329 my ($cluster_encoding) = $dbh->selectrow_array($query);
331 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
332 $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.');
337 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
342 $main::lxdebug->leave_sub();
346 $main::lxdebug->enter_sub();
349 my $dbh = $self->dbconnect();
351 my $charset = $::lx_office_conf{system}->{dbcharset};
352 $charset ||= Common::DEFAULT_CHARSET;
355 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
357 $main::lxdebug->leave_sub();
361 $main::lxdebug->enter_sub();
367 my $form = $main::form;
369 my $dbh = $self->dbconnect();
371 my ($sth, $query, $user_id);
375 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
376 ($user_id) = selectrow_query($form, $dbh, $query, $login);
379 $query = qq|SELECT nextval('auth.user_id_seq')|;
380 ($user_id) = selectrow_query($form, $dbh, $query);
382 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
383 do_query($form, $dbh, $query, $user_id, $login);
386 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
387 do_query($form, $dbh, $query, $user_id);
389 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
390 $sth = prepare_query($form, $dbh, $query);
392 while (my ($cfg_key, $cfg_value) = each %params) {
393 next if ($cfg_key eq 'password');
395 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
400 $main::lxdebug->leave_sub();
403 sub can_change_password {
406 return $self->{authenticator}->can_change_password();
409 sub change_password {
410 $main::lxdebug->enter_sub();
412 my ($self, $login, $new_password) = @_;
414 my $result = $self->{authenticator}->change_password($login, $new_password);
416 $main::lxdebug->leave_sub();
422 $main::lxdebug->enter_sub();
426 my $dbh = $self->dbconnect();
427 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
428 FROM auth.user_config cfg
429 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
430 my $sth = prepare_execute_query($main::form, $dbh, $query);
434 while (my $ref = $sth->fetchrow_hashref()) {
435 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
436 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
441 $main::lxdebug->leave_sub();
447 $main::lxdebug->enter_sub();
449 my ($self, %params) = @_;
451 my $dbh = $self->dbconnect();
453 my (@where, @values);
454 if ($params{login}) {
455 push @where, 'u.login = ?';
456 push @values, $params{login};
459 push @where, 'u.id = ?';
460 push @values, $params{id};
462 my $where = join ' AND ', '1 = 1', @where;
463 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
464 FROM auth.user_config cfg
465 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
467 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
471 while (my $ref = $sth->fetchrow_hashref()) {
472 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
473 @user_data{qw(id login)} = @{$ref}{qw(id login)};
476 # The XUL/XML backed menu has been removed.
477 $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
481 $main::lxdebug->leave_sub();
487 $main::lxdebug->enter_sub();
492 my $dbh = $self->dbconnect();
493 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
495 $main::lxdebug->leave_sub();
501 $::lxdebug->enter_sub;
506 my $dbh = $self->dbconnect;
507 my $id = $self->get_user_id($login);
510 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
512 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
513 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
515 $u_dbh->begin_work if $u_dbh && $user_db_exists;
519 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
520 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
521 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
522 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
525 $u_dbh->commit if $u_dbh && $user_db_exists;
527 $::lxdebug->leave_sub;
530 # --------------------------------------
534 sub restore_session {
535 $main::lxdebug->enter_sub();
539 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
540 $session_id =~ s|[^0-9a-f]||g if $session_id;
542 $self->{SESSION} = { };
545 $main::lxdebug->leave_sub();
549 my ($dbh, $query, $sth, $cookie, $ref, $form);
553 # Don't fail if the auth DB doesn't yet.
554 if (!( $dbh = $self->dbconnect(1) )) {
555 $::lxdebug->leave_sub;
559 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
560 # admin is creating the session tables at the moment.
561 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
563 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
564 $sth->finish if $sth;
565 $::lxdebug->leave_sub;
569 $cookie = $sth->fetchrow_hashref;
572 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
573 $self->destroy_session();
574 $main::lxdebug->leave_sub();
575 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
578 if ($self->{column_information}->has('auto_restore')) {
579 $self->_load_with_auto_restore_column($dbh, $session_id);
581 $self->_load_without_auto_restore_column($dbh, $session_id);
584 $main::lxdebug->leave_sub();
589 sub _load_without_auto_restore_column {
590 my ($self, $dbh, $session_id) = @_;
593 SELECT sess_key, sess_value
594 FROM auth.session_content
595 WHERE (session_id = ?)
597 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
599 while (my $ref = $sth->fetchrow_hashref) {
600 my $value = SL::Auth::SessionValue->new(auth => $self,
601 key => $ref->{sess_key},
602 value => $ref->{sess_value},
604 $self->{SESSION}->{ $ref->{sess_key} } = $value;
606 next if defined $::form->{$ref->{sess_key}};
608 my $data = $value->get;
609 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
613 sub _load_with_auto_restore_column {
614 my ($self, $dbh, $session_id) = @_;
616 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
619 SELECT sess_key, sess_value, auto_restore
620 FROM auth.session_content
621 WHERE (session_id = ?)
623 OR sess_key IN (${auto_restore_keys}))
625 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
627 while (my $ref = $sth->fetchrow_hashref) {
628 my $value = SL::Auth::SessionValue->new(auth => $self,
629 key => $ref->{sess_key},
630 value => $ref->{sess_value},
631 auto_restore => $ref->{auto_restore},
633 $self->{SESSION}->{ $ref->{sess_key} } = $value;
635 next if defined $::form->{$ref->{sess_key}};
637 my $data = $value->get;
638 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
645 FROM auth.session_content
646 WHERE (session_id = ?)
647 AND NOT COALESCE(auto_restore, FALSE)
648 AND (sess_key NOT IN (${auto_restore_keys}))
650 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
652 while (my $ref = $sth->fetchrow_hashref) {
653 my $value = SL::Auth::SessionValue->new(auth => $self,
654 key => $ref->{sess_key});
655 $self->{SESSION}->{ $ref->{sess_key} } = $value;
659 sub destroy_session {
660 $main::lxdebug->enter_sub();
665 my $dbh = $self->dbconnect();
669 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
670 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
674 SL::SessionFile->destroy_session($session_id);
677 $self->{SESSION} = { };
680 $main::lxdebug->leave_sub();
683 sub expire_sessions {
684 $main::lxdebug->enter_sub();
688 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
690 my $dbh = $self->dbconnect();
692 my $query = qq|SELECT id
694 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
696 my @ids = selectall_array_query($::form, $dbh, $query);
701 SL::SessionFile->destroy_session($_) for @ids;
703 $query = qq|DELETE FROM auth.session_content
704 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
705 do_query($main::form, $dbh, $query, @ids);
707 $query = qq|DELETE FROM auth.session
708 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
709 do_query($main::form, $dbh, $query, @ids);
714 $main::lxdebug->leave_sub();
717 sub _create_session_id {
718 $main::lxdebug->enter_sub();
721 map { push @data, int(rand() * 255); } (1..32);
723 my $id = md5_hex(pack 'C*', @data);
725 $main::lxdebug->leave_sub();
730 sub create_or_refresh_session {
731 $session_id ||= shift->_create_session_id;
735 $::lxdebug->enter_sub;
737 my $provided_dbh = shift;
739 my $dbh = $provided_dbh || $self->dbconnect(1);
741 $::lxdebug->leave_sub && return unless $dbh && $session_id;
743 $dbh->begin_work unless $provided_dbh;
745 # If this fails then the "auth" schema might not exist yet, e.g. if
746 # the admin is just trying to create the auth database.
747 if (!$dbh->do(qq|LOCK auth.session_content|)) {
748 $dbh->rollback unless $provided_dbh;
749 $::lxdebug->leave_sub;
753 my @unfetched_keys = map { $_->{key} }
754 grep { ! $_->{fetched} }
755 values %{ $self->{SESSION} };
756 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
757 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
758 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
759 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
761 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
763 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
766 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
768 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
771 my @values_to_save = grep { $_->{fetched} }
772 values %{ $self->{SESSION} };
773 if (@values_to_save) {
774 my ($columns, $placeholders) = ('', '');
775 my $auto_restore = $self->{column_information}->has('auto_restore');
778 $columns .= ', auto_restore';
779 $placeholders .= ', ?';
782 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
783 my $sth = prepare_query($::form, $dbh, $query);
785 foreach my $value (@values_to_save) {
786 my @values = ($value->{key}, $value->get_dumped);
787 push @values, $value->{auto_restore} if $auto_restore;
789 do_statement($::form, $sth, $query, $session_id, @values);
795 $dbh->commit() unless $provided_dbh;
796 $::lxdebug->leave_sub;
799 sub set_session_value {
800 $main::lxdebug->enter_sub();
805 $self->{SESSION} ||= { };
808 my $key = shift @params;
810 if (ref $key eq 'HASH') {
811 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
812 value => $key->{value},
813 auto_restore => $key->{auto_restore});
816 my $value = shift @params;
817 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
822 $main::lxdebug->leave_sub();
827 sub delete_session_value {
828 $main::lxdebug->enter_sub();
832 $self->{SESSION} ||= { };
833 delete @{ $self->{SESSION} }{ @_ };
835 $main::lxdebug->leave_sub();
840 sub get_session_value {
841 $main::lxdebug->enter_sub();
844 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
846 $main::lxdebug->leave_sub();
851 sub create_unique_sesion_value {
852 my ($self, $value, %params) = @_;
854 $self->{SESSION} ||= { };
856 my @now = gettimeofday();
857 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
858 $self->{unique_counter} ||= 0;
862 $self->{unique_counter}++;
863 $hashed_key = md5_hex($key . $self->{unique_counter});
864 } while (exists $self->{SESSION}->{$hashed_key});
866 $self->set_session_value($hashed_key => $value);
871 sub save_form_in_session {
872 my ($self, %params) = @_;
874 my $form = delete($params{form}) || $::form;
875 my $non_scalars = delete $params{non_scalars};
878 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
880 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
881 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
884 return $self->create_unique_sesion_value($data, %params);
887 sub restore_form_from_session {
888 my ($self, $key, %params) = @_;
890 my $data = $self->get_session_value($key);
891 return $self unless $data;
893 my $form = delete($params{form}) || $::form;
894 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
896 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
901 sub set_cookie_environment_variable {
903 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
906 sub get_session_cookie_name {
909 return $self->{cookie_name} || 'lx_office_erp_session_id';
916 sub session_tables_present {
917 $main::lxdebug->enter_sub();
921 # Only re-check for the presence of auth tables if either the check
922 # hasn't been done before of if they weren't present.
923 if ($self->{session_tables_present}) {
924 $main::lxdebug->leave_sub();
925 return $self->{session_tables_present};
928 my $dbh = $self->dbconnect(1);
931 $main::lxdebug->leave_sub();
938 WHERE (schemaname = 'auth')
939 AND (tablename IN ('session', 'session_content'))|;
941 my ($count) = selectrow_query($main::form, $dbh, $query);
943 $self->{session_tables_present} = 2 == $count;
945 $main::lxdebug->leave_sub();
947 return $self->{session_tables_present};
950 # --------------------------------------
952 sub all_rights_full {
953 my $locale = $main::locale;
956 ["--crm", $locale->text("CRM optional software")],
957 ["crm_search", $locale->text("CRM search")],
958 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
959 ["crm_service", $locale->text("CRM services")],
960 ["crm_admin", $locale->text("CRM admin")],
961 ["crm_adminuser", $locale->text("CRM user")],
962 ["crm_adminstatus", $locale->text("CRM status")],
963 ["crm_email", $locale->text("CRM send email")],
964 ["crm_termin", $locale->text("CRM termin")],
965 ["crm_opportunity", $locale->text("CRM opportunity")],
966 ["crm_knowhow", $locale->text("CRM know how")],
967 ["crm_follow", $locale->text("CRM follow up")],
968 ["crm_notices", $locale->text("CRM notices")],
969 ["crm_other", $locale->text("CRM other")],
970 ["--master_data", $locale->text("Master Data")],
971 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
972 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
973 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
974 ["project_edit", $locale->text("Create and edit projects")],
975 ["--ar", $locale->text("AR")],
976 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
977 ["sales_order_edit", $locale->text("Create and edit sales orders")],
978 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
979 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
980 ["dunning_edit", $locale->text("Create and edit dunnings")],
981 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
982 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
983 ["--ap", $locale->text("AP")],
984 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
985 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
986 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
987 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
988 ["--warehouse_management", $locale->text("Warehouse management")],
989 ["warehouse_contents", $locale->text("View warehouse content")],
990 ["warehouse_management", $locale->text("Warehouse management")],
991 ["--general_ledger_cash", $locale->text("General ledger and cash")],
992 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
993 ["datev_export", $locale->text("DATEV Export")],
994 ["cash", $locale->text("Receipt, payment, reconciliation")],
995 ["--reports", $locale->text('Reports')],
996 ["report", $locale->text('All reports')],
997 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
998 ["--batch_printing", $locale->text("Batch Printing")],
999 ["batch_printing", $locale->text("Batch Printing")],
1000 ["--others", $locale->text("Others")],
1001 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1002 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
1003 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1010 return grep !/^--/, map { $_->[0] } all_rights_full();
1014 $main::lxdebug->enter_sub();
1018 my $form = $main::form;
1020 my $dbh = $self->dbconnect();
1022 my $query = 'SELECT * FROM auth."group"';
1023 my $sth = prepare_execute_query($form, $dbh, $query);
1027 while ($row = $sth->fetchrow_hashref()) {
1028 $groups->{$row->{id}} = $row;
1032 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1033 $sth = prepare_query($form, $dbh, $query);
1035 foreach $group (values %{$groups}) {
1038 do_statement($form, $sth, $query, $group->{id});
1040 while ($row = $sth->fetchrow_hashref()) {
1041 push @members, $row->{user_id};
1043 $group->{members} = [ uniq @members ];
1047 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1048 $sth = prepare_query($form, $dbh, $query);
1050 foreach $group (values %{$groups}) {
1051 $group->{rights} = {};
1053 do_statement($form, $sth, $query, $group->{id});
1055 while ($row = $sth->fetchrow_hashref()) {
1056 $group->{rights}->{$row->{right}} |= $row->{granted};
1059 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1063 $main::lxdebug->leave_sub();
1069 $main::lxdebug->enter_sub();
1074 my $form = $main::form;
1075 my $dbh = $self->dbconnect();
1079 my ($query, $sth, $row, $rights);
1081 if (!$group->{id}) {
1082 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1084 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1085 do_query($form, $dbh, $query, $group->{id});
1088 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1090 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1092 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1093 $sth = prepare_query($form, $dbh, $query);
1095 foreach my $user_id (uniq @{ $group->{members} }) {
1096 do_statement($form, $sth, $query, $user_id, $group->{id});
1100 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1102 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1103 $sth = prepare_query($form, $dbh, $query);
1105 foreach my $right (keys %{ $group->{rights} }) {
1106 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1112 $main::lxdebug->leave_sub();
1116 $main::lxdebug->enter_sub();
1121 my $form = $main::form;
1123 my $dbh = $self->dbconnect();
1126 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1127 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1128 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1132 $main::lxdebug->leave_sub();
1135 sub evaluate_rights_ary {
1136 $main::lxdebug->enter_sub(2);
1143 foreach my $el (@{$ary}) {
1144 if (ref $el eq "ARRAY") {
1145 if ($action eq '|') {
1146 $value |= evaluate_rights_ary($el);
1148 $value &= evaluate_rights_ary($el);
1151 } elsif (($el eq '&') || ($el eq '|')) {
1154 } elsif ($action eq '|') {
1163 $main::lxdebug->leave_sub(2);
1168 sub _parse_rights_string {
1169 $main::lxdebug->enter_sub(2);
1179 push @stack, $cur_ary;
1181 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1183 substr($access, 0, length $1) = "";
1185 next if ($token =~ /\s/);
1187 if ($token eq "(") {
1188 my $new_cur_ary = [];
1189 push @stack, $new_cur_ary;
1190 push @{$cur_ary}, $new_cur_ary;
1191 $cur_ary = $new_cur_ary;
1193 } elsif ($token eq ")") {
1197 $main::lxdebug->leave_sub(2);
1201 $cur_ary = $stack[-1];
1203 } elsif (($token eq "|") || ($token eq "&")) {
1204 push @{$cur_ary}, $token;
1207 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1211 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1213 $main::lxdebug->leave_sub(2);
1219 $main::lxdebug->enter_sub(2);
1224 my $default = shift;
1226 $self->{FULL_RIGHTS} ||= { };
1227 $self->{FULL_RIGHTS}->{$login} ||= { };
1229 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1230 $self->{RIGHTS} ||= { };
1231 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1233 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1236 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1237 $granted = $default if (!defined $granted);
1239 $main::lxdebug->leave_sub(2);
1245 $::lxdebug->enter_sub(2);
1246 my ($self, $right, $dont_abort) = @_;
1248 if ($self->check_right($::myconfig{login}, $right)) {
1249 $::lxdebug->leave_sub(2);
1254 delete $::form->{title};
1255 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1258 $::lxdebug->leave_sub(2);
1263 sub load_rights_for_user {
1264 $::lxdebug->enter_sub;
1266 my ($self, $login) = @_;
1267 my $dbh = $self->dbconnect;
1268 my ($query, $sth, $row, $rights);
1270 $rights = { map { $_ => 0 } all_rights() };
1273 qq|SELECT gr."right", gr.granted
1274 FROM auth.group_rights gr
1277 FROM auth.user_group ug
1278 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1279 WHERE u.login = ?)|;
1281 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1283 while ($row = $sth->fetchrow_hashref()) {
1284 $rights->{$row->{right}} |= $row->{granted};
1288 $::lxdebug->leave_sub;
1302 SL::Auth - Authentication and session handling
1308 =item C<set_session_value @values>
1310 =item C<set_session_value %values>
1312 Store all values of C<@values> or C<%values> in the session. Each
1313 member of C<@values> is tested if it is a hash reference. If it is
1314 then it must contain the keys C<key> and C<value> and can optionally
1315 contain the key C<auto_restore>. In this case C<value> is associated
1316 with C<key> and restored to C<$::form> upon the next request
1317 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1320 If the current member of C<@values> is not a hash reference then it
1321 will be used as the C<key> and the next entry of C<@values> is used as
1322 the C<value> to store. In this case setting C<auto_restore> is not
1325 Therefore the following two invocations are identical:
1327 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1328 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1330 All of these values are copied back into C<$::form> for the next
1331 request automatically if they're scalar values or if they have
1332 C<auto_restore> set to trueish.
1334 The values can be any Perl structure. They are stored as YAML dumps.
1336 =item C<get_session_value $key>
1338 Retrieve a value from the session. Returns C<undef> if the value
1341 =item C<create_unique_sesion_value $value, %params>
1343 Create a unique key in the session and store C<$value>
1346 Returns the key created in the session.
1348 =item C<save_session>
1350 Stores the session values in the database. This is the only function
1351 that actually stores stuff in the database. Neither the various
1352 setters nor the deleter access the database.
1354 =item <save_form_in_session %params>
1356 Stores the content of C<$params{form}> (default: C<$::form>) in the
1357 session using L</create_unique_sesion_value>.
1359 If C<$params{non_scalars}> is trueish then non-scalar values will be
1360 stored as well. Default is to only store scalar values.
1362 The following keys will never be saved: C<login>, C<password>,
1363 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1364 can be given as an array ref in C<$params{skip_keys}>.
1366 Returns the unique key under which the form is stored.
1368 =item <restore_form_from_session $key, %params>
1370 Restores the form from the session into C<$params{form}> (default:
1373 If C<$params{clobber}> is falsish then existing values with the same
1374 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1387 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>