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);
23 $main::lxdebug->enter_sub();
30 $self->{SESSION} = { };
32 $self->_read_auth_config();
34 $main::lxdebug->leave_sub();
40 my ($self, $login) = @_;
41 my %user = $self->read_user($login);
42 my $dbh = SL::DBConnect->connect(
47 pg_enable_utf8 => $::locale->is_utf8,
50 ) or $::form->dberror;
52 if ($user{dboptions}) {
53 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
62 $self->{dbh}->disconnect() if ($self->{dbh});
65 # form isn't loaded yet, so auth needs it's own error.
67 $::lxdebug->show_backtrace();
69 my ($self, @msg) = @_;
70 if ($ENV{HTTP_USER_AGENT}) {
71 print Form->create_http_response(content_type => 'text/html');
72 print "<pre>", join ('<br>', @msg), "</pre>";
74 print STDERR "Error: @msg\n";
79 sub _read_auth_config {
80 $main::lxdebug->enter_sub();
84 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
85 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
86 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
88 if ($self->{module} eq 'DB') {
89 $self->{authenticator} = SL::Auth::DB->new($self);
91 } elsif ($self->{module} eq 'LDAP') {
92 $self->{authenticator} = SL::Auth::LDAP->new($self);
95 if (!$self->{authenticator}) {
96 my $locale = Locale->new('en');
97 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
100 my $cfg = $self->{DB_config};
103 my $locale = Locale->new('en');
104 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
107 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
108 my $locale = Locale->new('en');
109 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
112 $self->{authenticator}->verify_config();
114 $self->{session_timeout} *= 1;
115 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
117 $main::lxdebug->leave_sub();
120 sub authenticate_root {
121 $main::lxdebug->enter_sub();
124 my $password = shift;
125 my $is_crypted = shift;
127 $password = crypt $password, 'ro' if (!$password || !$is_crypted);
128 my $admin_password = crypt "$self->{admin_password}", 'ro';
130 $main::lxdebug->leave_sub();
132 return OK if $password eq $admin_password;
138 $main::lxdebug->enter_sub();
140 my ($self, $login, $password) = @_;
142 $main::lxdebug->leave_sub();
144 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
145 return OK if $result eq OK;
151 $main::lxdebug->enter_sub(2);
154 my $may_fail = shift;
157 $main::lxdebug->leave_sub(2);
161 my $cfg = $self->{DB_config};
162 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
165 $dsn .= ';port=' . $cfg->{port};
168 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
170 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
172 if (!$may_fail && !$self->{dbh}) {
173 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
176 $main::lxdebug->leave_sub(2);
182 $main::lxdebug->enter_sub();
187 $self->{dbh}->disconnect();
191 $main::lxdebug->leave_sub();
195 $main::lxdebug->enter_sub();
199 my $dbh = $self->dbconnect();
200 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
202 my ($count) = $dbh->selectrow_array($query);
204 $main::lxdebug->leave_sub();
210 $main::lxdebug->enter_sub();
214 my $dbh = $self->dbconnect(1);
216 $main::lxdebug->leave_sub();
221 sub create_database {
222 $main::lxdebug->enter_sub();
227 my $cfg = $self->{DB_config};
229 if (!$params{superuser}) {
230 $params{superuser} = $cfg->{user};
231 $params{superuser_password} = $cfg->{password};
234 $params{template} ||= 'template0';
235 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
237 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
240 $dsn .= ';port=' . $cfg->{port};
243 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
245 my $charset = $::lx_office_conf{system}->{dbcharset};
246 $charset ||= Common::DEFAULT_CHARSET;
247 my $encoding = $Common::charset_to_db_encoding{$charset};
248 $encoding ||= 'UNICODE';
250 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => $charset =~ m/^utf-?8$/i });
253 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
256 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
258 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
263 my $error = $dbh->errstr();
265 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
266 my ($cluster_encoding) = $dbh->selectrow_array($query);
268 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
269 $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.');
274 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
279 $main::lxdebug->leave_sub();
283 $main::lxdebug->enter_sub();
286 my $dbh = $self->dbconnect();
288 my $charset = $::lx_office_conf{system}->{dbcharset};
289 $charset ||= Common::DEFAULT_CHARSET;
292 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
294 $main::lxdebug->leave_sub();
298 $main::lxdebug->enter_sub();
304 my $form = $main::form;
306 my $dbh = $self->dbconnect();
308 my ($sth, $query, $user_id);
312 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
313 ($user_id) = selectrow_query($form, $dbh, $query, $login);
316 $query = qq|SELECT nextval('auth.user_id_seq')|;
317 ($user_id) = selectrow_query($form, $dbh, $query);
319 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
320 do_query($form, $dbh, $query, $user_id, $login);
323 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
324 do_query($form, $dbh, $query, $user_id);
326 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
327 $sth = prepare_query($form, $dbh, $query);
329 while (my ($cfg_key, $cfg_value) = each %params) {
330 next if ($cfg_key eq 'password');
332 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
337 $main::lxdebug->leave_sub();
340 sub can_change_password {
343 return $self->{authenticator}->can_change_password();
346 sub change_password {
347 $main::lxdebug->enter_sub();
350 my $result = $self->{authenticator}->change_password(@_);
352 $main::lxdebug->leave_sub();
358 $main::lxdebug->enter_sub();
362 my $dbh = $self->dbconnect();
363 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
364 FROM auth.user_config cfg
365 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
366 my $sth = prepare_execute_query($main::form, $dbh, $query);
370 while (my $ref = $sth->fetchrow_hashref()) {
371 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
372 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
377 $main::lxdebug->leave_sub();
383 $main::lxdebug->enter_sub();
388 my $dbh = $self->dbconnect();
389 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
390 FROM auth.user_config cfg
391 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
392 WHERE (u.login = ?)|;
393 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
397 while (my $ref = $sth->fetchrow_hashref()) {
398 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
399 @user_data{qw(id login)} = @{$ref}{qw(id login)};
404 $main::lxdebug->leave_sub();
410 $main::lxdebug->enter_sub();
415 my $dbh = $self->dbconnect();
416 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
418 $main::lxdebug->leave_sub();
424 $main::lxdebug->enter_sub();
429 my $form = $main::form;
431 my $dbh = $self->dbconnect();
435 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
437 my ($id) = selectrow_query($form, $dbh, $query, $login);
439 $dbh->rollback and return $main::lxdebug->leave_sub() if (!$id);
441 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
442 do_query($form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
446 $main::lxdebug->leave_sub();
449 # --------------------------------------
453 sub restore_session {
454 $main::lxdebug->enter_sub();
458 my $cgi = $main::cgi;
459 $cgi ||= CGI->new('');
461 $session_id = $cgi->cookie($self->get_session_cookie_name());
462 $session_id =~ s|[^0-9a-f]||g;
464 $self->{SESSION} = { };
467 $main::lxdebug->leave_sub();
471 my ($dbh, $query, $sth, $cookie, $ref, $form);
475 $dbh = $self->dbconnect();
476 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
478 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
480 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
481 $self->destroy_session();
482 $main::lxdebug->leave_sub();
483 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
486 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
487 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
489 while (my $ref = $sth->fetchrow_hashref()) {
490 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
491 next if defined $form->{$ref->{sess_key}};
493 my $params = $self->_load_value($ref->{sess_value});
494 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
499 $main::lxdebug->leave_sub();
505 my ($self, $value) = @_;
507 return { simple => 1, data => $value } if $value !~ m/^---/;
509 my %params = ( simple => 1 );
511 my $data = YAML::Load($value);
513 if (ref $data eq 'HASH') {
514 map { $params{$_} = $data->{$_} } keys %{ $data };
518 $params{data} = $data;
522 } or $params{data} = $value;
527 sub destroy_session {
528 $main::lxdebug->enter_sub();
533 my $dbh = $self->dbconnect();
537 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
538 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
543 $self->{SESSION} = { };
546 $main::lxdebug->leave_sub();
549 sub expire_sessions {
550 $main::lxdebug->enter_sub();
554 my $dbh = $self->dbconnect();
559 qq|DELETE FROM auth.session_content
563 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
565 do_query($main::form, $dbh, $query);
568 qq|DELETE FROM auth.session
569 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
571 do_query($main::form, $dbh, $query);
575 $main::lxdebug->leave_sub();
578 sub _create_session_id {
579 $main::lxdebug->enter_sub();
582 map { push @data, int(rand() * 255); } (1..32);
584 my $id = md5_hex(pack 'C*', @data);
586 $main::lxdebug->leave_sub();
591 sub create_or_refresh_session {
592 $main::lxdebug->enter_sub();
596 $session_id ||= $self->_create_session_id();
598 my ($form, $dbh, $query, $sth, $id);
601 $dbh = $self->dbconnect();
604 do_query($::form, $dbh, qq|LOCK auth.session_content|);
606 $query = qq|SELECT id FROM auth.session WHERE id = ?|;
608 ($id) = selectrow_query($form, $dbh, $query, $session_id);
611 do_query($form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
614 do_query($form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
618 $self->save_session($dbh);
622 $main::lxdebug->leave_sub();
627 my $provided_dbh = shift;
629 my $dbh = $provided_dbh || $self->dbconnect(1);
633 $dbh->begin_work unless $provided_dbh;
635 do_query($::form, $dbh, qq|LOCK auth.session_content|);
636 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
638 if (%{ $self->{SESSION} }) {
639 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
640 my $sth = prepare_query($::form, $dbh, $query);
642 foreach my $key (sort keys %{ $self->{SESSION} }) {
643 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
649 $dbh->commit() unless $provided_dbh;
652 sub set_session_value {
653 $main::lxdebug->enter_sub();
658 $self->{SESSION} ||= { };
660 while (my ($key, $value) = each %params) {
661 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
664 $main::lxdebug->leave_sub();
669 sub delete_session_value {
670 $main::lxdebug->enter_sub();
674 $self->{SESSION} ||= { };
675 delete @{ $self->{SESSION} }{ @_ };
677 $main::lxdebug->leave_sub();
682 sub get_session_value {
683 $main::lxdebug->enter_sub();
686 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
688 $main::lxdebug->leave_sub();
690 return $params->{data};
693 sub create_unique_sesion_value {
694 my ($self, $value, %params) = @_;
696 $self->{SESSION} ||= { };
698 my @now = gettimeofday();
699 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
700 $self->{unique_counter} ||= 0;
702 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
703 $self->{unique_counter}++;
705 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
706 no_auto => !$params{auto_restore},
710 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
712 return $key . $self->{unique_counter};
715 sub save_form_in_session {
716 my ($self, %params) = @_;
718 my $form = delete($params{form}) || $::form;
719 my $non_scalars = delete $params{non_scalars};
722 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
724 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
725 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
728 return $self->create_unique_sesion_value($data, %params);
731 sub restore_form_from_session {
732 my ($self, $key, %params) = @_;
734 my $data = $self->get_session_value($key);
735 return $self unless $data;
737 my $form = delete($params{form}) || $::form;
738 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
740 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
745 sub expire_session_keys {
748 $self->{SESSION} ||= { };
750 my @now = gettimeofday();
751 my $now = $now[0] * 1000000 + $now[1];
753 $self->delete_session_value(map { $_->[0] }
754 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
755 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
756 keys %{ $self->{SESSION} });
761 sub _has_expiration {
763 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
766 sub set_cookie_environment_variable {
768 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
771 sub get_session_cookie_name {
774 return $self->{cookie_name} || 'lx_office_erp_session_id';
781 sub session_tables_present {
782 $main::lxdebug->enter_sub();
785 my $dbh = $self->dbconnect(1);
788 $main::lxdebug->leave_sub();
795 WHERE (schemaname = 'auth')
796 AND (tablename IN ('session', 'session_content'))|;
798 my ($count) = selectrow_query($main::form, $dbh, $query);
800 $main::lxdebug->leave_sub();
805 # --------------------------------------
807 sub all_rights_full {
808 my $locale = $main::locale;
811 ["--crm", $locale->text("CRM optional software")],
812 ["crm_search", $locale->text("CRM search")],
813 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
814 ["crm_service", $locale->text("CRM services")],
815 ["crm_admin", $locale->text("CRM admin")],
816 ["crm_adminuser", $locale->text("CRM user")],
817 ["crm_adminstatus", $locale->text("CRM status")],
818 ["crm_email", $locale->text("CRM send email")],
819 ["crm_termin", $locale->text("CRM termin")],
820 ["crm_opportunity", $locale->text("CRM opportunity")],
821 ["crm_knowhow", $locale->text("CRM know how")],
822 ["crm_follow", $locale->text("CRM follow up")],
823 ["crm_notices", $locale->text("CRM notices")],
824 ["crm_other", $locale->text("CRM other")],
825 ["--master_data", $locale->text("Master Data")],
826 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
827 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
828 ["project_edit", $locale->text("Create and edit projects")],
829 ["license_edit", $locale->text("Manage license keys")],
830 ["--ar", $locale->text("AR")],
831 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
832 ["sales_order_edit", $locale->text("Create and edit sales orders")],
833 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
834 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
835 ["dunning_edit", $locale->text("Create and edit dunnings")],
836 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
837 ["--ap", $locale->text("AP")],
838 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
839 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
840 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
841 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
842 ["--warehouse_management", $locale->text("Warehouse management")],
843 ["warehouse_contents", $locale->text("View warehouse content")],
844 ["warehouse_management", $locale->text("Warehouse management")],
845 ["--general_ledger_cash", $locale->text("General ledger and cash")],
846 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
847 ["datev_export", $locale->text("DATEV Export")],
848 ["cash", $locale->text("Receipt, payment, reconciliation")],
849 ["--reports", $locale->text('Reports')],
850 ["report", $locale->text('All reports')],
851 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
852 ["--batch_printing", $locale->text("Batch Printing")],
853 ["batch_printing", $locale->text("Batch Printing")],
854 ["--others", $locale->text("Others")],
855 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
856 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
863 return grep !/^--/, map { $_->[0] } all_rights_full();
867 $main::lxdebug->enter_sub();
871 my $form = $main::form;
873 my $dbh = $self->dbconnect();
875 my $query = 'SELECT * FROM auth."group"';
876 my $sth = prepare_execute_query($form, $dbh, $query);
880 while ($row = $sth->fetchrow_hashref()) {
881 $groups->{$row->{id}} = $row;
885 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
886 $sth = prepare_query($form, $dbh, $query);
888 foreach $group (values %{$groups}) {
891 do_statement($form, $sth, $query, $group->{id});
893 while ($row = $sth->fetchrow_hashref()) {
894 push @members, $row->{user_id};
896 $group->{members} = [ uniq @members ];
900 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
901 $sth = prepare_query($form, $dbh, $query);
903 foreach $group (values %{$groups}) {
904 $group->{rights} = {};
906 do_statement($form, $sth, $query, $group->{id});
908 while ($row = $sth->fetchrow_hashref()) {
909 $group->{rights}->{$row->{right}} |= $row->{granted};
912 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
916 $main::lxdebug->leave_sub();
922 $main::lxdebug->enter_sub();
927 my $form = $main::form;
928 my $dbh = $self->dbconnect();
932 my ($query, $sth, $row, $rights);
935 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
937 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
938 do_query($form, $dbh, $query, $group->{id});
941 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
943 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
945 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
946 $sth = prepare_query($form, $dbh, $query);
948 foreach my $user_id (uniq @{ $group->{members} }) {
949 do_statement($form, $sth, $query, $user_id, $group->{id});
953 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
955 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
956 $sth = prepare_query($form, $dbh, $query);
958 foreach my $right (keys %{ $group->{rights} }) {
959 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
965 $main::lxdebug->leave_sub();
969 $main::lxdebug->enter_sub();
974 my $form = $main::form;
976 my $dbh = $self->dbconnect();
979 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
980 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
981 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
985 $main::lxdebug->leave_sub();
988 sub evaluate_rights_ary {
989 $main::lxdebug->enter_sub(2);
996 foreach my $el (@{$ary}) {
997 if (ref $el eq "ARRAY") {
998 if ($action eq '|') {
999 $value |= evaluate_rights_ary($el);
1001 $value &= evaluate_rights_ary($el);
1004 } elsif (($el eq '&') || ($el eq '|')) {
1007 } elsif ($action eq '|') {
1016 $main::lxdebug->leave_sub(2);
1021 sub _parse_rights_string {
1022 $main::lxdebug->enter_sub(2);
1032 push @stack, $cur_ary;
1034 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1036 substr($access, 0, length $1) = "";
1038 next if ($token =~ /\s/);
1040 if ($token eq "(") {
1041 my $new_cur_ary = [];
1042 push @stack, $new_cur_ary;
1043 push @{$cur_ary}, $new_cur_ary;
1044 $cur_ary = $new_cur_ary;
1046 } elsif ($token eq ")") {
1050 $main::lxdebug->leave_sub(2);
1054 $cur_ary = $stack[-1];
1056 } elsif (($token eq "|") || ($token eq "&")) {
1057 push @{$cur_ary}, $token;
1060 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1064 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1066 $main::lxdebug->leave_sub(2);
1072 $main::lxdebug->enter_sub(2);
1077 my $default = shift;
1079 $self->{FULL_RIGHTS} ||= { };
1080 $self->{FULL_RIGHTS}->{$login} ||= { };
1082 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1083 $self->{RIGHTS} ||= { };
1084 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1086 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1089 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1090 $granted = $default if (!defined $granted);
1092 $main::lxdebug->leave_sub(2);
1098 $main::lxdebug->enter_sub(2);
1102 my $dont_abort = shift;
1104 my $form = $main::form;
1106 if ($self->check_right($form->{login}, $right)) {
1107 $main::lxdebug->leave_sub(2);
1112 delete $form->{title};
1113 $form->show_generic_error($main::locale->text("You do not have the permissions to access this function."));
1116 $main::lxdebug->leave_sub(2);
1121 sub load_rights_for_user {
1122 $main::lxdebug->enter_sub();
1127 my $form = $main::form;
1128 my $dbh = $self->dbconnect();
1130 my ($query, $sth, $row, $rights);
1135 qq|SELECT gr."right", gr.granted
1136 FROM auth.group_rights gr
1139 FROM auth.user_group ug
1140 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1141 WHERE u.login = ?)|;
1143 $sth = prepare_execute_query($form, $dbh, $query, $login);
1145 while ($row = $sth->fetchrow_hashref()) {
1146 $rights->{$row->{right}} |= $row->{granted};
1150 map({ $rights->{$_} = 0 unless (defined $rights->{$_}); } SL::Auth::all_rights());
1152 $main::lxdebug->leave_sub();
1166 SL::Auth - Authentication and session handling
1172 =item C<set_session_value %values>
1174 Store all key/value pairs in C<%values> in the session. All of these
1175 values are copied back into C<$::form> in the next request
1178 The values can be any Perl structure. They are stored as YAML dumps.
1180 =item C<get_session_value $key>
1182 Retrieve a value from the session. Returns C<undef> if the value
1185 =item C<create_unique_sesion_value $value, %params>
1187 Create a unique key in the session and store C<$value>
1190 If C<$params{expiration}> is set then it is interpreted as a number of
1191 seconds after which the value is removed from the session. It will
1192 never expire if that parameter is falsish.
1194 If C<$params{auto_restore}> is trueish then the value will be copied
1195 into C<$::form> upon the next request automatically. It defaults to
1196 C<false> and has therefore different behaviour than
1197 L</set_session_value>.
1199 Returns the key created in the session.
1201 =item C<expire_session_keys>
1203 Removes all keys from the session that have an expiration time set and
1204 whose expiration time is in the past.
1206 =item C<save_session>
1208 Stores the session values in the database. This is the only function
1209 that actually stores stuff in the database. Neither the various
1210 setters nor the deleter access the database.
1212 =item <save_form_in_session %params>
1214 Stores the content of C<$params{form}> (default: C<$::form>) in the
1215 session using L</create_unique_sesion_value>.
1217 If C<$params{non_scalars}> is trueish then non-scalar values will be
1218 stored as well. Default is to only store scalar values.
1220 The following keys will never be saved: C<login>, C<password>,
1221 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1222 can be given as an array ref in C<$params{skip_keys}>.
1224 Returns the unique key under which the form is stored.
1226 =item <restore_form_from_session $key, %params>
1228 Restores the form from the session into C<$params{form}> (default:
1231 If C<$params{clobber}> is falsish then existing values with the same
1232 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1245 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>