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();
397 my $result = $self->{authenticator}->change_password(@_);
399 $main::lxdebug->leave_sub();
405 $main::lxdebug->enter_sub();
409 my $dbh = $self->dbconnect();
410 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
411 FROM auth.user_config cfg
412 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
413 my $sth = prepare_execute_query($main::form, $dbh, $query);
417 while (my $ref = $sth->fetchrow_hashref()) {
418 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
419 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
424 $main::lxdebug->leave_sub();
430 $main::lxdebug->enter_sub();
435 my $dbh = $self->dbconnect();
436 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
437 FROM auth.user_config cfg
438 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
439 WHERE (u.login = ?)|;
440 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
444 while (my $ref = $sth->fetchrow_hashref()) {
445 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
446 @user_data{qw(id login)} = @{$ref}{qw(id login)};
451 $main::lxdebug->leave_sub();
457 $main::lxdebug->enter_sub();
462 my $dbh = $self->dbconnect();
463 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
465 $main::lxdebug->leave_sub();
471 $::lxdebug->enter_sub;
476 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
477 my $dbh = $self->dbconnect;
481 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
483 my ($id) = selectrow_query($::form, $dbh, $query, $login);
485 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
487 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
488 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
489 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
492 $u_dbh->commit if $u_dbh;
494 $::lxdebug->leave_sub;
497 # --------------------------------------
501 sub restore_session {
502 $main::lxdebug->enter_sub();
506 my $cgi = $main::cgi;
507 $cgi ||= CGI->new('');
509 $session_id = $cgi->cookie($self->get_session_cookie_name());
510 $session_id =~ s|[^0-9a-f]||g;
512 $self->{SESSION} = { };
515 $main::lxdebug->leave_sub();
519 my ($dbh, $query, $sth, $cookie, $ref, $form);
523 $dbh = $self->dbconnect();
524 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
526 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
528 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
529 $self->destroy_session();
530 $main::lxdebug->leave_sub();
531 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
534 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
535 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
537 while (my $ref = $sth->fetchrow_hashref()) {
538 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
539 next if defined $form->{$ref->{sess_key}};
541 my $params = $self->_load_value($ref->{sess_value});
542 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
547 $main::lxdebug->leave_sub();
553 my ($self, $value) = @_;
555 return { simple => 1, data => $value } if $value !~ m/^---/;
557 my %params = ( simple => 1 );
559 my $data = YAML::Load($value);
561 if (ref $data eq 'HASH') {
562 map { $params{$_} = $data->{$_} } keys %{ $data };
566 $params{data} = $data;
570 } or $params{data} = $value;
575 sub destroy_session {
576 $main::lxdebug->enter_sub();
581 my $dbh = $self->dbconnect();
585 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
586 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
590 SL::SessionFile->destroy_session($session_id);
593 $self->{SESSION} = { };
596 $main::lxdebug->leave_sub();
599 sub expire_sessions {
600 $main::lxdebug->enter_sub();
604 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
606 my $dbh = $self->dbconnect();
608 my $query = qq|SELECT id
610 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
612 my @ids = selectall_array_query($::form, $dbh, $query);
617 SL::SessionFile->destroy_session($_) for @ids;
619 $query = qq|DELETE FROM auth.session_content
620 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
621 do_query($main::form, $dbh, $query, @ids);
623 $query = qq|DELETE FROM auth.session
624 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
625 do_query($main::form, $dbh, $query, @ids);
630 $main::lxdebug->leave_sub();
633 sub _create_session_id {
634 $main::lxdebug->enter_sub();
637 map { push @data, int(rand() * 255); } (1..32);
639 my $id = md5_hex(pack 'C*', @data);
641 $main::lxdebug->leave_sub();
646 sub create_or_refresh_session {
647 $session_id ||= shift->_create_session_id;
651 $::lxdebug->enter_sub;
653 my $provided_dbh = shift;
655 my $dbh = $provided_dbh || $self->dbconnect(1);
657 $::lxdebug->leave_sub && return unless $dbh && $session_id;
659 $dbh->begin_work unless $provided_dbh;
661 do_query($::form, $dbh, qq|LOCK auth.session_content|);
662 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
664 my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
666 my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
669 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
671 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
674 if (%{ $self->{SESSION} }) {
675 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
676 my $sth = prepare_query($::form, $dbh, $query);
678 foreach my $key (sort keys %{ $self->{SESSION} }) {
679 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
685 $dbh->commit() unless $provided_dbh;
686 $::lxdebug->leave_sub;
689 sub set_session_value {
690 $main::lxdebug->enter_sub();
695 $self->{SESSION} ||= { };
698 my $key = shift @params;
700 if (ref $key eq 'HASH') {
701 my $value = { data => $key->{value},
702 auto_restore => $key->{auto_restore},
704 $self->{SESSION}->{ $key->{key} } = YAML::Dump($value);
707 my $value = shift @params;
708 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
712 $main::lxdebug->leave_sub();
717 sub delete_session_value {
718 $main::lxdebug->enter_sub();
722 $self->{SESSION} ||= { };
723 delete @{ $self->{SESSION} }{ @_ };
725 $main::lxdebug->leave_sub();
730 sub get_session_value {
731 $main::lxdebug->enter_sub();
734 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
736 $main::lxdebug->leave_sub();
738 return $params->{data};
741 sub create_unique_sesion_value {
742 my ($self, $value, %params) = @_;
744 $self->{SESSION} ||= { };
746 my @now = gettimeofday();
747 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
748 $self->{unique_counter} ||= 0;
750 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . ($self->{unique_counter} + 1)};
751 $self->{unique_counter}++;
753 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
757 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
759 return $key . $self->{unique_counter};
762 sub save_form_in_session {
763 my ($self, %params) = @_;
765 my $form = delete($params{form}) || $::form;
766 my $non_scalars = delete $params{non_scalars};
769 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
771 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
772 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
775 return $self->create_unique_sesion_value($data, %params);
778 sub restore_form_from_session {
779 my ($self, $key, %params) = @_;
781 my $data = $self->get_session_value($key);
782 return $self unless $data;
784 my $form = delete($params{form}) || $::form;
785 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
787 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
792 sub expire_session_keys {
795 $self->{SESSION} ||= { };
797 my @now = gettimeofday();
798 my $now = $now[0] * 1000000 + $now[1];
800 $self->delete_session_value(map { $_->[0] }
801 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
802 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
803 keys %{ $self->{SESSION} });
808 sub _has_expiration {
810 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
813 sub set_cookie_environment_variable {
815 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
818 sub get_session_cookie_name {
821 return $self->{cookie_name} || 'lx_office_erp_session_id';
828 sub session_tables_present {
829 $main::lxdebug->enter_sub();
833 # Only re-check for the presence of auth tables if either the check
834 # hasn't been done before of if they weren't present.
835 if ($self->{session_tables_present}) {
836 $main::lxdebug->leave_sub();
837 return $self->{session_tables_present};
840 my $dbh = $self->dbconnect(1);
843 $main::lxdebug->leave_sub();
850 WHERE (schemaname = 'auth')
851 AND (tablename IN ('session', 'session_content'))|;
853 my ($count) = selectrow_query($main::form, $dbh, $query);
855 $self->{session_tables_present} = 2 == $count;
857 $main::lxdebug->leave_sub();
859 return $self->{session_tables_present};
862 # --------------------------------------
864 sub all_rights_full {
865 my $locale = $main::locale;
868 ["--crm", $locale->text("CRM optional software")],
869 ["crm_search", $locale->text("CRM search")],
870 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
871 ["crm_service", $locale->text("CRM services")],
872 ["crm_admin", $locale->text("CRM admin")],
873 ["crm_adminuser", $locale->text("CRM user")],
874 ["crm_adminstatus", $locale->text("CRM status")],
875 ["crm_email", $locale->text("CRM send email")],
876 ["crm_termin", $locale->text("CRM termin")],
877 ["crm_opportunity", $locale->text("CRM opportunity")],
878 ["crm_knowhow", $locale->text("CRM know how")],
879 ["crm_follow", $locale->text("CRM follow up")],
880 ["crm_notices", $locale->text("CRM notices")],
881 ["crm_other", $locale->text("CRM other")],
882 ["--master_data", $locale->text("Master Data")],
883 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
884 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
885 ["project_edit", $locale->text("Create and edit projects")],
886 ["--ar", $locale->text("AR")],
887 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
888 ["sales_order_edit", $locale->text("Create and edit sales orders")],
889 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
890 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
891 ["dunning_edit", $locale->text("Create and edit dunnings")],
892 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
893 ["--ap", $locale->text("AP")],
894 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
895 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
896 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
897 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
898 ["--warehouse_management", $locale->text("Warehouse management")],
899 ["warehouse_contents", $locale->text("View warehouse content")],
900 ["warehouse_management", $locale->text("Warehouse management")],
901 ["--general_ledger_cash", $locale->text("General ledger and cash")],
902 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
903 ["datev_export", $locale->text("DATEV Export")],
904 ["cash", $locale->text("Receipt, payment, reconciliation")],
905 ["--reports", $locale->text('Reports')],
906 ["report", $locale->text('All reports')],
907 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
908 ["--batch_printing", $locale->text("Batch Printing")],
909 ["batch_printing", $locale->text("Batch Printing")],
910 ["--others", $locale->text("Others")],
911 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
912 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
919 return grep !/^--/, map { $_->[0] } all_rights_full();
923 $main::lxdebug->enter_sub();
927 my $form = $main::form;
929 my $dbh = $self->dbconnect();
931 my $query = 'SELECT * FROM auth."group"';
932 my $sth = prepare_execute_query($form, $dbh, $query);
936 while ($row = $sth->fetchrow_hashref()) {
937 $groups->{$row->{id}} = $row;
941 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
942 $sth = prepare_query($form, $dbh, $query);
944 foreach $group (values %{$groups}) {
947 do_statement($form, $sth, $query, $group->{id});
949 while ($row = $sth->fetchrow_hashref()) {
950 push @members, $row->{user_id};
952 $group->{members} = [ uniq @members ];
956 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
957 $sth = prepare_query($form, $dbh, $query);
959 foreach $group (values %{$groups}) {
960 $group->{rights} = {};
962 do_statement($form, $sth, $query, $group->{id});
964 while ($row = $sth->fetchrow_hashref()) {
965 $group->{rights}->{$row->{right}} |= $row->{granted};
968 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
972 $main::lxdebug->leave_sub();
978 $main::lxdebug->enter_sub();
983 my $form = $main::form;
984 my $dbh = $self->dbconnect();
988 my ($query, $sth, $row, $rights);
991 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
993 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
994 do_query($form, $dbh, $query, $group->{id});
997 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
999 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1001 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1002 $sth = prepare_query($form, $dbh, $query);
1004 foreach my $user_id (uniq @{ $group->{members} }) {
1005 do_statement($form, $sth, $query, $user_id, $group->{id});
1009 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1011 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1012 $sth = prepare_query($form, $dbh, $query);
1014 foreach my $right (keys %{ $group->{rights} }) {
1015 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1021 $main::lxdebug->leave_sub();
1025 $main::lxdebug->enter_sub();
1030 my $form = $main::form;
1032 my $dbh = $self->dbconnect();
1035 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1036 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1037 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1041 $main::lxdebug->leave_sub();
1044 sub evaluate_rights_ary {
1045 $main::lxdebug->enter_sub(2);
1052 foreach my $el (@{$ary}) {
1053 if (ref $el eq "ARRAY") {
1054 if ($action eq '|') {
1055 $value |= evaluate_rights_ary($el);
1057 $value &= evaluate_rights_ary($el);
1060 } elsif (($el eq '&') || ($el eq '|')) {
1063 } elsif ($action eq '|') {
1072 $main::lxdebug->leave_sub(2);
1077 sub _parse_rights_string {
1078 $main::lxdebug->enter_sub(2);
1088 push @stack, $cur_ary;
1090 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1092 substr($access, 0, length $1) = "";
1094 next if ($token =~ /\s/);
1096 if ($token eq "(") {
1097 my $new_cur_ary = [];
1098 push @stack, $new_cur_ary;
1099 push @{$cur_ary}, $new_cur_ary;
1100 $cur_ary = $new_cur_ary;
1102 } elsif ($token eq ")") {
1106 $main::lxdebug->leave_sub(2);
1110 $cur_ary = $stack[-1];
1112 } elsif (($token eq "|") || ($token eq "&")) {
1113 push @{$cur_ary}, $token;
1116 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1120 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1122 $main::lxdebug->leave_sub(2);
1128 $main::lxdebug->enter_sub(2);
1133 my $default = shift;
1135 $self->{FULL_RIGHTS} ||= { };
1136 $self->{FULL_RIGHTS}->{$login} ||= { };
1138 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1139 $self->{RIGHTS} ||= { };
1140 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1142 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1145 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1146 $granted = $default if (!defined $granted);
1148 $main::lxdebug->leave_sub(2);
1154 $::lxdebug->enter_sub(2);
1155 my ($self, $right, $dont_abort) = @_;
1157 if ($self->check_right($::myconfig{login}, $right)) {
1158 $::lxdebug->leave_sub(2);
1163 delete $::form->{title};
1164 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1167 $::lxdebug->leave_sub(2);
1172 sub load_rights_for_user {
1173 $::lxdebug->enter_sub;
1175 my ($self, $login) = @_;
1176 my $dbh = $self->dbconnect;
1177 my ($query, $sth, $row, $rights);
1179 $rights = { map { $_ => 0 } all_rights() };
1182 qq|SELECT gr."right", gr.granted
1183 FROM auth.group_rights gr
1186 FROM auth.user_group ug
1187 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1188 WHERE u.login = ?)|;
1190 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1192 while ($row = $sth->fetchrow_hashref()) {
1193 $rights->{$row->{right}} |= $row->{granted};
1197 $::lxdebug->leave_sub;
1211 SL::Auth - Authentication and session handling
1217 =item C<set_session_value @values>
1218 =item C<set_session_value %values>
1220 Store all values of C<@values> or C<%values> in the session. Each
1221 member of C<@values> is tested if it is a hash reference. If it is
1222 then it must contain the keys C<key> and C<value> and can optionally
1223 contain the key C<auto_restore>. In this case C<value> is associated
1224 with C<key> and restored to C<$::form> upon the next request
1225 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1228 If the current member of C<@values> is not a hash reference then it
1229 will be used as the C<key> and the next entry of C<@values> is used as
1230 the C<value> to store. In this case setting C<auto_restore> is not
1233 Therefore the following two invocations are identical:
1235 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1236 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1238 All of these values are copied back into C<$::form> for the next
1239 request automatically if they're scalar values or if they have
1240 C<auto_restore> set to trueish.
1242 The values can be any Perl structure. They are stored as YAML dumps.
1244 =item C<get_session_value $key>
1246 Retrieve a value from the session. Returns C<undef> if the value
1249 =item C<create_unique_sesion_value $value, %params>
1251 Create a unique key in the session and store C<$value>
1254 If C<$params{expiration}> is set then it is interpreted as a number of
1255 seconds after which the value is removed from the session. It will
1256 never expire if that parameter is falsish.
1258 Returns the key created in the session.
1260 =item C<expire_session_keys>
1262 Removes all keys from the session that have an expiration time set and
1263 whose expiration time is in the past.
1265 =item C<save_session>
1267 Stores the session values in the database. This is the only function
1268 that actually stores stuff in the database. Neither the various
1269 setters nor the deleter access the database.
1271 =item <save_form_in_session %params>
1273 Stores the content of C<$params{form}> (default: C<$::form>) in the
1274 session using L</create_unique_sesion_value>.
1276 If C<$params{non_scalars}> is trueish then non-scalar values will be
1277 stored as well. Default is to only store scalar values.
1279 The following keys will never be saved: C<login>, C<password>,
1280 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1281 can be given as an array ref in C<$params{skip_keys}>.
1283 Returns the unique key under which the form is stored.
1285 =item <restore_form_from_session $key, %params>
1287 Restores the form from the session into C<$params{form}> (default:
1290 If C<$params{clobber}> is falsish then existing values with the same
1291 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1304 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>