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 $::lxdebug->leave_sub;
174 $main::lxdebug->enter_sub();
176 my ($self, $login, $password) = @_;
178 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
179 if (defined $session_auth && $session_auth == OK) {
180 $::lxdebug->leave_sub;
184 if (!defined $password) {
185 $::lxdebug->leave_sub;
189 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
190 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login);
192 $::lxdebug->leave_sub;
196 sub punish_wrong_login {
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, s.mtime AS last_action
429 FROM auth."user" AS u
431 LEFT JOIN auth.user_config AS cfg
432 ON (cfg.user_id = u.id)
434 LEFT JOIN auth.session_content AS sc_login
435 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
437 LEFT JOIN auth.session AS s
438 ON (s.id = sc_login.session_id)
440 my $sth = prepare_execute_query($main::form, $dbh, $query);
444 while (my $ref = $sth->fetchrow_hashref()) {
446 $users{$ref->{login}} ||= {
447 'login' => $ref->{login},
449 'last_action' => $ref->{last_action},
451 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
456 $main::lxdebug->leave_sub();
462 $main::lxdebug->enter_sub();
464 my ($self, %params) = @_;
466 my $dbh = $self->dbconnect();
468 my (@where, @values);
469 if ($params{login}) {
470 push @where, 'u.login = ?';
471 push @values, $params{login};
474 push @where, 'u.id = ?';
475 push @values, $params{id};
477 my $where = join ' AND ', '1 = 1', @where;
478 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
479 FROM auth.user_config cfg
480 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
482 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
486 while (my $ref = $sth->fetchrow_hashref()) {
487 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
488 @user_data{qw(id login)} = @{$ref}{qw(id login)};
491 # The XUL/XML backed menu has been removed.
492 $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
496 $main::lxdebug->leave_sub();
502 $main::lxdebug->enter_sub();
507 my $dbh = $self->dbconnect();
508 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
510 $main::lxdebug->leave_sub();
516 $::lxdebug->enter_sub;
521 my $dbh = $self->dbconnect;
522 my $id = $self->get_user_id($login);
525 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
527 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
528 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
530 $u_dbh->begin_work if $u_dbh && $user_db_exists;
534 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
535 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
536 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
537 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
540 $u_dbh->commit if $u_dbh && $user_db_exists;
542 $::lxdebug->leave_sub;
545 # --------------------------------------
549 sub restore_session {
550 $main::lxdebug->enter_sub();
554 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
555 $session_id =~ s|[^0-9a-f]||g if $session_id;
557 $self->{SESSION} = { };
560 $main::lxdebug->leave_sub();
564 my ($dbh, $query, $sth, $cookie, $ref, $form);
568 # Don't fail if the auth DB doesn't yet.
569 if (!( $dbh = $self->dbconnect(1) )) {
570 $::lxdebug->leave_sub;
574 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
575 # admin is creating the session tables at the moment.
576 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
578 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
579 $sth->finish if $sth;
580 $::lxdebug->leave_sub;
584 $cookie = $sth->fetchrow_hashref;
587 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
588 $self->destroy_session();
589 $main::lxdebug->leave_sub();
590 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
593 if ($self->{column_information}->has('auto_restore')) {
594 $self->_load_with_auto_restore_column($dbh, $session_id);
596 $self->_load_without_auto_restore_column($dbh, $session_id);
599 $main::lxdebug->leave_sub();
604 sub _load_without_auto_restore_column {
605 my ($self, $dbh, $session_id) = @_;
608 SELECT sess_key, sess_value
609 FROM auth.session_content
610 WHERE (session_id = ?)
612 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
614 while (my $ref = $sth->fetchrow_hashref) {
615 my $value = SL::Auth::SessionValue->new(auth => $self,
616 key => $ref->{sess_key},
617 value => $ref->{sess_value},
619 $self->{SESSION}->{ $ref->{sess_key} } = $value;
621 next if defined $::form->{$ref->{sess_key}};
623 my $data = $value->get;
624 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
628 sub _load_with_auto_restore_column {
629 my ($self, $dbh, $session_id) = @_;
631 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
634 SELECT sess_key, sess_value, auto_restore
635 FROM auth.session_content
636 WHERE (session_id = ?)
638 OR sess_key IN (${auto_restore_keys}))
640 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
642 while (my $ref = $sth->fetchrow_hashref) {
643 my $value = SL::Auth::SessionValue->new(auth => $self,
644 key => $ref->{sess_key},
645 value => $ref->{sess_value},
646 auto_restore => $ref->{auto_restore},
648 $self->{SESSION}->{ $ref->{sess_key} } = $value;
650 next if defined $::form->{$ref->{sess_key}};
652 my $data = $value->get;
653 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
660 FROM auth.session_content
661 WHERE (session_id = ?)
662 AND NOT COALESCE(auto_restore, FALSE)
663 AND (sess_key NOT IN (${auto_restore_keys}))
665 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
667 while (my $ref = $sth->fetchrow_hashref) {
668 my $value = SL::Auth::SessionValue->new(auth => $self,
669 key => $ref->{sess_key});
670 $self->{SESSION}->{ $ref->{sess_key} } = $value;
674 sub destroy_session {
675 $main::lxdebug->enter_sub();
680 my $dbh = $self->dbconnect();
684 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
685 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
689 SL::SessionFile->destroy_session($session_id);
692 $self->{SESSION} = { };
695 $main::lxdebug->leave_sub();
698 sub expire_sessions {
699 $main::lxdebug->enter_sub();
703 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
705 my $dbh = $self->dbconnect();
707 my $query = qq|SELECT id
709 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
711 my @ids = selectall_array_query($::form, $dbh, $query);
716 SL::SessionFile->destroy_session($_) for @ids;
718 $query = qq|DELETE FROM auth.session_content
719 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
720 do_query($main::form, $dbh, $query, @ids);
722 $query = qq|DELETE FROM auth.session
723 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
724 do_query($main::form, $dbh, $query, @ids);
729 $main::lxdebug->leave_sub();
732 sub _create_session_id {
733 $main::lxdebug->enter_sub();
736 map { push @data, int(rand() * 255); } (1..32);
738 my $id = md5_hex(pack 'C*', @data);
740 $main::lxdebug->leave_sub();
745 sub create_or_refresh_session {
746 $session_id ||= shift->_create_session_id;
750 $::lxdebug->enter_sub;
752 my $provided_dbh = shift;
754 my $dbh = $provided_dbh || $self->dbconnect(1);
756 $::lxdebug->leave_sub && return unless $dbh && $session_id;
758 $dbh->begin_work unless $provided_dbh;
760 # If this fails then the "auth" schema might not exist yet, e.g. if
761 # the admin is just trying to create the auth database.
762 if (!$dbh->do(qq|LOCK auth.session_content|)) {
763 $dbh->rollback unless $provided_dbh;
764 $::lxdebug->leave_sub;
768 my @unfetched_keys = map { $_->{key} }
769 grep { ! $_->{fetched} }
770 values %{ $self->{SESSION} };
771 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
772 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
773 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
774 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
776 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
778 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
781 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
783 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
786 my @values_to_save = grep { $_->{fetched} }
787 values %{ $self->{SESSION} };
788 if (@values_to_save) {
789 my ($columns, $placeholders) = ('', '');
790 my $auto_restore = $self->{column_information}->has('auto_restore');
793 $columns .= ', auto_restore';
794 $placeholders .= ', ?';
797 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
798 my $sth = prepare_query($::form, $dbh, $query);
800 foreach my $value (@values_to_save) {
801 my @values = ($value->{key}, $value->get_dumped);
802 push @values, $value->{auto_restore} if $auto_restore;
804 do_statement($::form, $sth, $query, $session_id, @values);
810 $dbh->commit() unless $provided_dbh;
811 $::lxdebug->leave_sub;
814 sub set_session_value {
815 $main::lxdebug->enter_sub();
820 $self->{SESSION} ||= { };
823 my $key = shift @params;
825 if (ref $key eq 'HASH') {
826 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
827 value => $key->{value},
828 auto_restore => $key->{auto_restore});
831 my $value = shift @params;
832 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
837 $main::lxdebug->leave_sub();
842 sub delete_session_value {
843 $main::lxdebug->enter_sub();
847 $self->{SESSION} ||= { };
848 delete @{ $self->{SESSION} }{ @_ };
850 $main::lxdebug->leave_sub();
855 sub get_session_value {
856 $main::lxdebug->enter_sub();
859 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
861 $main::lxdebug->leave_sub();
866 sub create_unique_sesion_value {
867 my ($self, $value, %params) = @_;
869 $self->{SESSION} ||= { };
871 my @now = gettimeofday();
872 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
873 $self->{unique_counter} ||= 0;
877 $self->{unique_counter}++;
878 $hashed_key = md5_hex($key . $self->{unique_counter});
879 } while (exists $self->{SESSION}->{$hashed_key});
881 $self->set_session_value($hashed_key => $value);
886 sub save_form_in_session {
887 my ($self, %params) = @_;
889 my $form = delete($params{form}) || $::form;
890 my $non_scalars = delete $params{non_scalars};
893 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
895 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
896 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
899 return $self->create_unique_sesion_value($data, %params);
902 sub restore_form_from_session {
903 my ($self, $key, %params) = @_;
905 my $data = $self->get_session_value($key);
906 return $self unless $data;
908 my $form = delete($params{form}) || $::form;
909 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
911 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
916 sub set_cookie_environment_variable {
918 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
921 sub get_session_cookie_name {
924 return $self->{cookie_name} || 'lx_office_erp_session_id';
931 sub session_tables_present {
932 $main::lxdebug->enter_sub();
936 # Only re-check for the presence of auth tables if either the check
937 # hasn't been done before of if they weren't present.
938 if ($self->{session_tables_present}) {
939 $main::lxdebug->leave_sub();
940 return $self->{session_tables_present};
943 my $dbh = $self->dbconnect(1);
946 $main::lxdebug->leave_sub();
953 WHERE (schemaname = 'auth')
954 AND (tablename IN ('session', 'session_content'))|;
956 my ($count) = selectrow_query($main::form, $dbh, $query);
958 $self->{session_tables_present} = 2 == $count;
960 $main::lxdebug->leave_sub();
962 return $self->{session_tables_present};
965 # --------------------------------------
967 sub all_rights_full {
968 my $locale = $main::locale;
971 ["--crm", $locale->text("CRM optional software")],
972 ["crm_search", $locale->text("CRM search")],
973 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
974 ["crm_service", $locale->text("CRM services")],
975 ["crm_admin", $locale->text("CRM admin")],
976 ["crm_adminuser", $locale->text("CRM user")],
977 ["crm_adminstatus", $locale->text("CRM status")],
978 ["crm_email", $locale->text("CRM send email")],
979 ["crm_termin", $locale->text("CRM termin")],
980 ["crm_opportunity", $locale->text("CRM opportunity")],
981 ["crm_knowhow", $locale->text("CRM know how")],
982 ["crm_follow", $locale->text("CRM follow up")],
983 ["crm_notices", $locale->text("CRM notices")],
984 ["crm_other", $locale->text("CRM other")],
985 ["--master_data", $locale->text("Master Data")],
986 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
987 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
988 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
989 ["project_edit", $locale->text("Create and edit projects")],
990 ["--ar", $locale->text("AR")],
991 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
992 ["sales_order_edit", $locale->text("Create and edit sales orders")],
993 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
994 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
995 ["dunning_edit", $locale->text("Create and edit dunnings")],
996 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
997 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
998 ["--ap", $locale->text("AP")],
999 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1000 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1001 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1002 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1003 ["--warehouse_management", $locale->text("Warehouse management")],
1004 ["warehouse_contents", $locale->text("View warehouse content")],
1005 ["warehouse_management", $locale->text("Warehouse management")],
1006 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1007 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1008 ["datev_export", $locale->text("DATEV Export")],
1009 ["cash", $locale->text("Receipt, payment, reconciliation")],
1010 ["--reports", $locale->text('Reports')],
1011 ["report", $locale->text('All reports')],
1012 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1013 ["--batch_printing", $locale->text("Batch Printing")],
1014 ["batch_printing", $locale->text("Batch Printing")],
1015 ["--others", $locale->text("Others")],
1016 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1017 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
1018 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1025 return grep !/^--/, map { $_->[0] } all_rights_full();
1029 $main::lxdebug->enter_sub();
1033 my $form = $main::form;
1035 my $dbh = $self->dbconnect();
1037 my $query = 'SELECT * FROM auth."group"';
1038 my $sth = prepare_execute_query($form, $dbh, $query);
1042 while ($row = $sth->fetchrow_hashref()) {
1043 $groups->{$row->{id}} = $row;
1047 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1048 $sth = prepare_query($form, $dbh, $query);
1050 foreach $group (values %{$groups}) {
1053 do_statement($form, $sth, $query, $group->{id});
1055 while ($row = $sth->fetchrow_hashref()) {
1056 push @members, $row->{user_id};
1058 $group->{members} = [ uniq @members ];
1062 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1063 $sth = prepare_query($form, $dbh, $query);
1065 foreach $group (values %{$groups}) {
1066 $group->{rights} = {};
1068 do_statement($form, $sth, $query, $group->{id});
1070 while ($row = $sth->fetchrow_hashref()) {
1071 $group->{rights}->{$row->{right}} |= $row->{granted};
1074 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1078 $main::lxdebug->leave_sub();
1084 $main::lxdebug->enter_sub();
1089 my $form = $main::form;
1090 my $dbh = $self->dbconnect();
1094 my ($query, $sth, $row, $rights);
1096 if (!$group->{id}) {
1097 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1099 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1100 do_query($form, $dbh, $query, $group->{id});
1103 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1105 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1107 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1108 $sth = prepare_query($form, $dbh, $query);
1110 foreach my $user_id (uniq @{ $group->{members} }) {
1111 do_statement($form, $sth, $query, $user_id, $group->{id});
1115 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1117 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1118 $sth = prepare_query($form, $dbh, $query);
1120 foreach my $right (keys %{ $group->{rights} }) {
1121 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1127 $main::lxdebug->leave_sub();
1131 $main::lxdebug->enter_sub();
1136 my $form = $main::form;
1138 my $dbh = $self->dbconnect();
1141 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1142 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1143 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1147 $main::lxdebug->leave_sub();
1150 sub evaluate_rights_ary {
1151 $main::lxdebug->enter_sub(2);
1158 foreach my $el (@{$ary}) {
1159 if (ref $el eq "ARRAY") {
1160 if ($action eq '|') {
1161 $value |= evaluate_rights_ary($el);
1163 $value &= evaluate_rights_ary($el);
1166 } elsif (($el eq '&') || ($el eq '|')) {
1169 } elsif ($action eq '|') {
1178 $main::lxdebug->leave_sub(2);
1183 sub _parse_rights_string {
1184 $main::lxdebug->enter_sub(2);
1194 push @stack, $cur_ary;
1196 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1198 substr($access, 0, length $1) = "";
1200 next if ($token =~ /\s/);
1202 if ($token eq "(") {
1203 my $new_cur_ary = [];
1204 push @stack, $new_cur_ary;
1205 push @{$cur_ary}, $new_cur_ary;
1206 $cur_ary = $new_cur_ary;
1208 } elsif ($token eq ")") {
1212 $main::lxdebug->leave_sub(2);
1216 $cur_ary = $stack[-1];
1218 } elsif (($token eq "|") || ($token eq "&")) {
1219 push @{$cur_ary}, $token;
1222 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1226 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1228 $main::lxdebug->leave_sub(2);
1234 $main::lxdebug->enter_sub(2);
1239 my $default = shift;
1241 $self->{FULL_RIGHTS} ||= { };
1242 $self->{FULL_RIGHTS}->{$login} ||= { };
1244 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1245 $self->{RIGHTS} ||= { };
1246 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1248 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1251 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1252 $granted = $default if (!defined $granted);
1254 $main::lxdebug->leave_sub(2);
1260 $::lxdebug->enter_sub(2);
1261 my ($self, $right, $dont_abort) = @_;
1263 if ($self->check_right($::myconfig{login}, $right)) {
1264 $::lxdebug->leave_sub(2);
1269 delete $::form->{title};
1270 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1273 $::lxdebug->leave_sub(2);
1278 sub load_rights_for_user {
1279 $::lxdebug->enter_sub;
1281 my ($self, $login) = @_;
1282 my $dbh = $self->dbconnect;
1283 my ($query, $sth, $row, $rights);
1285 $rights = { map { $_ => 0 } all_rights() };
1288 qq|SELECT gr."right", gr.granted
1289 FROM auth.group_rights gr
1292 FROM auth.user_group ug
1293 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1294 WHERE u.login = ?)|;
1296 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1298 while ($row = $sth->fetchrow_hashref()) {
1299 $rights->{$row->{right}} |= $row->{granted};
1303 $::lxdebug->leave_sub;
1317 SL::Auth - Authentication and session handling
1323 =item C<set_session_value @values>
1325 =item C<set_session_value %values>
1327 Store all values of C<@values> or C<%values> in the session. Each
1328 member of C<@values> is tested if it is a hash reference. If it is
1329 then it must contain the keys C<key> and C<value> and can optionally
1330 contain the key C<auto_restore>. In this case C<value> is associated
1331 with C<key> and restored to C<$::form> upon the next request
1332 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1335 If the current member of C<@values> is not a hash reference then it
1336 will be used as the C<key> and the next entry of C<@values> is used as
1337 the C<value> to store. In this case setting C<auto_restore> is not
1340 Therefore the following two invocations are identical:
1342 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1343 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1345 All of these values are copied back into C<$::form> for the next
1346 request automatically if they're scalar values or if they have
1347 C<auto_restore> set to trueish.
1349 The values can be any Perl structure. They are stored as YAML dumps.
1351 =item C<get_session_value $key>
1353 Retrieve a value from the session. Returns C<undef> if the value
1356 =item C<create_unique_sesion_value $value, %params>
1358 Create a unique key in the session and store C<$value>
1361 Returns the key created in the session.
1363 =item C<save_session>
1365 Stores the session values in the database. This is the only function
1366 that actually stores stuff in the database. Neither the various
1367 setters nor the deleter access the database.
1369 =item <save_form_in_session %params>
1371 Stores the content of C<$params{form}> (default: C<$::form>) in the
1372 session using L</create_unique_sesion_value>.
1374 If C<$params{non_scalars}> is trueish then non-scalar values will be
1375 stored as well. Default is to only store scalar values.
1377 The following keys will never be saved: C<login>, C<password>,
1378 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1379 can be given as an array ref in C<$params{skip_keys}>.
1381 Returns the unique key under which the form is stored.
1383 =item <restore_form_from_session $key, %params>
1385 Restores the form from the session into C<$params{form}> (default:
1388 If C<$params{clobber}> is falsish then existing values with the same
1389 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1402 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>