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 $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login}, password => $params{password})
169 unless $self->{authenticator}->requires_cleartext_password;
171 $self->set_session_value(login => $params{login}, password => $params{password});
174 sub store_root_credentials_in_session {
175 my ($self, $rpw) = @_;
177 $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
181 $main::lxdebug->enter_sub(2);
184 my $may_fail = shift;
187 $main::lxdebug->leave_sub(2);
191 my $cfg = $self->{DB_config};
192 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
195 $dsn .= ';port=' . $cfg->{port};
198 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
200 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
202 if (!$may_fail && !$self->{dbh}) {
203 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
206 $main::lxdebug->leave_sub(2);
212 $main::lxdebug->enter_sub();
217 $self->{dbh}->disconnect();
221 $main::lxdebug->leave_sub();
225 $main::lxdebug->enter_sub();
229 my $dbh = $self->dbconnect();
230 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
232 my ($count) = $dbh->selectrow_array($query);
234 $main::lxdebug->leave_sub();
240 $main::lxdebug->enter_sub();
244 my $dbh = $self->dbconnect(1);
246 $main::lxdebug->leave_sub();
251 sub create_database {
252 $main::lxdebug->enter_sub();
257 my $cfg = $self->{DB_config};
259 if (!$params{superuser}) {
260 $params{superuser} = $cfg->{user};
261 $params{superuser_password} = $cfg->{password};
264 $params{template} ||= 'template0';
265 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
267 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
270 $dsn .= ';port=' . $cfg->{port};
273 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
275 my $charset = $::lx_office_conf{system}->{dbcharset};
276 $charset ||= Common::DEFAULT_CHARSET;
277 my $encoding = $Common::charset_to_db_encoding{$charset};
278 $encoding ||= 'UNICODE';
280 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
283 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
286 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
288 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
293 my $error = $dbh->errstr();
295 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
296 my ($cluster_encoding) = $dbh->selectrow_array($query);
298 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
299 $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.');
304 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
309 $main::lxdebug->leave_sub();
313 $main::lxdebug->enter_sub();
316 my $dbh = $self->dbconnect();
318 my $charset = $::lx_office_conf{system}->{dbcharset};
319 $charset ||= Common::DEFAULT_CHARSET;
322 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
324 $main::lxdebug->leave_sub();
328 $main::lxdebug->enter_sub();
334 my $form = $main::form;
336 my $dbh = $self->dbconnect();
338 my ($sth, $query, $user_id);
342 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
343 ($user_id) = selectrow_query($form, $dbh, $query, $login);
346 $query = qq|SELECT nextval('auth.user_id_seq')|;
347 ($user_id) = selectrow_query($form, $dbh, $query);
349 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
350 do_query($form, $dbh, $query, $user_id, $login);
353 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
354 do_query($form, $dbh, $query, $user_id);
356 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
357 $sth = prepare_query($form, $dbh, $query);
359 while (my ($cfg_key, $cfg_value) = each %params) {
360 next if ($cfg_key eq 'password');
362 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
367 $main::lxdebug->leave_sub();
370 sub can_change_password {
373 return $self->{authenticator}->can_change_password();
376 sub change_password {
377 $main::lxdebug->enter_sub();
380 my $result = $self->{authenticator}->change_password(@_);
382 $main::lxdebug->leave_sub();
388 $main::lxdebug->enter_sub();
392 my $dbh = $self->dbconnect();
393 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
394 FROM auth.user_config cfg
395 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
396 my $sth = prepare_execute_query($main::form, $dbh, $query);
400 while (my $ref = $sth->fetchrow_hashref()) {
401 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
402 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
407 $main::lxdebug->leave_sub();
413 $main::lxdebug->enter_sub();
418 my $dbh = $self->dbconnect();
419 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
420 FROM auth.user_config cfg
421 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
422 WHERE (u.login = ?)|;
423 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
427 while (my $ref = $sth->fetchrow_hashref()) {
428 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
429 @user_data{qw(id login)} = @{$ref}{qw(id login)};
434 $main::lxdebug->leave_sub();
440 $main::lxdebug->enter_sub();
445 my $dbh = $self->dbconnect();
446 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
448 $main::lxdebug->leave_sub();
454 $::lxdebug->enter_sub;
459 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
460 my $dbh = $self->dbconnect;
464 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
466 my ($id) = selectrow_query($::form, $dbh, $query, $login);
468 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
470 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
471 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
472 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
475 $u_dbh->commit if $u_dbh;
477 $::lxdebug->leave_sub;
480 # --------------------------------------
484 sub restore_session {
485 $main::lxdebug->enter_sub();
489 my $cgi = $main::cgi;
490 $cgi ||= CGI->new('');
492 $session_id = $cgi->cookie($self->get_session_cookie_name());
493 $session_id =~ s|[^0-9a-f]||g;
495 $self->{SESSION} = { };
498 $main::lxdebug->leave_sub();
502 my ($dbh, $query, $sth, $cookie, $ref, $form);
506 $dbh = $self->dbconnect();
507 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
509 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
511 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
512 $self->destroy_session();
513 $main::lxdebug->leave_sub();
514 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
517 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
518 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
520 while (my $ref = $sth->fetchrow_hashref()) {
521 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
522 next if defined $form->{$ref->{sess_key}};
524 my $params = $self->_load_value($ref->{sess_value});
525 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
530 $main::lxdebug->leave_sub();
536 my ($self, $value) = @_;
538 return { simple => 1, data => $value } if $value !~ m/^---/;
540 my %params = ( simple => 1 );
542 my $data = YAML::Load($value);
544 if (ref $data eq 'HASH') {
545 map { $params{$_} = $data->{$_} } keys %{ $data };
549 $params{data} = $data;
553 } or $params{data} = $value;
558 sub destroy_session {
559 $main::lxdebug->enter_sub();
564 my $dbh = $self->dbconnect();
568 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
569 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
573 SL::SessionFile->destroy_session($session_id);
576 $self->{SESSION} = { };
579 $main::lxdebug->leave_sub();
582 sub expire_sessions {
583 $main::lxdebug->enter_sub();
587 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
589 my $dbh = $self->dbconnect();
591 my $query = qq|SELECT id
593 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
595 my @ids = selectall_array_query($::form, $dbh, $query);
600 SL::SessionFile->destroy_session($_) for @ids;
602 $query = qq|DELETE FROM auth.session_content
603 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
604 do_query($main::form, $dbh, $query, @ids);
606 $query = qq|DELETE FROM auth.session
607 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
608 do_query($main::form, $dbh, $query, @ids);
613 $main::lxdebug->leave_sub();
616 sub _create_session_id {
617 $main::lxdebug->enter_sub();
620 map { push @data, int(rand() * 255); } (1..32);
622 my $id = md5_hex(pack 'C*', @data);
624 $main::lxdebug->leave_sub();
629 sub create_or_refresh_session {
630 $session_id ||= shift->_create_session_id;
634 $::lxdebug->enter_sub;
636 my $provided_dbh = shift;
638 my $dbh = $provided_dbh || $self->dbconnect(1);
640 $::lxdebug->leave_sub && return unless $dbh && $session_id;
642 $dbh->begin_work unless $provided_dbh;
644 do_query($::form, $dbh, qq|LOCK auth.session_content|);
645 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
647 my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
649 my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
652 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
654 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
657 if (%{ $self->{SESSION} }) {
658 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
659 my $sth = prepare_query($::form, $dbh, $query);
661 foreach my $key (sort keys %{ $self->{SESSION} }) {
662 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
668 $dbh->commit() unless $provided_dbh;
669 $::lxdebug->leave_sub;
672 sub set_session_value {
673 $main::lxdebug->enter_sub();
678 $self->{SESSION} ||= { };
681 my $key = shift @params;
683 if (ref $key eq 'HASH') {
684 my $value = { data => $key->{value},
685 auto_restore => $key->{auto_restore},
687 $self->{SESSION}->{ $key->{key} } = YAML::Dump($value);
690 my $value = shift @params;
691 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
695 $main::lxdebug->leave_sub();
700 sub delete_session_value {
701 $main::lxdebug->enter_sub();
705 $self->{SESSION} ||= { };
706 delete @{ $self->{SESSION} }{ @_ };
708 $main::lxdebug->leave_sub();
713 sub get_session_value {
714 $main::lxdebug->enter_sub();
717 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
719 $main::lxdebug->leave_sub();
721 return $params->{data};
724 sub create_unique_sesion_value {
725 my ($self, $value, %params) = @_;
727 $self->{SESSION} ||= { };
729 my @now = gettimeofday();
730 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
731 $self->{unique_counter} ||= 0;
733 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
734 $self->{unique_counter}++;
736 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
740 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
742 return $key . $self->{unique_counter};
745 sub save_form_in_session {
746 my ($self, %params) = @_;
748 my $form = delete($params{form}) || $::form;
749 my $non_scalars = delete $params{non_scalars};
752 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
754 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
755 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
758 return $self->create_unique_sesion_value($data, %params);
761 sub restore_form_from_session {
762 my ($self, $key, %params) = @_;
764 my $data = $self->get_session_value($key);
765 return $self unless $data;
767 my $form = delete($params{form}) || $::form;
768 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
770 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
775 sub expire_session_keys {
778 $self->{SESSION} ||= { };
780 my @now = gettimeofday();
781 my $now = $now[0] * 1000000 + $now[1];
783 $self->delete_session_value(map { $_->[0] }
784 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
785 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
786 keys %{ $self->{SESSION} });
791 sub _has_expiration {
793 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
796 sub set_cookie_environment_variable {
798 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
801 sub get_session_cookie_name {
804 return $self->{cookie_name} || 'lx_office_erp_session_id';
811 sub session_tables_present {
812 $main::lxdebug->enter_sub();
816 # Only re-check for the presence of auth tables if either the check
817 # hasn't been done before of if they weren't present.
818 if ($self->{session_tables_present}) {
819 $main::lxdebug->leave_sub();
820 return $self->{session_tables_present};
823 my $dbh = $self->dbconnect(1);
826 $main::lxdebug->leave_sub();
833 WHERE (schemaname = 'auth')
834 AND (tablename IN ('session', 'session_content'))|;
836 my ($count) = selectrow_query($main::form, $dbh, $query);
838 $self->{session_tables_present} = 2 == $count;
840 $main::lxdebug->leave_sub();
842 return $self->{session_tables_present};
845 # --------------------------------------
847 sub all_rights_full {
848 my $locale = $main::locale;
851 ["--crm", $locale->text("CRM optional software")],
852 ["crm_search", $locale->text("CRM search")],
853 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
854 ["crm_service", $locale->text("CRM services")],
855 ["crm_admin", $locale->text("CRM admin")],
856 ["crm_adminuser", $locale->text("CRM user")],
857 ["crm_adminstatus", $locale->text("CRM status")],
858 ["crm_email", $locale->text("CRM send email")],
859 ["crm_termin", $locale->text("CRM termin")],
860 ["crm_opportunity", $locale->text("CRM opportunity")],
861 ["crm_knowhow", $locale->text("CRM know how")],
862 ["crm_follow", $locale->text("CRM follow up")],
863 ["crm_notices", $locale->text("CRM notices")],
864 ["crm_other", $locale->text("CRM other")],
865 ["--master_data", $locale->text("Master Data")],
866 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
867 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
868 ["project_edit", $locale->text("Create and edit projects")],
869 ["--ar", $locale->text("AR")],
870 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
871 ["sales_order_edit", $locale->text("Create and edit sales orders")],
872 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
873 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
874 ["dunning_edit", $locale->text("Create and edit dunnings")],
875 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
876 ["--ap", $locale->text("AP")],
877 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
878 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
879 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
880 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
881 ["--warehouse_management", $locale->text("Warehouse management")],
882 ["warehouse_contents", $locale->text("View warehouse content")],
883 ["warehouse_management", $locale->text("Warehouse management")],
884 ["--general_ledger_cash", $locale->text("General ledger and cash")],
885 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
886 ["datev_export", $locale->text("DATEV Export")],
887 ["cash", $locale->text("Receipt, payment, reconciliation")],
888 ["--reports", $locale->text('Reports')],
889 ["report", $locale->text('All reports')],
890 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
891 ["--batch_printing", $locale->text("Batch Printing")],
892 ["batch_printing", $locale->text("Batch Printing")],
893 ["--others", $locale->text("Others")],
894 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
895 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
902 return grep !/^--/, map { $_->[0] } all_rights_full();
906 $main::lxdebug->enter_sub();
910 my $form = $main::form;
912 my $dbh = $self->dbconnect();
914 my $query = 'SELECT * FROM auth."group"';
915 my $sth = prepare_execute_query($form, $dbh, $query);
919 while ($row = $sth->fetchrow_hashref()) {
920 $groups->{$row->{id}} = $row;
924 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
925 $sth = prepare_query($form, $dbh, $query);
927 foreach $group (values %{$groups}) {
930 do_statement($form, $sth, $query, $group->{id});
932 while ($row = $sth->fetchrow_hashref()) {
933 push @members, $row->{user_id};
935 $group->{members} = [ uniq @members ];
939 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
940 $sth = prepare_query($form, $dbh, $query);
942 foreach $group (values %{$groups}) {
943 $group->{rights} = {};
945 do_statement($form, $sth, $query, $group->{id});
947 while ($row = $sth->fetchrow_hashref()) {
948 $group->{rights}->{$row->{right}} |= $row->{granted};
951 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
955 $main::lxdebug->leave_sub();
961 $main::lxdebug->enter_sub();
966 my $form = $main::form;
967 my $dbh = $self->dbconnect();
971 my ($query, $sth, $row, $rights);
974 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
976 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
977 do_query($form, $dbh, $query, $group->{id});
980 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
982 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
984 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
985 $sth = prepare_query($form, $dbh, $query);
987 foreach my $user_id (uniq @{ $group->{members} }) {
988 do_statement($form, $sth, $query, $user_id, $group->{id});
992 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
994 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
995 $sth = prepare_query($form, $dbh, $query);
997 foreach my $right (keys %{ $group->{rights} }) {
998 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1004 $main::lxdebug->leave_sub();
1008 $main::lxdebug->enter_sub();
1013 my $form = $main::form;
1015 my $dbh = $self->dbconnect();
1018 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1019 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1020 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1024 $main::lxdebug->leave_sub();
1027 sub evaluate_rights_ary {
1028 $main::lxdebug->enter_sub(2);
1035 foreach my $el (@{$ary}) {
1036 if (ref $el eq "ARRAY") {
1037 if ($action eq '|') {
1038 $value |= evaluate_rights_ary($el);
1040 $value &= evaluate_rights_ary($el);
1043 } elsif (($el eq '&') || ($el eq '|')) {
1046 } elsif ($action eq '|') {
1055 $main::lxdebug->leave_sub(2);
1060 sub _parse_rights_string {
1061 $main::lxdebug->enter_sub(2);
1071 push @stack, $cur_ary;
1073 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1075 substr($access, 0, length $1) = "";
1077 next if ($token =~ /\s/);
1079 if ($token eq "(") {
1080 my $new_cur_ary = [];
1081 push @stack, $new_cur_ary;
1082 push @{$cur_ary}, $new_cur_ary;
1083 $cur_ary = $new_cur_ary;
1085 } elsif ($token eq ")") {
1089 $main::lxdebug->leave_sub(2);
1093 $cur_ary = $stack[-1];
1095 } elsif (($token eq "|") || ($token eq "&")) {
1096 push @{$cur_ary}, $token;
1099 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1103 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1105 $main::lxdebug->leave_sub(2);
1111 $main::lxdebug->enter_sub(2);
1116 my $default = shift;
1118 $self->{FULL_RIGHTS} ||= { };
1119 $self->{FULL_RIGHTS}->{$login} ||= { };
1121 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1122 $self->{RIGHTS} ||= { };
1123 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1125 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1128 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1129 $granted = $default if (!defined $granted);
1131 $main::lxdebug->leave_sub(2);
1137 $::lxdebug->enter_sub(2);
1138 my ($self, $right, $dont_abort) = @_;
1140 if ($self->check_right($::myconfig{login}, $right)) {
1141 $::lxdebug->leave_sub(2);
1146 delete $::form->{title};
1147 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1150 $::lxdebug->leave_sub(2);
1155 sub load_rights_for_user {
1156 $::lxdebug->enter_sub;
1158 my ($self, $login) = @_;
1159 my $dbh = $self->dbconnect;
1160 my ($query, $sth, $row, $rights);
1162 $rights = { map { $_ => 0 } all_rights() };
1165 qq|SELECT gr."right", gr.granted
1166 FROM auth.group_rights gr
1169 FROM auth.user_group ug
1170 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1171 WHERE u.login = ?)|;
1173 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1175 while ($row = $sth->fetchrow_hashref()) {
1176 $rights->{$row->{right}} |= $row->{granted};
1180 $::lxdebug->leave_sub;
1194 SL::Auth - Authentication and session handling
1200 =item C<set_session_value @values>
1201 =item C<set_session_value %values>
1203 Store all values of C<@values> or C<%values> in the session. Each
1204 member of C<@values> is tested if it is a hash reference. If it is
1205 then it must contain the keys C<key> and C<value> and can optionally
1206 contain the key C<auto_restore>. In this case C<value> is associated
1207 with C<key> and restored to C<$::form> upon the next request
1208 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1211 If the current member of C<@values> is not a hash reference then it
1212 will be used as the C<key> and the next entry of C<@values> is used as
1213 the C<value> to store. In this case setting C<auto_restore> is not
1216 Therefore the following two invocations are identical:
1218 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1219 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1221 All of these values are copied back into C<$::form> for the next
1222 request automatically if they're scalar values or if they have
1223 C<auto_restore> set to trueish.
1225 The values can be any Perl structure. They are stored as YAML dumps.
1227 =item C<get_session_value $key>
1229 Retrieve a value from the session. Returns C<undef> if the value
1232 =item C<create_unique_sesion_value $value, %params>
1234 Create a unique key in the session and store C<$value>
1237 If C<$params{expiration}> is set then it is interpreted as a number of
1238 seconds after which the value is removed from the session. It will
1239 never expire if that parameter is falsish.
1241 Returns the key created in the session.
1243 =item C<expire_session_keys>
1245 Removes all keys from the session that have an expiration time set and
1246 whose expiration time is in the past.
1248 =item C<save_session>
1250 Stores the session values in the database. This is the only function
1251 that actually stores stuff in the database. Neither the various
1252 setters nor the deleter access the database.
1254 =item <save_form_in_session %params>
1256 Stores the content of C<$params{form}> (default: C<$::form>) in the
1257 session using L</create_unique_sesion_value>.
1259 If C<$params{non_scalars}> is trueish then non-scalar values will be
1260 stored as well. Default is to only store scalar values.
1262 The following keys will never be saved: C<login>, C<password>,
1263 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1264 can be given as an array ref in C<$params{skip_keys}>.
1266 Returns the unique key under which the form is stored.
1268 =item <restore_form_from_session $key, %params>
1270 Restores the form from the session into C<$params{form}> (default:
1273 If C<$params{clobber}> is falsish then existing values with the same
1274 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1287 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>