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} ||= { };
680 while (my ($key, $value) = each %params) {
681 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
684 $main::lxdebug->leave_sub();
689 sub delete_session_value {
690 $main::lxdebug->enter_sub();
694 $self->{SESSION} ||= { };
695 delete @{ $self->{SESSION} }{ @_ };
697 $main::lxdebug->leave_sub();
702 sub get_session_value {
703 $main::lxdebug->enter_sub();
706 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
708 $main::lxdebug->leave_sub();
710 return $params->{data};
713 sub create_unique_sesion_value {
714 my ($self, $value, %params) = @_;
716 $self->{SESSION} ||= { };
718 my @now = gettimeofday();
719 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
720 $self->{unique_counter} ||= 0;
722 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
723 $self->{unique_counter}++;
725 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
729 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
731 return $key . $self->{unique_counter};
734 sub save_form_in_session {
735 my ($self, %params) = @_;
737 my $form = delete($params{form}) || $::form;
738 my $non_scalars = delete $params{non_scalars};
741 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
743 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
744 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
747 return $self->create_unique_sesion_value($data, %params);
750 sub restore_form_from_session {
751 my ($self, $key, %params) = @_;
753 my $data = $self->get_session_value($key);
754 return $self unless $data;
756 my $form = delete($params{form}) || $::form;
757 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
759 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
764 sub expire_session_keys {
767 $self->{SESSION} ||= { };
769 my @now = gettimeofday();
770 my $now = $now[0] * 1000000 + $now[1];
772 $self->delete_session_value(map { $_->[0] }
773 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
774 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
775 keys %{ $self->{SESSION} });
780 sub _has_expiration {
782 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
785 sub set_cookie_environment_variable {
787 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
790 sub get_session_cookie_name {
793 return $self->{cookie_name} || 'lx_office_erp_session_id';
800 sub session_tables_present {
801 $main::lxdebug->enter_sub();
805 # Only re-check for the presence of auth tables if either the check
806 # hasn't been done before of if they weren't present.
807 if ($self->{session_tables_present}) {
808 $main::lxdebug->leave_sub();
809 return $self->{session_tables_present};
812 my $dbh = $self->dbconnect(1);
815 $main::lxdebug->leave_sub();
822 WHERE (schemaname = 'auth')
823 AND (tablename IN ('session', 'session_content'))|;
825 my ($count) = selectrow_query($main::form, $dbh, $query);
827 $self->{session_tables_present} = 2 == $count;
829 $main::lxdebug->leave_sub();
831 return $self->{session_tables_present};
834 # --------------------------------------
836 sub all_rights_full {
837 my $locale = $main::locale;
840 ["--crm", $locale->text("CRM optional software")],
841 ["crm_search", $locale->text("CRM search")],
842 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
843 ["crm_service", $locale->text("CRM services")],
844 ["crm_admin", $locale->text("CRM admin")],
845 ["crm_adminuser", $locale->text("CRM user")],
846 ["crm_adminstatus", $locale->text("CRM status")],
847 ["crm_email", $locale->text("CRM send email")],
848 ["crm_termin", $locale->text("CRM termin")],
849 ["crm_opportunity", $locale->text("CRM opportunity")],
850 ["crm_knowhow", $locale->text("CRM know how")],
851 ["crm_follow", $locale->text("CRM follow up")],
852 ["crm_notices", $locale->text("CRM notices")],
853 ["crm_other", $locale->text("CRM other")],
854 ["--master_data", $locale->text("Master Data")],
855 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
856 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
857 ["project_edit", $locale->text("Create and edit projects")],
858 ["--ar", $locale->text("AR")],
859 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
860 ["sales_order_edit", $locale->text("Create and edit sales orders")],
861 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
862 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
863 ["dunning_edit", $locale->text("Create and edit dunnings")],
864 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
865 ["--ap", $locale->text("AP")],
866 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
867 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
868 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
869 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
870 ["--warehouse_management", $locale->text("Warehouse management")],
871 ["warehouse_contents", $locale->text("View warehouse content")],
872 ["warehouse_management", $locale->text("Warehouse management")],
873 ["--general_ledger_cash", $locale->text("General ledger and cash")],
874 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
875 ["datev_export", $locale->text("DATEV Export")],
876 ["cash", $locale->text("Receipt, payment, reconciliation")],
877 ["--reports", $locale->text('Reports')],
878 ["report", $locale->text('All reports')],
879 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
880 ["--batch_printing", $locale->text("Batch Printing")],
881 ["batch_printing", $locale->text("Batch Printing")],
882 ["--others", $locale->text("Others")],
883 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
884 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
891 return grep !/^--/, map { $_->[0] } all_rights_full();
895 $main::lxdebug->enter_sub();
899 my $form = $main::form;
901 my $dbh = $self->dbconnect();
903 my $query = 'SELECT * FROM auth."group"';
904 my $sth = prepare_execute_query($form, $dbh, $query);
908 while ($row = $sth->fetchrow_hashref()) {
909 $groups->{$row->{id}} = $row;
913 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
914 $sth = prepare_query($form, $dbh, $query);
916 foreach $group (values %{$groups}) {
919 do_statement($form, $sth, $query, $group->{id});
921 while ($row = $sth->fetchrow_hashref()) {
922 push @members, $row->{user_id};
924 $group->{members} = [ uniq @members ];
928 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
929 $sth = prepare_query($form, $dbh, $query);
931 foreach $group (values %{$groups}) {
932 $group->{rights} = {};
934 do_statement($form, $sth, $query, $group->{id});
936 while ($row = $sth->fetchrow_hashref()) {
937 $group->{rights}->{$row->{right}} |= $row->{granted};
940 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
944 $main::lxdebug->leave_sub();
950 $main::lxdebug->enter_sub();
955 my $form = $main::form;
956 my $dbh = $self->dbconnect();
960 my ($query, $sth, $row, $rights);
963 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
965 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
966 do_query($form, $dbh, $query, $group->{id});
969 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
971 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
973 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
974 $sth = prepare_query($form, $dbh, $query);
976 foreach my $user_id (uniq @{ $group->{members} }) {
977 do_statement($form, $sth, $query, $user_id, $group->{id});
981 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
983 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
984 $sth = prepare_query($form, $dbh, $query);
986 foreach my $right (keys %{ $group->{rights} }) {
987 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
993 $main::lxdebug->leave_sub();
997 $main::lxdebug->enter_sub();
1002 my $form = $main::form;
1004 my $dbh = $self->dbconnect();
1007 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1008 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1009 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1013 $main::lxdebug->leave_sub();
1016 sub evaluate_rights_ary {
1017 $main::lxdebug->enter_sub(2);
1024 foreach my $el (@{$ary}) {
1025 if (ref $el eq "ARRAY") {
1026 if ($action eq '|') {
1027 $value |= evaluate_rights_ary($el);
1029 $value &= evaluate_rights_ary($el);
1032 } elsif (($el eq '&') || ($el eq '|')) {
1035 } elsif ($action eq '|') {
1044 $main::lxdebug->leave_sub(2);
1049 sub _parse_rights_string {
1050 $main::lxdebug->enter_sub(2);
1060 push @stack, $cur_ary;
1062 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1064 substr($access, 0, length $1) = "";
1066 next if ($token =~ /\s/);
1068 if ($token eq "(") {
1069 my $new_cur_ary = [];
1070 push @stack, $new_cur_ary;
1071 push @{$cur_ary}, $new_cur_ary;
1072 $cur_ary = $new_cur_ary;
1074 } elsif ($token eq ")") {
1078 $main::lxdebug->leave_sub(2);
1082 $cur_ary = $stack[-1];
1084 } elsif (($token eq "|") || ($token eq "&")) {
1085 push @{$cur_ary}, $token;
1088 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1092 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1094 $main::lxdebug->leave_sub(2);
1100 $main::lxdebug->enter_sub(2);
1105 my $default = shift;
1107 $self->{FULL_RIGHTS} ||= { };
1108 $self->{FULL_RIGHTS}->{$login} ||= { };
1110 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1111 $self->{RIGHTS} ||= { };
1112 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1114 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1117 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1118 $granted = $default if (!defined $granted);
1120 $main::lxdebug->leave_sub(2);
1126 $::lxdebug->enter_sub(2);
1127 my ($self, $right, $dont_abort) = @_;
1129 if ($self->check_right($::myconfig{login}, $right)) {
1130 $::lxdebug->leave_sub(2);
1135 delete $::form->{title};
1136 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1139 $::lxdebug->leave_sub(2);
1144 sub load_rights_for_user {
1145 $::lxdebug->enter_sub;
1147 my ($self, $login) = @_;
1148 my $dbh = $self->dbconnect;
1149 my ($query, $sth, $row, $rights);
1151 $rights = { map { $_ => 0 } all_rights() };
1154 qq|SELECT gr."right", gr.granted
1155 FROM auth.group_rights gr
1158 FROM auth.user_group ug
1159 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1160 WHERE u.login = ?)|;
1162 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1164 while ($row = $sth->fetchrow_hashref()) {
1165 $rights->{$row->{right}} |= $row->{granted};
1169 $::lxdebug->leave_sub;
1183 SL::Auth - Authentication and session handling
1189 =item C<set_session_value %values>
1191 Store all key/value pairs in C<%values> in the session. All of these
1192 values are copied back into C<$::form> in the next request
1195 The values can be any Perl structure. They are stored as YAML dumps.
1197 =item C<get_session_value $key>
1199 Retrieve a value from the session. Returns C<undef> if the value
1202 =item C<create_unique_sesion_value $value, %params>
1204 Create a unique key in the session and store C<$value>
1207 If C<$params{expiration}> is set then it is interpreted as a number of
1208 seconds after which the value is removed from the session. It will
1209 never expire if that parameter is falsish.
1211 Returns the key created in the session.
1213 =item C<expire_session_keys>
1215 Removes all keys from the session that have an expiration time set and
1216 whose expiration time is in the past.
1218 =item C<save_session>
1220 Stores the session values in the database. This is the only function
1221 that actually stores stuff in the database. Neither the various
1222 setters nor the deleter access the database.
1224 =item <save_form_in_session %params>
1226 Stores the content of C<$params{form}> (default: C<$::form>) in the
1227 session using L</create_unique_sesion_value>.
1229 If C<$params{non_scalars}> is trueish then non-scalar values will be
1230 stored as well. Default is to only store scalar values.
1232 The following keys will never be saved: C<login>, C<password>,
1233 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1234 can be given as an array ref in C<$params{skip_keys}>.
1236 Returns the unique key under which the form is stored.
1238 =item <restore_form_from_session $key, %params>
1240 Restores the form from the session into C<$params{form}> (default:
1243 If C<$params{clobber}> is falsish then existing values with the same
1244 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1257 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>