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);
24 $main::lxdebug->enter_sub();
31 $self->{SESSION} = { };
33 $self->_read_auth_config();
35 $main::lxdebug->leave_sub();
41 my ($self, %params) = @_;
43 $self->{SESSION} = { };
44 $self->{FULL_RIGHTS} = { };
45 $self->{RIGHTS} = { };
46 $self->{unique_counter} = 0;
50 my ($self, $login, %params) = @_;
51 my $may_fail = delete $params{may_fail};
53 my %user = $self->read_user($login);
54 my $dbh = SL::DBConnect->connect(
59 pg_enable_utf8 => $::locale->is_utf8,
64 if (!$may_fail && !$dbh) {
65 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
68 if ($user{dboptions} && $dbh) {
69 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
78 $self->{dbh}->disconnect() if ($self->{dbh});
81 # form isn't loaded yet, so auth needs it's own error.
83 $::lxdebug->show_backtrace();
85 my ($self, @msg) = @_;
86 if ($ENV{HTTP_USER_AGENT}) {
87 print Form->create_http_response(content_type => 'text/html');
88 print "<pre>", join ('<br>', @msg), "</pre>";
90 print STDERR "Error: @msg\n";
95 sub _read_auth_config {
96 $main::lxdebug->enter_sub();
100 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
101 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
102 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
104 if ($self->{module} eq 'DB') {
105 $self->{authenticator} = SL::Auth::DB->new($self);
107 } elsif ($self->{module} eq 'LDAP') {
108 $self->{authenticator} = SL::Auth::LDAP->new($self);
111 if (!$self->{authenticator}) {
112 my $locale = Locale->new('en');
113 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
116 my $cfg = $self->{DB_config};
119 my $locale = Locale->new('en');
120 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
123 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
124 my $locale = Locale->new('en');
125 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
128 $self->{authenticator}->verify_config();
130 $self->{session_timeout} *= 1;
131 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
133 $main::lxdebug->leave_sub();
136 sub authenticate_root {
137 $main::lxdebug->enter_sub();
140 my $password = shift;
141 my $is_crypted = shift;
143 $password = crypt $password, 'ro' if (!$password || !$is_crypted);
144 my $admin_password = crypt "$self->{admin_password}", 'ro';
146 $main::lxdebug->leave_sub();
148 return OK if $password eq $admin_password;
154 $main::lxdebug->enter_sub();
156 my ($self, $login, $password) = @_;
158 $main::lxdebug->leave_sub();
160 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
161 return OK if $result eq OK;
167 $main::lxdebug->enter_sub(2);
170 my $may_fail = shift;
173 $main::lxdebug->leave_sub(2);
177 my $cfg = $self->{DB_config};
178 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
181 $dsn .= ';port=' . $cfg->{port};
184 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
186 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
188 if (!$may_fail && !$self->{dbh}) {
189 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
192 $main::lxdebug->leave_sub(2);
198 $main::lxdebug->enter_sub();
203 $self->{dbh}->disconnect();
207 $main::lxdebug->leave_sub();
211 $main::lxdebug->enter_sub();
215 my $dbh = $self->dbconnect();
216 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
218 my ($count) = $dbh->selectrow_array($query);
220 $main::lxdebug->leave_sub();
226 $main::lxdebug->enter_sub();
230 my $dbh = $self->dbconnect(1);
232 $main::lxdebug->leave_sub();
237 sub create_database {
238 $main::lxdebug->enter_sub();
243 my $cfg = $self->{DB_config};
245 if (!$params{superuser}) {
246 $params{superuser} = $cfg->{user};
247 $params{superuser_password} = $cfg->{password};
250 $params{template} ||= 'template0';
251 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
253 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
256 $dsn .= ';port=' . $cfg->{port};
259 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
261 my $charset = $::lx_office_conf{system}->{dbcharset};
262 $charset ||= Common::DEFAULT_CHARSET;
263 my $encoding = $Common::charset_to_db_encoding{$charset};
264 $encoding ||= 'UNICODE';
266 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
269 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
272 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
274 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
279 my $error = $dbh->errstr();
281 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
282 my ($cluster_encoding) = $dbh->selectrow_array($query);
284 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
285 $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.');
290 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
295 $main::lxdebug->leave_sub();
299 $main::lxdebug->enter_sub();
302 my $dbh = $self->dbconnect();
304 my $charset = $::lx_office_conf{system}->{dbcharset};
305 $charset ||= Common::DEFAULT_CHARSET;
308 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
310 $main::lxdebug->leave_sub();
314 $main::lxdebug->enter_sub();
320 my $form = $main::form;
322 my $dbh = $self->dbconnect();
324 my ($sth, $query, $user_id);
328 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
329 ($user_id) = selectrow_query($form, $dbh, $query, $login);
332 $query = qq|SELECT nextval('auth.user_id_seq')|;
333 ($user_id) = selectrow_query($form, $dbh, $query);
335 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
336 do_query($form, $dbh, $query, $user_id, $login);
339 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
340 do_query($form, $dbh, $query, $user_id);
342 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
343 $sth = prepare_query($form, $dbh, $query);
345 while (my ($cfg_key, $cfg_value) = each %params) {
346 next if ($cfg_key eq 'password');
348 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
353 $main::lxdebug->leave_sub();
356 sub can_change_password {
359 return $self->{authenticator}->can_change_password();
362 sub change_password {
363 $main::lxdebug->enter_sub();
366 my $result = $self->{authenticator}->change_password(@_);
368 $main::lxdebug->leave_sub();
374 $main::lxdebug->enter_sub();
378 my $dbh = $self->dbconnect();
379 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
380 FROM auth.user_config cfg
381 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
382 my $sth = prepare_execute_query($main::form, $dbh, $query);
386 while (my $ref = $sth->fetchrow_hashref()) {
387 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
388 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
393 $main::lxdebug->leave_sub();
399 $main::lxdebug->enter_sub();
404 my $dbh = $self->dbconnect();
405 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
406 FROM auth.user_config cfg
407 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
408 WHERE (u.login = ?)|;
409 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
413 while (my $ref = $sth->fetchrow_hashref()) {
414 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
415 @user_data{qw(id login)} = @{$ref}{qw(id login)};
420 $main::lxdebug->leave_sub();
426 $main::lxdebug->enter_sub();
431 my $dbh = $self->dbconnect();
432 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
434 $main::lxdebug->leave_sub();
440 $::lxdebug->enter_sub;
445 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
446 my $dbh = $self->dbconnect;
450 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
452 my ($id) = selectrow_query($::form, $dbh, $query, $login);
454 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
456 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
457 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
458 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
461 $u_dbh->commit if $u_dbh;
463 $::lxdebug->leave_sub;
466 # --------------------------------------
470 sub restore_session {
471 $main::lxdebug->enter_sub();
475 my $cgi = $main::cgi;
476 $cgi ||= CGI->new('');
478 $session_id = $cgi->cookie($self->get_session_cookie_name());
479 $session_id =~ s|[^0-9a-f]||g;
481 $self->{SESSION} = { };
484 $main::lxdebug->leave_sub();
488 my ($dbh, $query, $sth, $cookie, $ref, $form);
492 $dbh = $self->dbconnect();
493 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
495 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
497 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
498 $self->destroy_session();
499 $main::lxdebug->leave_sub();
500 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
503 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
504 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
506 while (my $ref = $sth->fetchrow_hashref()) {
507 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
508 next if defined $form->{$ref->{sess_key}};
510 my $params = $self->_load_value($ref->{sess_value});
511 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
516 $main::lxdebug->leave_sub();
522 my ($self, $value) = @_;
524 return { simple => 1, data => $value } if $value !~ m/^---/;
526 my %params = ( simple => 1 );
528 my $data = YAML::Load($value);
530 if (ref $data eq 'HASH') {
531 map { $params{$_} = $data->{$_} } keys %{ $data };
535 $params{data} = $data;
539 } or $params{data} = $value;
544 sub destroy_session {
545 $main::lxdebug->enter_sub();
550 my $dbh = $self->dbconnect();
554 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
555 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
559 SL::SessionFile->destroy_session($session_id);
562 $self->{SESSION} = { };
565 $main::lxdebug->leave_sub();
568 sub expire_sessions {
569 $main::lxdebug->enter_sub();
573 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
575 my $dbh = $self->dbconnect();
577 my $query = qq|SELECT id
579 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
581 my @ids = selectall_array_query($::form, $dbh, $query);
586 SL::SessionFile->destroy_session($_) for @ids;
588 $query = qq|DELETE FROM auth.session_content
589 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
590 do_query($main::form, $dbh, $query, @ids);
592 $query = qq|DELETE FROM auth.session
593 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
594 do_query($main::form, $dbh, $query, @ids);
599 $main::lxdebug->leave_sub();
602 sub _create_session_id {
603 $main::lxdebug->enter_sub();
606 map { push @data, int(rand() * 255); } (1..32);
608 my $id = md5_hex(pack 'C*', @data);
610 $main::lxdebug->leave_sub();
615 sub create_or_refresh_session {
616 $session_id ||= shift->_create_session_id;
620 $::lxdebug->enter_sub;
622 my $provided_dbh = shift;
624 my $dbh = $provided_dbh || $self->dbconnect(1);
626 $::lxdebug->leave_sub && return unless $dbh && $session_id;
628 $dbh->begin_work unless $provided_dbh;
630 do_query($::form, $dbh, qq|LOCK auth.session_content|);
631 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
633 my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
635 my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
638 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
640 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
643 if (%{ $self->{SESSION} }) {
644 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
645 my $sth = prepare_query($::form, $dbh, $query);
647 foreach my $key (sort keys %{ $self->{SESSION} }) {
648 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
654 $dbh->commit() unless $provided_dbh;
655 $::lxdebug->leave_sub;
658 sub set_session_value {
659 $main::lxdebug->enter_sub();
664 $self->{SESSION} ||= { };
666 while (my ($key, $value) = each %params) {
667 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
670 $main::lxdebug->leave_sub();
675 sub delete_session_value {
676 $main::lxdebug->enter_sub();
680 $self->{SESSION} ||= { };
681 delete @{ $self->{SESSION} }{ @_ };
683 $main::lxdebug->leave_sub();
688 sub get_session_value {
689 $main::lxdebug->enter_sub();
692 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
694 $main::lxdebug->leave_sub();
696 return $params->{data};
699 sub create_unique_sesion_value {
700 my ($self, $value, %params) = @_;
702 $self->{SESSION} ||= { };
704 my @now = gettimeofday();
705 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
706 $self->{unique_counter} ||= 0;
708 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
709 $self->{unique_counter}++;
711 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
715 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
717 return $key . $self->{unique_counter};
720 sub save_form_in_session {
721 my ($self, %params) = @_;
723 my $form = delete($params{form}) || $::form;
724 my $non_scalars = delete $params{non_scalars};
727 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
729 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
730 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
733 return $self->create_unique_sesion_value($data, %params);
736 sub restore_form_from_session {
737 my ($self, $key, %params) = @_;
739 my $data = $self->get_session_value($key);
740 return $self unless $data;
742 my $form = delete($params{form}) || $::form;
743 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
745 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
750 sub expire_session_keys {
753 $self->{SESSION} ||= { };
755 my @now = gettimeofday();
756 my $now = $now[0] * 1000000 + $now[1];
758 $self->delete_session_value(map { $_->[0] }
759 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
760 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
761 keys %{ $self->{SESSION} });
766 sub _has_expiration {
768 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
771 sub set_cookie_environment_variable {
773 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
776 sub get_session_cookie_name {
779 return $self->{cookie_name} || 'lx_office_erp_session_id';
786 sub session_tables_present {
787 $main::lxdebug->enter_sub();
791 # Only re-check for the presence of auth tables if either the check
792 # hasn't been done before of if they weren't present.
793 if ($self->{session_tables_present}) {
794 $main::lxdebug->leave_sub();
795 return $self->{session_tables_present};
798 my $dbh = $self->dbconnect(1);
801 $main::lxdebug->leave_sub();
808 WHERE (schemaname = 'auth')
809 AND (tablename IN ('session', 'session_content'))|;
811 my ($count) = selectrow_query($main::form, $dbh, $query);
813 $self->{session_tables_present} = 2 == $count;
815 $main::lxdebug->leave_sub();
817 return $self->{session_tables_present};
820 # --------------------------------------
822 sub all_rights_full {
823 my $locale = $main::locale;
826 ["--crm", $locale->text("CRM optional software")],
827 ["crm_search", $locale->text("CRM search")],
828 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
829 ["crm_service", $locale->text("CRM services")],
830 ["crm_admin", $locale->text("CRM admin")],
831 ["crm_adminuser", $locale->text("CRM user")],
832 ["crm_adminstatus", $locale->text("CRM status")],
833 ["crm_email", $locale->text("CRM send email")],
834 ["crm_termin", $locale->text("CRM termin")],
835 ["crm_opportunity", $locale->text("CRM opportunity")],
836 ["crm_knowhow", $locale->text("CRM know how")],
837 ["crm_follow", $locale->text("CRM follow up")],
838 ["crm_notices", $locale->text("CRM notices")],
839 ["crm_other", $locale->text("CRM other")],
840 ["--master_data", $locale->text("Master Data")],
841 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
842 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
843 ["project_edit", $locale->text("Create and edit projects")],
844 ["license_edit", $locale->text("Manage license keys")],
845 ["--ar", $locale->text("AR")],
846 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
847 ["sales_order_edit", $locale->text("Create and edit sales orders")],
848 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
849 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
850 ["dunning_edit", $locale->text("Create and edit dunnings")],
851 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
852 ["--ap", $locale->text("AP")],
853 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
854 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
855 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
856 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
857 ["--warehouse_management", $locale->text("Warehouse management")],
858 ["warehouse_contents", $locale->text("View warehouse content")],
859 ["warehouse_management", $locale->text("Warehouse management")],
860 ["--general_ledger_cash", $locale->text("General ledger and cash")],
861 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
862 ["datev_export", $locale->text("DATEV Export")],
863 ["cash", $locale->text("Receipt, payment, reconciliation")],
864 ["--reports", $locale->text('Reports')],
865 ["report", $locale->text('All reports')],
866 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
867 ["--batch_printing", $locale->text("Batch Printing")],
868 ["batch_printing", $locale->text("Batch Printing")],
869 ["--others", $locale->text("Others")],
870 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
871 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
878 return grep !/^--/, map { $_->[0] } all_rights_full();
882 $main::lxdebug->enter_sub();
886 my $form = $main::form;
888 my $dbh = $self->dbconnect();
890 my $query = 'SELECT * FROM auth."group"';
891 my $sth = prepare_execute_query($form, $dbh, $query);
895 while ($row = $sth->fetchrow_hashref()) {
896 $groups->{$row->{id}} = $row;
900 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
901 $sth = prepare_query($form, $dbh, $query);
903 foreach $group (values %{$groups}) {
906 do_statement($form, $sth, $query, $group->{id});
908 while ($row = $sth->fetchrow_hashref()) {
909 push @members, $row->{user_id};
911 $group->{members} = [ uniq @members ];
915 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
916 $sth = prepare_query($form, $dbh, $query);
918 foreach $group (values %{$groups}) {
919 $group->{rights} = {};
921 do_statement($form, $sth, $query, $group->{id});
923 while ($row = $sth->fetchrow_hashref()) {
924 $group->{rights}->{$row->{right}} |= $row->{granted};
927 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
931 $main::lxdebug->leave_sub();
937 $main::lxdebug->enter_sub();
942 my $form = $main::form;
943 my $dbh = $self->dbconnect();
947 my ($query, $sth, $row, $rights);
950 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
952 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
953 do_query($form, $dbh, $query, $group->{id});
956 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
958 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
960 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
961 $sth = prepare_query($form, $dbh, $query);
963 foreach my $user_id (uniq @{ $group->{members} }) {
964 do_statement($form, $sth, $query, $user_id, $group->{id});
968 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
970 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
971 $sth = prepare_query($form, $dbh, $query);
973 foreach my $right (keys %{ $group->{rights} }) {
974 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
980 $main::lxdebug->leave_sub();
984 $main::lxdebug->enter_sub();
989 my $form = $main::form;
991 my $dbh = $self->dbconnect();
994 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
995 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
996 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1000 $main::lxdebug->leave_sub();
1003 sub evaluate_rights_ary {
1004 $main::lxdebug->enter_sub(2);
1011 foreach my $el (@{$ary}) {
1012 if (ref $el eq "ARRAY") {
1013 if ($action eq '|') {
1014 $value |= evaluate_rights_ary($el);
1016 $value &= evaluate_rights_ary($el);
1019 } elsif (($el eq '&') || ($el eq '|')) {
1022 } elsif ($action eq '|') {
1031 $main::lxdebug->leave_sub(2);
1036 sub _parse_rights_string {
1037 $main::lxdebug->enter_sub(2);
1047 push @stack, $cur_ary;
1049 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1051 substr($access, 0, length $1) = "";
1053 next if ($token =~ /\s/);
1055 if ($token eq "(") {
1056 my $new_cur_ary = [];
1057 push @stack, $new_cur_ary;
1058 push @{$cur_ary}, $new_cur_ary;
1059 $cur_ary = $new_cur_ary;
1061 } elsif ($token eq ")") {
1065 $main::lxdebug->leave_sub(2);
1069 $cur_ary = $stack[-1];
1071 } elsif (($token eq "|") || ($token eq "&")) {
1072 push @{$cur_ary}, $token;
1075 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1079 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1081 $main::lxdebug->leave_sub(2);
1087 $main::lxdebug->enter_sub(2);
1092 my $default = shift;
1094 $self->{FULL_RIGHTS} ||= { };
1095 $self->{FULL_RIGHTS}->{$login} ||= { };
1097 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1098 $self->{RIGHTS} ||= { };
1099 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1101 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1104 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1105 $granted = $default if (!defined $granted);
1107 $main::lxdebug->leave_sub(2);
1113 $::lxdebug->enter_sub(2);
1114 my ($self, $right, $dont_abort) = @_;
1116 if ($self->check_right($::myconfig{login}, $right)) {
1117 $::lxdebug->leave_sub(2);
1122 delete $::form->{title};
1123 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1126 $::lxdebug->leave_sub(2);
1131 sub load_rights_for_user {
1132 $::lxdebug->enter_sub;
1134 my ($self, $login) = @_;
1135 my $dbh = $self->dbconnect;
1136 my ($query, $sth, $row, $rights);
1138 $rights = { map { $_ => 0 } all_rights() };
1141 qq|SELECT gr."right", gr.granted
1142 FROM auth.group_rights gr
1145 FROM auth.user_group ug
1146 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1147 WHERE u.login = ?)|;
1149 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1151 while ($row = $sth->fetchrow_hashref()) {
1152 $rights->{$row->{right}} |= $row->{granted};
1156 $::lxdebug->leave_sub;
1170 SL::Auth - Authentication and session handling
1176 =item C<set_session_value %values>
1178 Store all key/value pairs in C<%values> in the session. All of these
1179 values are copied back into C<$::form> in the next request
1182 The values can be any Perl structure. They are stored as YAML dumps.
1184 =item C<get_session_value $key>
1186 Retrieve a value from the session. Returns C<undef> if the value
1189 =item C<create_unique_sesion_value $value, %params>
1191 Create a unique key in the session and store C<$value>
1194 If C<$params{expiration}> is set then it is interpreted as a number of
1195 seconds after which the value is removed from the session. It will
1196 never expire if that parameter is falsish.
1198 Returns the key created in the session.
1200 =item C<expire_session_keys>
1202 Removes all keys from the session that have an expiration time set and
1203 whose expiration time is in the past.
1205 =item C<save_session>
1207 Stores the session values in the database. This is the only function
1208 that actually stores stuff in the database. Neither the various
1209 setters nor the deleter access the database.
1211 =item <save_form_in_session %params>
1213 Stores the content of C<$params{form}> (default: C<$::form>) in the
1214 session using L</create_unique_sesion_value>.
1216 If C<$params{non_scalars}> is trueish then non-scalar values will be
1217 stored as well. Default is to only store scalar values.
1219 The following keys will never be saved: C<login>, C<password>,
1220 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1221 can be given as an array ref in C<$params{skip_keys}>.
1223 Returns the unique key under which the form is stored.
1225 =item <restore_form_from_session $key, %params>
1227 Restores the form from the session into C<$params{form}> (default:
1230 If C<$params{clobber}> is falsish then existing values with the same
1231 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1244 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>