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, %params) = @_;
42 $self->{SESSION} = { };
43 $self->{FULL_RIGHTS} = { };
44 $self->{RIGHTS} = { };
45 $self->{unique_counter} = 0;
49 my ($self, $login) = @_;
50 my %user = $self->read_user($login);
51 my $dbh = SL::DBConnect->connect(
56 pg_enable_utf8 => $::locale->is_utf8,
59 ) or $::form->dberror;
61 if ($user{dboptions}) {
62 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
71 $self->{dbh}->disconnect() if ($self->{dbh});
74 # form isn't loaded yet, so auth needs it's own error.
76 $::lxdebug->show_backtrace();
78 my ($self, @msg) = @_;
79 if ($ENV{HTTP_USER_AGENT}) {
80 print Form->create_http_response(content_type => 'text/html');
81 print "<pre>", join ('<br>', @msg), "</pre>";
83 print STDERR "Error: @msg\n";
88 sub _read_auth_config {
89 $main::lxdebug->enter_sub();
93 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
94 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
95 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
97 if ($self->{module} eq 'DB') {
98 $self->{authenticator} = SL::Auth::DB->new($self);
100 } elsif ($self->{module} eq 'LDAP') {
101 $self->{authenticator} = SL::Auth::LDAP->new($self);
104 if (!$self->{authenticator}) {
105 my $locale = Locale->new('en');
106 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
109 my $cfg = $self->{DB_config};
112 my $locale = Locale->new('en');
113 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
116 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
117 my $locale = Locale->new('en');
118 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
121 $self->{authenticator}->verify_config();
123 $self->{session_timeout} *= 1;
124 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
126 $main::lxdebug->leave_sub();
129 sub authenticate_root {
130 $main::lxdebug->enter_sub();
133 my $password = shift;
134 my $is_crypted = shift;
136 $password = crypt $password, 'ro' if (!$password || !$is_crypted);
137 my $admin_password = crypt "$self->{admin_password}", 'ro';
139 $main::lxdebug->leave_sub();
141 return OK if $password eq $admin_password;
147 $main::lxdebug->enter_sub();
149 my ($self, $login, $password) = @_;
151 $main::lxdebug->leave_sub();
153 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
154 return OK if $result eq OK;
160 $main::lxdebug->enter_sub(2);
163 my $may_fail = shift;
166 $main::lxdebug->leave_sub(2);
170 my $cfg = $self->{DB_config};
171 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
174 $dsn .= ';port=' . $cfg->{port};
177 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
179 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
181 if (!$may_fail && !$self->{dbh}) {
182 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
185 $main::lxdebug->leave_sub(2);
191 $main::lxdebug->enter_sub();
196 $self->{dbh}->disconnect();
200 $main::lxdebug->leave_sub();
204 $main::lxdebug->enter_sub();
208 my $dbh = $self->dbconnect();
209 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
211 my ($count) = $dbh->selectrow_array($query);
213 $main::lxdebug->leave_sub();
219 $main::lxdebug->enter_sub();
223 my $dbh = $self->dbconnect(1);
225 $main::lxdebug->leave_sub();
230 sub create_database {
231 $main::lxdebug->enter_sub();
236 my $cfg = $self->{DB_config};
238 if (!$params{superuser}) {
239 $params{superuser} = $cfg->{user};
240 $params{superuser_password} = $cfg->{password};
243 $params{template} ||= 'template0';
244 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
246 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
249 $dsn .= ';port=' . $cfg->{port};
252 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
254 my $charset = $::lx_office_conf{system}->{dbcharset};
255 $charset ||= Common::DEFAULT_CHARSET;
256 my $encoding = $Common::charset_to_db_encoding{$charset};
257 $encoding ||= 'UNICODE';
259 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => $charset =~ m/^utf-?8$/i });
262 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
265 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
267 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
272 my $error = $dbh->errstr();
274 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
275 my ($cluster_encoding) = $dbh->selectrow_array($query);
277 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
278 $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.');
283 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
288 $main::lxdebug->leave_sub();
292 $main::lxdebug->enter_sub();
295 my $dbh = $self->dbconnect();
297 my $charset = $::lx_office_conf{system}->{dbcharset};
298 $charset ||= Common::DEFAULT_CHARSET;
301 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
303 $main::lxdebug->leave_sub();
307 $main::lxdebug->enter_sub();
313 my $form = $main::form;
315 my $dbh = $self->dbconnect();
317 my ($sth, $query, $user_id);
321 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
322 ($user_id) = selectrow_query($form, $dbh, $query, $login);
325 $query = qq|SELECT nextval('auth.user_id_seq')|;
326 ($user_id) = selectrow_query($form, $dbh, $query);
328 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
329 do_query($form, $dbh, $query, $user_id, $login);
332 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
333 do_query($form, $dbh, $query, $user_id);
335 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
336 $sth = prepare_query($form, $dbh, $query);
338 while (my ($cfg_key, $cfg_value) = each %params) {
339 next if ($cfg_key eq 'password');
341 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
346 $main::lxdebug->leave_sub();
349 sub can_change_password {
352 return $self->{authenticator}->can_change_password();
355 sub change_password {
356 $main::lxdebug->enter_sub();
359 my $result = $self->{authenticator}->change_password(@_);
361 $main::lxdebug->leave_sub();
367 $main::lxdebug->enter_sub();
371 my $dbh = $self->dbconnect();
372 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
373 FROM auth.user_config cfg
374 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
375 my $sth = prepare_execute_query($main::form, $dbh, $query);
379 while (my $ref = $sth->fetchrow_hashref()) {
380 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
381 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
386 $main::lxdebug->leave_sub();
392 $main::lxdebug->enter_sub();
397 my $dbh = $self->dbconnect();
398 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
399 FROM auth.user_config cfg
400 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
401 WHERE (u.login = ?)|;
402 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
406 while (my $ref = $sth->fetchrow_hashref()) {
407 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
408 @user_data{qw(id login)} = @{$ref}{qw(id login)};
413 $main::lxdebug->leave_sub();
419 $main::lxdebug->enter_sub();
424 my $dbh = $self->dbconnect();
425 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
427 $main::lxdebug->leave_sub();
433 $main::lxdebug->enter_sub();
438 my $form = $main::form;
440 my $dbh = $self->dbconnect();
444 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
446 my ($id) = selectrow_query($form, $dbh, $query, $login);
448 $dbh->rollback and return $main::lxdebug->leave_sub() if (!$id);
450 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
451 do_query($form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
455 $main::lxdebug->leave_sub();
458 # --------------------------------------
462 sub restore_session {
463 $main::lxdebug->enter_sub();
467 my $cgi = $main::cgi;
468 $cgi ||= CGI->new('');
470 $session_id = $cgi->cookie($self->get_session_cookie_name());
471 $session_id =~ s|[^0-9a-f]||g;
473 $self->{SESSION} = { };
476 $main::lxdebug->leave_sub();
480 my ($dbh, $query, $sth, $cookie, $ref, $form);
484 $dbh = $self->dbconnect();
485 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
487 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
489 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
490 $self->destroy_session();
491 $main::lxdebug->leave_sub();
492 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
495 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
496 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
498 while (my $ref = $sth->fetchrow_hashref()) {
499 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
500 next if defined $form->{$ref->{sess_key}};
502 my $params = $self->_load_value($ref->{sess_value});
503 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
508 $main::lxdebug->leave_sub();
514 my ($self, $value) = @_;
516 return { simple => 1, data => $value } if $value !~ m/^---/;
518 my %params = ( simple => 1 );
520 my $data = YAML::Load($value);
522 if (ref $data eq 'HASH') {
523 map { $params{$_} = $data->{$_} } keys %{ $data };
527 $params{data} = $data;
531 } or $params{data} = $value;
536 sub destroy_session {
537 $main::lxdebug->enter_sub();
542 my $dbh = $self->dbconnect();
546 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
547 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
552 $self->{SESSION} = { };
555 $main::lxdebug->leave_sub();
558 sub expire_sessions {
559 $main::lxdebug->enter_sub();
563 my $dbh = $self->dbconnect();
568 qq|DELETE FROM auth.session_content
572 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
574 do_query($main::form, $dbh, $query);
577 qq|DELETE FROM auth.session
578 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
580 do_query($main::form, $dbh, $query);
584 $main::lxdebug->leave_sub();
587 sub _create_session_id {
588 $main::lxdebug->enter_sub();
591 map { push @data, int(rand() * 255); } (1..32);
593 my $id = md5_hex(pack 'C*', @data);
595 $main::lxdebug->leave_sub();
600 sub create_or_refresh_session {
601 $session_id ||= shift->_create_session_id;
605 $::lxdebug->enter_sub;
607 my $provided_dbh = shift;
609 my $dbh = $provided_dbh || $self->dbconnect(1);
611 $::lxdebug->leave_sub && return unless $dbh;
613 $dbh->begin_work unless $provided_dbh;
615 do_query($::form, $dbh, qq|LOCK auth.session_content|);
616 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
618 my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
620 my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
623 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
625 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
628 if (%{ $self->{SESSION} }) {
629 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
630 my $sth = prepare_query($::form, $dbh, $query);
632 foreach my $key (sort keys %{ $self->{SESSION} }) {
633 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
639 $dbh->commit() unless $provided_dbh;
640 $::lxdebug->leave_sub;
643 sub set_session_value {
644 $main::lxdebug->enter_sub();
649 $self->{SESSION} ||= { };
651 while (my ($key, $value) = each %params) {
652 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
655 $main::lxdebug->leave_sub();
660 sub delete_session_value {
661 $main::lxdebug->enter_sub();
665 $self->{SESSION} ||= { };
666 delete @{ $self->{SESSION} }{ @_ };
668 $main::lxdebug->leave_sub();
673 sub get_session_value {
674 $main::lxdebug->enter_sub();
677 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
679 $main::lxdebug->leave_sub();
681 return $params->{data};
684 sub create_unique_sesion_value {
685 my ($self, $value, %params) = @_;
687 $self->{SESSION} ||= { };
689 my @now = gettimeofday();
690 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
691 $self->{unique_counter} ||= 0;
693 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
694 $self->{unique_counter}++;
696 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
697 no_auto => !$params{auto_restore},
701 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
703 return $key . $self->{unique_counter};
706 sub save_form_in_session {
707 my ($self, %params) = @_;
709 my $form = delete($params{form}) || $::form;
710 my $non_scalars = delete $params{non_scalars};
713 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
715 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
716 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
719 return $self->create_unique_sesion_value($data, %params);
722 sub restore_form_from_session {
723 my ($self, $key, %params) = @_;
725 my $data = $self->get_session_value($key);
726 return $self unless $data;
728 my $form = delete($params{form}) || $::form;
729 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
731 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
736 sub expire_session_keys {
739 $self->{SESSION} ||= { };
741 my @now = gettimeofday();
742 my $now = $now[0] * 1000000 + $now[1];
744 $self->delete_session_value(map { $_->[0] }
745 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
746 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
747 keys %{ $self->{SESSION} });
752 sub _has_expiration {
754 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
757 sub set_cookie_environment_variable {
759 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
762 sub get_session_cookie_name {
765 return $self->{cookie_name} || 'lx_office_erp_session_id';
772 sub session_tables_present {
773 $main::lxdebug->enter_sub();
776 my $dbh = $self->dbconnect(1);
779 $main::lxdebug->leave_sub();
786 WHERE (schemaname = 'auth')
787 AND (tablename IN ('session', 'session_content'))|;
789 my ($count) = selectrow_query($main::form, $dbh, $query);
791 $main::lxdebug->leave_sub();
796 # --------------------------------------
798 sub all_rights_full {
799 my $locale = $main::locale;
802 ["--crm", $locale->text("CRM optional software")],
803 ["crm_search", $locale->text("CRM search")],
804 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
805 ["crm_service", $locale->text("CRM services")],
806 ["crm_admin", $locale->text("CRM admin")],
807 ["crm_adminuser", $locale->text("CRM user")],
808 ["crm_adminstatus", $locale->text("CRM status")],
809 ["crm_email", $locale->text("CRM send email")],
810 ["crm_termin", $locale->text("CRM termin")],
811 ["crm_opportunity", $locale->text("CRM opportunity")],
812 ["crm_knowhow", $locale->text("CRM know how")],
813 ["crm_follow", $locale->text("CRM follow up")],
814 ["crm_notices", $locale->text("CRM notices")],
815 ["crm_other", $locale->text("CRM other")],
816 ["--master_data", $locale->text("Master Data")],
817 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
818 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
819 ["project_edit", $locale->text("Create and edit projects")],
820 ["license_edit", $locale->text("Manage license keys")],
821 ["--ar", $locale->text("AR")],
822 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
823 ["sales_order_edit", $locale->text("Create and edit sales orders")],
824 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
825 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
826 ["dunning_edit", $locale->text("Create and edit dunnings")],
827 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
828 ["--ap", $locale->text("AP")],
829 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
830 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
831 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
832 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
833 ["--warehouse_management", $locale->text("Warehouse management")],
834 ["warehouse_contents", $locale->text("View warehouse content")],
835 ["warehouse_management", $locale->text("Warehouse management")],
836 ["--general_ledger_cash", $locale->text("General ledger and cash")],
837 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
838 ["datev_export", $locale->text("DATEV Export")],
839 ["cash", $locale->text("Receipt, payment, reconciliation")],
840 ["--reports", $locale->text('Reports')],
841 ["report", $locale->text('All reports')],
842 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
843 ["--batch_printing", $locale->text("Batch Printing")],
844 ["batch_printing", $locale->text("Batch Printing")],
845 ["--others", $locale->text("Others")],
846 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
847 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
854 return grep !/^--/, map { $_->[0] } all_rights_full();
858 $main::lxdebug->enter_sub();
862 my $form = $main::form;
864 my $dbh = $self->dbconnect();
866 my $query = 'SELECT * FROM auth."group"';
867 my $sth = prepare_execute_query($form, $dbh, $query);
871 while ($row = $sth->fetchrow_hashref()) {
872 $groups->{$row->{id}} = $row;
876 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
877 $sth = prepare_query($form, $dbh, $query);
879 foreach $group (values %{$groups}) {
882 do_statement($form, $sth, $query, $group->{id});
884 while ($row = $sth->fetchrow_hashref()) {
885 push @members, $row->{user_id};
887 $group->{members} = [ uniq @members ];
891 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
892 $sth = prepare_query($form, $dbh, $query);
894 foreach $group (values %{$groups}) {
895 $group->{rights} = {};
897 do_statement($form, $sth, $query, $group->{id});
899 while ($row = $sth->fetchrow_hashref()) {
900 $group->{rights}->{$row->{right}} |= $row->{granted};
903 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
907 $main::lxdebug->leave_sub();
913 $main::lxdebug->enter_sub();
918 my $form = $main::form;
919 my $dbh = $self->dbconnect();
923 my ($query, $sth, $row, $rights);
926 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
928 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
929 do_query($form, $dbh, $query, $group->{id});
932 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
934 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
936 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
937 $sth = prepare_query($form, $dbh, $query);
939 foreach my $user_id (uniq @{ $group->{members} }) {
940 do_statement($form, $sth, $query, $user_id, $group->{id});
944 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
946 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
947 $sth = prepare_query($form, $dbh, $query);
949 foreach my $right (keys %{ $group->{rights} }) {
950 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
956 $main::lxdebug->leave_sub();
960 $main::lxdebug->enter_sub();
965 my $form = $main::form;
967 my $dbh = $self->dbconnect();
970 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
971 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
972 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
976 $main::lxdebug->leave_sub();
979 sub evaluate_rights_ary {
980 $main::lxdebug->enter_sub(2);
987 foreach my $el (@{$ary}) {
988 if (ref $el eq "ARRAY") {
989 if ($action eq '|') {
990 $value |= evaluate_rights_ary($el);
992 $value &= evaluate_rights_ary($el);
995 } elsif (($el eq '&') || ($el eq '|')) {
998 } elsif ($action eq '|') {
1007 $main::lxdebug->leave_sub(2);
1012 sub _parse_rights_string {
1013 $main::lxdebug->enter_sub(2);
1023 push @stack, $cur_ary;
1025 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1027 substr($access, 0, length $1) = "";
1029 next if ($token =~ /\s/);
1031 if ($token eq "(") {
1032 my $new_cur_ary = [];
1033 push @stack, $new_cur_ary;
1034 push @{$cur_ary}, $new_cur_ary;
1035 $cur_ary = $new_cur_ary;
1037 } elsif ($token eq ")") {
1041 $main::lxdebug->leave_sub(2);
1045 $cur_ary = $stack[-1];
1047 } elsif (($token eq "|") || ($token eq "&")) {
1048 push @{$cur_ary}, $token;
1051 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1055 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1057 $main::lxdebug->leave_sub(2);
1063 $main::lxdebug->enter_sub(2);
1068 my $default = shift;
1070 $self->{FULL_RIGHTS} ||= { };
1071 $self->{FULL_RIGHTS}->{$login} ||= { };
1073 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1074 $self->{RIGHTS} ||= { };
1075 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1077 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1080 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1081 $granted = $default if (!defined $granted);
1083 $main::lxdebug->leave_sub(2);
1089 $main::lxdebug->enter_sub(2);
1093 my $dont_abort = shift;
1095 my $form = $main::form;
1097 if ($self->check_right($form->{login}, $right)) {
1098 $main::lxdebug->leave_sub(2);
1103 delete $form->{title};
1104 $form->show_generic_error($main::locale->text("You do not have the permissions to access this function."));
1107 $main::lxdebug->leave_sub(2);
1112 sub load_rights_for_user {
1113 $::lxdebug->enter_sub;
1115 my ($self, $login) = @_;
1116 my $dbh = $self->dbconnect;
1117 my ($query, $sth, $row, $rights);
1119 $rights = { map { $rights->{$_} = 0 } all_rights() };
1122 qq|SELECT gr."right", gr.granted
1123 FROM auth.group_rights gr
1126 FROM auth.user_group ug
1127 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1128 WHERE u.login = ?)|;
1130 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1132 while ($row = $sth->fetchrow_hashref()) {
1133 $rights->{$row->{right}} |= $row->{granted};
1137 $::lxdebug->leave_sub;
1151 SL::Auth - Authentication and session handling
1157 =item C<set_session_value %values>
1159 Store all key/value pairs in C<%values> in the session. All of these
1160 values are copied back into C<$::form> in the next request
1163 The values can be any Perl structure. They are stored as YAML dumps.
1165 =item C<get_session_value $key>
1167 Retrieve a value from the session. Returns C<undef> if the value
1170 =item C<create_unique_sesion_value $value, %params>
1172 Create a unique key in the session and store C<$value>
1175 If C<$params{expiration}> is set then it is interpreted as a number of
1176 seconds after which the value is removed from the session. It will
1177 never expire if that parameter is falsish.
1179 If C<$params{auto_restore}> is trueish then the value will be copied
1180 into C<$::form> upon the next request automatically. It defaults to
1181 C<false> and has therefore different behaviour than
1182 L</set_session_value>.
1184 Returns the key created in the session.
1186 =item C<expire_session_keys>
1188 Removes all keys from the session that have an expiration time set and
1189 whose expiration time is in the past.
1191 =item C<save_session>
1193 Stores the session values in the database. This is the only function
1194 that actually stores stuff in the database. Neither the various
1195 setters nor the deleter access the database.
1197 =item <save_form_in_session %params>
1199 Stores the content of C<$params{form}> (default: C<$::form>) in the
1200 session using L</create_unique_sesion_value>.
1202 If C<$params{non_scalars}> is trueish then non-scalar values will be
1203 stored as well. Default is to only store scalar values.
1205 The following keys will never be saved: C<login>, C<password>,
1206 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1207 can be given as an array ref in C<$params{skip_keys}>.
1209 Returns the unique key under which the form is stored.
1211 =item <restore_form_from_session $key, %params>
1213 Restores the form from the session into C<$params{form}> (default:
1216 If C<$params{clobber}> is falsish then existing values with the same
1217 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1230 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>