5 use Digest::MD5 qw(md5_hex);
7 use Time::HiRes qw(gettimeofday);
8 use List::MoreUtils qw(uniq);
11 use SL::Auth::Constants qw(:all);
14 use SL::Auth::Password;
25 $main::lxdebug->enter_sub();
32 $self->{SESSION} = { };
34 $self->_read_auth_config();
36 $main::lxdebug->leave_sub();
42 my ($self, %params) = @_;
44 $self->{SESSION} = { };
45 $self->{FULL_RIGHTS} = { };
46 $self->{RIGHTS} = { };
47 $self->{unique_counter} = 0;
51 my ($self, $login, %params) = @_;
52 my $may_fail = delete $params{may_fail};
54 my %user = $self->read_user($login);
55 my $dbh = SL::DBConnect->connect(
60 pg_enable_utf8 => $::locale->is_utf8,
65 if (!$may_fail && !$dbh) {
66 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
69 if ($user{dboptions} && $dbh) {
70 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
79 $self->{dbh}->disconnect() if ($self->{dbh});
82 # form isn't loaded yet, so auth needs it's own error.
84 $::lxdebug->show_backtrace();
86 my ($self, @msg) = @_;
87 if ($ENV{HTTP_USER_AGENT}) {
88 print Form->create_http_response(content_type => 'text/html');
89 print "<pre>", join ('<br>', @msg), "</pre>";
91 print STDERR "Error: @msg\n";
96 sub _read_auth_config {
97 $main::lxdebug->enter_sub();
101 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
102 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
103 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
105 if ($self->{module} eq 'DB') {
106 $self->{authenticator} = SL::Auth::DB->new($self);
108 } elsif ($self->{module} eq 'LDAP') {
109 $self->{authenticator} = SL::Auth::LDAP->new($self);
112 if (!$self->{authenticator}) {
113 my $locale = Locale->new('en');
114 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
117 my $cfg = $self->{DB_config};
120 my $locale = Locale->new('en');
121 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
124 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
125 my $locale = Locale->new('en');
126 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
129 $self->{authenticator}->verify_config();
131 $self->{session_timeout} *= 1;
132 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
134 $main::lxdebug->leave_sub();
137 sub authenticate_root {
138 $main::lxdebug->enter_sub();
140 my ($self, $password) = @_;
142 $password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
143 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password});
145 $main::lxdebug->leave_sub();
147 return OK if $password eq $admin_password;
153 $main::lxdebug->enter_sub();
155 my ($self, $login, $password) = @_;
157 $main::lxdebug->leave_sub();
159 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
160 return OK if $result eq OK;
165 sub store_credentials_in_session {
166 my ($self, %params) = @_;
168 if (!$self->{authenticator}->requires_cleartext_password) {
169 $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login},
170 password => $params{password},
171 look_up_algorithm => 1,
175 $self->set_session_value(login => $params{login}, password => $params{password});
178 sub store_root_credentials_in_session {
179 my ($self, $rpw) = @_;
181 $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
184 sub get_stored_password {
185 my ($self, $login) = @_;
187 my $dbh = $self->dbconnect;
189 return undef unless $dbh;
191 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
192 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
194 return $stored_password;
198 $main::lxdebug->enter_sub(2);
201 my $may_fail = shift;
204 $main::lxdebug->leave_sub(2);
208 my $cfg = $self->{DB_config};
209 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
212 $dsn .= ';port=' . $cfg->{port};
215 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
217 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
219 if (!$may_fail && !$self->{dbh}) {
220 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
223 $main::lxdebug->leave_sub(2);
229 $main::lxdebug->enter_sub();
234 $self->{dbh}->disconnect();
238 $main::lxdebug->leave_sub();
242 $main::lxdebug->enter_sub();
246 my $dbh = $self->dbconnect();
247 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
249 my ($count) = $dbh->selectrow_array($query);
251 $main::lxdebug->leave_sub();
257 $main::lxdebug->enter_sub();
261 my $dbh = $self->dbconnect(1);
263 $main::lxdebug->leave_sub();
268 sub create_database {
269 $main::lxdebug->enter_sub();
274 my $cfg = $self->{DB_config};
276 if (!$params{superuser}) {
277 $params{superuser} = $cfg->{user};
278 $params{superuser_password} = $cfg->{password};
281 $params{template} ||= 'template0';
282 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
284 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
287 $dsn .= ';port=' . $cfg->{port};
290 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
292 my $charset = $::lx_office_conf{system}->{dbcharset};
293 $charset ||= Common::DEFAULT_CHARSET;
294 my $encoding = $Common::charset_to_db_encoding{$charset};
295 $encoding ||= 'UNICODE';
297 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
300 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
303 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
305 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
310 my $error = $dbh->errstr();
312 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
313 my ($cluster_encoding) = $dbh->selectrow_array($query);
315 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
316 $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.');
321 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
326 $main::lxdebug->leave_sub();
330 $main::lxdebug->enter_sub();
333 my $dbh = $self->dbconnect();
335 my $charset = $::lx_office_conf{system}->{dbcharset};
336 $charset ||= Common::DEFAULT_CHARSET;
339 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
341 $main::lxdebug->leave_sub();
345 $main::lxdebug->enter_sub();
351 my $form = $main::form;
353 my $dbh = $self->dbconnect();
355 my ($sth, $query, $user_id);
359 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
360 ($user_id) = selectrow_query($form, $dbh, $query, $login);
363 $query = qq|SELECT nextval('auth.user_id_seq')|;
364 ($user_id) = selectrow_query($form, $dbh, $query);
366 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
367 do_query($form, $dbh, $query, $user_id, $login);
370 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
371 do_query($form, $dbh, $query, $user_id);
373 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
374 $sth = prepare_query($form, $dbh, $query);
376 while (my ($cfg_key, $cfg_value) = each %params) {
377 next if ($cfg_key eq 'password');
379 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
384 $main::lxdebug->leave_sub();
387 sub can_change_password {
390 return $self->{authenticator}->can_change_password();
393 sub change_password {
394 $main::lxdebug->enter_sub();
396 my ($self, $login, $new_password) = @_;
398 my $result = $self->{authenticator}->change_password($login, $new_password);
400 $self->store_credentials_in_session(login => $login,
401 password => $new_password,
402 look_up_algorithm => 1,
405 $main::lxdebug->leave_sub();
411 $main::lxdebug->enter_sub();
415 my $dbh = $self->dbconnect();
416 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
417 FROM auth.user_config cfg
418 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
419 my $sth = prepare_execute_query($main::form, $dbh, $query);
423 while (my $ref = $sth->fetchrow_hashref()) {
424 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
425 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
430 $main::lxdebug->leave_sub();
436 $main::lxdebug->enter_sub();
441 my $dbh = $self->dbconnect();
442 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
443 FROM auth.user_config cfg
444 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
445 WHERE (u.login = ?)|;
446 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
450 while (my $ref = $sth->fetchrow_hashref()) {
451 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
452 @user_data{qw(id login)} = @{$ref}{qw(id login)};
457 $main::lxdebug->leave_sub();
463 $main::lxdebug->enter_sub();
468 my $dbh = $self->dbconnect();
469 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
471 $main::lxdebug->leave_sub();
477 $::lxdebug->enter_sub;
482 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
483 my $dbh = $self->dbconnect;
487 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
489 my ($id) = selectrow_query($::form, $dbh, $query, $login);
491 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
493 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
494 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
495 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
498 $u_dbh->commit if $u_dbh;
500 $::lxdebug->leave_sub;
503 # --------------------------------------
507 sub restore_session {
508 $main::lxdebug->enter_sub();
512 my $cgi = $main::cgi;
513 $cgi ||= CGI->new('');
515 $session_id = $cgi->cookie($self->get_session_cookie_name());
516 $session_id =~ s|[^0-9a-f]||g;
518 $self->{SESSION} = { };
521 $main::lxdebug->leave_sub();
525 my ($dbh, $query, $sth, $cookie, $ref, $form);
529 $dbh = $self->dbconnect();
530 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
532 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
534 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
535 $self->destroy_session();
536 $main::lxdebug->leave_sub();
537 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
540 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
541 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
543 while (my $ref = $sth->fetchrow_hashref()) {
544 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
545 next if defined $form->{$ref->{sess_key}};
547 my $params = $self->_load_value($ref->{sess_value});
548 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
553 $main::lxdebug->leave_sub();
559 my ($self, $value) = @_;
561 return { simple => 1, data => $value } if $value !~ m/^---/;
563 my %params = ( simple => 1 );
565 my $data = YAML::Load($value);
567 if (ref $data eq 'HASH') {
568 map { $params{$_} = $data->{$_} } keys %{ $data };
572 $params{data} = $data;
576 } or $params{data} = $value;
581 sub destroy_session {
582 $main::lxdebug->enter_sub();
587 my $dbh = $self->dbconnect();
591 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
592 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
596 SL::SessionFile->destroy_session($session_id);
599 $self->{SESSION} = { };
602 $main::lxdebug->leave_sub();
605 sub expire_sessions {
606 $main::lxdebug->enter_sub();
610 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
612 my $dbh = $self->dbconnect();
614 my $query = qq|SELECT id
616 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
618 my @ids = selectall_array_query($::form, $dbh, $query);
623 SL::SessionFile->destroy_session($_) for @ids;
625 $query = qq|DELETE FROM auth.session_content
626 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
627 do_query($main::form, $dbh, $query, @ids);
629 $query = qq|DELETE FROM auth.session
630 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
631 do_query($main::form, $dbh, $query, @ids);
636 $main::lxdebug->leave_sub();
639 sub _create_session_id {
640 $main::lxdebug->enter_sub();
643 map { push @data, int(rand() * 255); } (1..32);
645 my $id = md5_hex(pack 'C*', @data);
647 $main::lxdebug->leave_sub();
652 sub create_or_refresh_session {
653 $session_id ||= shift->_create_session_id;
657 $::lxdebug->enter_sub;
659 my $provided_dbh = shift;
661 my $dbh = $provided_dbh || $self->dbconnect(1);
663 $::lxdebug->leave_sub && return unless $dbh && $session_id;
665 $dbh->begin_work unless $provided_dbh;
667 do_query($::form, $dbh, qq|LOCK auth.session_content|);
668 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
670 my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
672 my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
675 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
677 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
680 if (%{ $self->{SESSION} }) {
681 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
682 my $sth = prepare_query($::form, $dbh, $query);
684 foreach my $key (sort keys %{ $self->{SESSION} }) {
685 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
691 $dbh->commit() unless $provided_dbh;
692 $::lxdebug->leave_sub;
695 sub set_session_value {
696 $main::lxdebug->enter_sub();
701 $self->{SESSION} ||= { };
704 my $key = shift @params;
706 if (ref $key eq 'HASH') {
707 my $value = { data => $key->{value},
708 auto_restore => $key->{auto_restore},
710 $self->{SESSION}->{ $key->{key} } = YAML::Dump($value);
713 my $value = shift @params;
714 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
718 $main::lxdebug->leave_sub();
723 sub delete_session_value {
724 $main::lxdebug->enter_sub();
728 $self->{SESSION} ||= { };
729 delete @{ $self->{SESSION} }{ @_ };
731 $main::lxdebug->leave_sub();
736 sub get_session_value {
737 $main::lxdebug->enter_sub();
740 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
742 $main::lxdebug->leave_sub();
744 return $params->{data};
747 sub create_unique_sesion_value {
748 my ($self, $value, %params) = @_;
750 $self->{SESSION} ||= { };
752 my @now = gettimeofday();
753 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
754 $self->{unique_counter} ||= 0;
756 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . ($self->{unique_counter} + 1)};
757 $self->{unique_counter}++;
759 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
763 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
765 return $key . $self->{unique_counter};
768 sub save_form_in_session {
769 my ($self, %params) = @_;
771 my $form = delete($params{form}) || $::form;
772 my $non_scalars = delete $params{non_scalars};
775 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
777 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
778 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
781 return $self->create_unique_sesion_value($data, %params);
784 sub restore_form_from_session {
785 my ($self, $key, %params) = @_;
787 my $data = $self->get_session_value($key);
788 return $self unless $data;
790 my $form = delete($params{form}) || $::form;
791 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
793 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
798 sub expire_session_keys {
801 $self->{SESSION} ||= { };
803 my @now = gettimeofday();
804 my $now = $now[0] * 1000000 + $now[1];
806 $self->delete_session_value(map { $_->[0] }
807 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
808 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
809 keys %{ $self->{SESSION} });
814 sub _has_expiration {
816 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
819 sub set_cookie_environment_variable {
821 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
824 sub get_session_cookie_name {
827 return $self->{cookie_name} || 'lx_office_erp_session_id';
834 sub session_tables_present {
835 $main::lxdebug->enter_sub();
839 # Only re-check for the presence of auth tables if either the check
840 # hasn't been done before of if they weren't present.
841 if ($self->{session_tables_present}) {
842 $main::lxdebug->leave_sub();
843 return $self->{session_tables_present};
846 my $dbh = $self->dbconnect(1);
849 $main::lxdebug->leave_sub();
856 WHERE (schemaname = 'auth')
857 AND (tablename IN ('session', 'session_content'))|;
859 my ($count) = selectrow_query($main::form, $dbh, $query);
861 $self->{session_tables_present} = 2 == $count;
863 $main::lxdebug->leave_sub();
865 return $self->{session_tables_present};
868 # --------------------------------------
870 sub all_rights_full {
871 my $locale = $main::locale;
874 ["--crm", $locale->text("CRM optional software")],
875 ["crm_search", $locale->text("CRM search")],
876 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
877 ["crm_service", $locale->text("CRM services")],
878 ["crm_admin", $locale->text("CRM admin")],
879 ["crm_adminuser", $locale->text("CRM user")],
880 ["crm_adminstatus", $locale->text("CRM status")],
881 ["crm_email", $locale->text("CRM send email")],
882 ["crm_termin", $locale->text("CRM termin")],
883 ["crm_opportunity", $locale->text("CRM opportunity")],
884 ["crm_knowhow", $locale->text("CRM know how")],
885 ["crm_follow", $locale->text("CRM follow up")],
886 ["crm_notices", $locale->text("CRM notices")],
887 ["crm_other", $locale->text("CRM other")],
888 ["--master_data", $locale->text("Master Data")],
889 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
890 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
891 ["project_edit", $locale->text("Create and edit projects")],
892 ["--ar", $locale->text("AR")],
893 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
894 ["sales_order_edit", $locale->text("Create and edit sales orders")],
895 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
896 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
897 ["dunning_edit", $locale->text("Create and edit dunnings")],
898 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
899 ["--ap", $locale->text("AP")],
900 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
901 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
902 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
903 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
904 ["--warehouse_management", $locale->text("Warehouse management")],
905 ["warehouse_contents", $locale->text("View warehouse content")],
906 ["warehouse_management", $locale->text("Warehouse management")],
907 ["--general_ledger_cash", $locale->text("General ledger and cash")],
908 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
909 ["datev_export", $locale->text("DATEV Export")],
910 ["cash", $locale->text("Receipt, payment, reconciliation")],
911 ["--reports", $locale->text('Reports')],
912 ["report", $locale->text('All reports')],
913 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
914 ["--batch_printing", $locale->text("Batch Printing")],
915 ["batch_printing", $locale->text("Batch Printing")],
916 ["--others", $locale->text("Others")],
917 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
918 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
925 return grep !/^--/, map { $_->[0] } all_rights_full();
929 $main::lxdebug->enter_sub();
933 my $form = $main::form;
935 my $dbh = $self->dbconnect();
937 my $query = 'SELECT * FROM auth."group"';
938 my $sth = prepare_execute_query($form, $dbh, $query);
942 while ($row = $sth->fetchrow_hashref()) {
943 $groups->{$row->{id}} = $row;
947 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
948 $sth = prepare_query($form, $dbh, $query);
950 foreach $group (values %{$groups}) {
953 do_statement($form, $sth, $query, $group->{id});
955 while ($row = $sth->fetchrow_hashref()) {
956 push @members, $row->{user_id};
958 $group->{members} = [ uniq @members ];
962 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
963 $sth = prepare_query($form, $dbh, $query);
965 foreach $group (values %{$groups}) {
966 $group->{rights} = {};
968 do_statement($form, $sth, $query, $group->{id});
970 while ($row = $sth->fetchrow_hashref()) {
971 $group->{rights}->{$row->{right}} |= $row->{granted};
974 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
978 $main::lxdebug->leave_sub();
984 $main::lxdebug->enter_sub();
989 my $form = $main::form;
990 my $dbh = $self->dbconnect();
994 my ($query, $sth, $row, $rights);
997 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
999 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1000 do_query($form, $dbh, $query, $group->{id});
1003 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1005 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1007 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1008 $sth = prepare_query($form, $dbh, $query);
1010 foreach my $user_id (uniq @{ $group->{members} }) {
1011 do_statement($form, $sth, $query, $user_id, $group->{id});
1015 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1017 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1018 $sth = prepare_query($form, $dbh, $query);
1020 foreach my $right (keys %{ $group->{rights} }) {
1021 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1027 $main::lxdebug->leave_sub();
1031 $main::lxdebug->enter_sub();
1036 my $form = $main::form;
1038 my $dbh = $self->dbconnect();
1041 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1042 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1043 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1047 $main::lxdebug->leave_sub();
1050 sub evaluate_rights_ary {
1051 $main::lxdebug->enter_sub(2);
1058 foreach my $el (@{$ary}) {
1059 if (ref $el eq "ARRAY") {
1060 if ($action eq '|') {
1061 $value |= evaluate_rights_ary($el);
1063 $value &= evaluate_rights_ary($el);
1066 } elsif (($el eq '&') || ($el eq '|')) {
1069 } elsif ($action eq '|') {
1078 $main::lxdebug->leave_sub(2);
1083 sub _parse_rights_string {
1084 $main::lxdebug->enter_sub(2);
1094 push @stack, $cur_ary;
1096 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1098 substr($access, 0, length $1) = "";
1100 next if ($token =~ /\s/);
1102 if ($token eq "(") {
1103 my $new_cur_ary = [];
1104 push @stack, $new_cur_ary;
1105 push @{$cur_ary}, $new_cur_ary;
1106 $cur_ary = $new_cur_ary;
1108 } elsif ($token eq ")") {
1112 $main::lxdebug->leave_sub(2);
1116 $cur_ary = $stack[-1];
1118 } elsif (($token eq "|") || ($token eq "&")) {
1119 push @{$cur_ary}, $token;
1122 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1126 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1128 $main::lxdebug->leave_sub(2);
1134 $main::lxdebug->enter_sub(2);
1139 my $default = shift;
1141 $self->{FULL_RIGHTS} ||= { };
1142 $self->{FULL_RIGHTS}->{$login} ||= { };
1144 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1145 $self->{RIGHTS} ||= { };
1146 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1148 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1151 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1152 $granted = $default if (!defined $granted);
1154 $main::lxdebug->leave_sub(2);
1160 $::lxdebug->enter_sub(2);
1161 my ($self, $right, $dont_abort) = @_;
1163 if ($self->check_right($::myconfig{login}, $right)) {
1164 $::lxdebug->leave_sub(2);
1169 delete $::form->{title};
1170 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1173 $::lxdebug->leave_sub(2);
1178 sub load_rights_for_user {
1179 $::lxdebug->enter_sub;
1181 my ($self, $login) = @_;
1182 my $dbh = $self->dbconnect;
1183 my ($query, $sth, $row, $rights);
1185 $rights = { map { $_ => 0 } all_rights() };
1188 qq|SELECT gr."right", gr.granted
1189 FROM auth.group_rights gr
1192 FROM auth.user_group ug
1193 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1194 WHERE u.login = ?)|;
1196 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1198 while ($row = $sth->fetchrow_hashref()) {
1199 $rights->{$row->{right}} |= $row->{granted};
1203 $::lxdebug->leave_sub;
1217 SL::Auth - Authentication and session handling
1223 =item C<set_session_value @values>
1224 =item C<set_session_value %values>
1226 Store all values of C<@values> or C<%values> in the session. Each
1227 member of C<@values> is tested if it is a hash reference. If it is
1228 then it must contain the keys C<key> and C<value> and can optionally
1229 contain the key C<auto_restore>. In this case C<value> is associated
1230 with C<key> and restored to C<$::form> upon the next request
1231 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1234 If the current member of C<@values> is not a hash reference then it
1235 will be used as the C<key> and the next entry of C<@values> is used as
1236 the C<value> to store. In this case setting C<auto_restore> is not
1239 Therefore the following two invocations are identical:
1241 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1242 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1244 All of these values are copied back into C<$::form> for the next
1245 request automatically if they're scalar values or if they have
1246 C<auto_restore> set to trueish.
1248 The values can be any Perl structure. They are stored as YAML dumps.
1250 =item C<get_session_value $key>
1252 Retrieve a value from the session. Returns C<undef> if the value
1255 =item C<create_unique_sesion_value $value, %params>
1257 Create a unique key in the session and store C<$value>
1260 If C<$params{expiration}> is set then it is interpreted as a number of
1261 seconds after which the value is removed from the session. It will
1262 never expire if that parameter is falsish.
1264 Returns the key created in the session.
1266 =item C<expire_session_keys>
1268 Removes all keys from the session that have an expiration time set and
1269 whose expiration time is in the past.
1271 =item C<save_session>
1273 Stores the session values in the database. This is the only function
1274 that actually stores stuff in the database. Neither the various
1275 setters nor the deleter access the database.
1277 =item <save_form_in_session %params>
1279 Stores the content of C<$params{form}> (default: C<$::form>) in the
1280 session using L</create_unique_sesion_value>.
1282 If C<$params{non_scalars}> is trueish then non-scalar values will be
1283 stored as well. Default is to only store scalar values.
1285 The following keys will never be saved: C<login>, C<password>,
1286 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1287 can be given as an array ref in C<$params{skip_keys}>.
1289 Returns the unique key under which the form is stored.
1291 =item <restore_form_from_session $key, %params>
1293 Restores the form from the session into C<$params{form}> (default:
1296 If C<$params{clobber}> is falsish then existing values with the same
1297 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1310 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>