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, %params) = @_;
50 my $may_fail = delete $params{may_fail};
52 my %user = $self->read_user($login);
53 my $dbh = SL::DBConnect->connect(
58 pg_enable_utf8 => $::locale->is_utf8,
63 if (!$may_fail && !$dbh) {
64 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
67 if ($user{dboptions} && $dbh) {
68 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
77 $self->{dbh}->disconnect() if ($self->{dbh});
80 # form isn't loaded yet, so auth needs it's own error.
82 $::lxdebug->show_backtrace();
84 my ($self, @msg) = @_;
85 if ($ENV{HTTP_USER_AGENT}) {
86 print Form->create_http_response(content_type => 'text/html');
87 print "<pre>", join ('<br>', @msg), "</pre>";
89 print STDERR "Error: @msg\n";
94 sub _read_auth_config {
95 $main::lxdebug->enter_sub();
99 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
100 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
101 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
103 if ($self->{module} eq 'DB') {
104 $self->{authenticator} = SL::Auth::DB->new($self);
106 } elsif ($self->{module} eq 'LDAP') {
107 $self->{authenticator} = SL::Auth::LDAP->new($self);
110 if (!$self->{authenticator}) {
111 my $locale = Locale->new('en');
112 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
115 my $cfg = $self->{DB_config};
118 my $locale = Locale->new('en');
119 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
122 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
123 my $locale = Locale->new('en');
124 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
127 $self->{authenticator}->verify_config();
129 $self->{session_timeout} *= 1;
130 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
132 $main::lxdebug->leave_sub();
135 sub authenticate_root {
136 $main::lxdebug->enter_sub();
139 my $password = shift;
140 my $is_crypted = shift;
142 $password = crypt $password, 'ro' if (!$password || !$is_crypted);
143 my $admin_password = crypt "$self->{admin_password}", 'ro';
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;
166 $main::lxdebug->enter_sub(2);
169 my $may_fail = shift;
172 $main::lxdebug->leave_sub(2);
176 my $cfg = $self->{DB_config};
177 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
180 $dsn .= ';port=' . $cfg->{port};
183 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
185 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
187 if (!$may_fail && !$self->{dbh}) {
188 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
191 $main::lxdebug->leave_sub(2);
197 $main::lxdebug->enter_sub();
202 $self->{dbh}->disconnect();
206 $main::lxdebug->leave_sub();
210 $main::lxdebug->enter_sub();
214 my $dbh = $self->dbconnect();
215 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
217 my ($count) = $dbh->selectrow_array($query);
219 $main::lxdebug->leave_sub();
225 $main::lxdebug->enter_sub();
229 my $dbh = $self->dbconnect(1);
231 $main::lxdebug->leave_sub();
236 sub create_database {
237 $main::lxdebug->enter_sub();
242 my $cfg = $self->{DB_config};
244 if (!$params{superuser}) {
245 $params{superuser} = $cfg->{user};
246 $params{superuser_password} = $cfg->{password};
249 $params{template} ||= 'template0';
250 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
252 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
255 $dsn .= ';port=' . $cfg->{port};
258 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
260 my $charset = $::lx_office_conf{system}->{dbcharset};
261 $charset ||= Common::DEFAULT_CHARSET;
262 my $encoding = $Common::charset_to_db_encoding{$charset};
263 $encoding ||= 'UNICODE';
265 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
268 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
271 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
273 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
278 my $error = $dbh->errstr();
280 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
281 my ($cluster_encoding) = $dbh->selectrow_array($query);
283 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
284 $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.');
289 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
294 $main::lxdebug->leave_sub();
298 $main::lxdebug->enter_sub();
301 my $dbh = $self->dbconnect();
303 my $charset = $::lx_office_conf{system}->{dbcharset};
304 $charset ||= Common::DEFAULT_CHARSET;
307 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
309 $main::lxdebug->leave_sub();
313 $main::lxdebug->enter_sub();
319 my $form = $main::form;
321 my $dbh = $self->dbconnect();
323 my ($sth, $query, $user_id);
327 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
328 ($user_id) = selectrow_query($form, $dbh, $query, $login);
331 $query = qq|SELECT nextval('auth.user_id_seq')|;
332 ($user_id) = selectrow_query($form, $dbh, $query);
334 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
335 do_query($form, $dbh, $query, $user_id, $login);
338 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
339 do_query($form, $dbh, $query, $user_id);
341 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
342 $sth = prepare_query($form, $dbh, $query);
344 while (my ($cfg_key, $cfg_value) = each %params) {
345 next if ($cfg_key eq 'password');
347 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
352 $main::lxdebug->leave_sub();
355 sub can_change_password {
358 return $self->{authenticator}->can_change_password();
361 sub change_password {
362 $main::lxdebug->enter_sub();
365 my $result = $self->{authenticator}->change_password(@_);
367 $main::lxdebug->leave_sub();
373 $main::lxdebug->enter_sub();
377 my $dbh = $self->dbconnect();
378 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
379 FROM auth.user_config cfg
380 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
381 my $sth = prepare_execute_query($main::form, $dbh, $query);
385 while (my $ref = $sth->fetchrow_hashref()) {
386 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
387 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
392 $main::lxdebug->leave_sub();
398 $main::lxdebug->enter_sub();
403 my $dbh = $self->dbconnect();
404 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
405 FROM auth.user_config cfg
406 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
407 WHERE (u.login = ?)|;
408 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
412 while (my $ref = $sth->fetchrow_hashref()) {
413 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
414 @user_data{qw(id login)} = @{$ref}{qw(id login)};
419 $main::lxdebug->leave_sub();
425 $main::lxdebug->enter_sub();
430 my $dbh = $self->dbconnect();
431 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
433 $main::lxdebug->leave_sub();
439 $::lxdebug->enter_sub;
444 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
445 my $dbh = $self->dbconnect;
449 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
451 my ($id) = selectrow_query($::form, $dbh, $query, $login);
453 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
455 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
456 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
457 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
460 $u_dbh->commit if $u_dbh;
462 $::lxdebug->leave_sub;
465 # --------------------------------------
469 sub restore_session {
470 $main::lxdebug->enter_sub();
474 my $cgi = $main::cgi;
475 $cgi ||= CGI->new('');
477 $session_id = $cgi->cookie($self->get_session_cookie_name());
478 $session_id =~ s|[^0-9a-f]||g;
480 $self->{SESSION} = { };
483 $main::lxdebug->leave_sub();
487 my ($dbh, $query, $sth, $cookie, $ref, $form);
491 $dbh = $self->dbconnect();
492 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
494 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
496 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
497 $self->destroy_session();
498 $main::lxdebug->leave_sub();
499 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
502 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
503 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
505 while (my $ref = $sth->fetchrow_hashref()) {
506 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
507 next if defined $form->{$ref->{sess_key}};
509 my $params = $self->_load_value($ref->{sess_value});
510 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
515 $main::lxdebug->leave_sub();
521 my ($self, $value) = @_;
523 return { simple => 1, data => $value } if $value !~ m/^---/;
525 my %params = ( simple => 1 );
527 my $data = YAML::Load($value);
529 if (ref $data eq 'HASH') {
530 map { $params{$_} = $data->{$_} } keys %{ $data };
534 $params{data} = $data;
538 } or $params{data} = $value;
543 sub destroy_session {
544 $main::lxdebug->enter_sub();
549 my $dbh = $self->dbconnect();
553 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
554 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
559 $self->{SESSION} = { };
562 $main::lxdebug->leave_sub();
565 sub expire_sessions {
566 $main::lxdebug->enter_sub();
570 my $dbh = $self->dbconnect();
575 qq|DELETE FROM auth.session_content
579 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
581 do_query($main::form, $dbh, $query);
584 qq|DELETE FROM auth.session
585 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
587 do_query($main::form, $dbh, $query);
591 $main::lxdebug->leave_sub();
594 sub _create_session_id {
595 $main::lxdebug->enter_sub();
598 map { push @data, int(rand() * 255); } (1..32);
600 my $id = md5_hex(pack 'C*', @data);
602 $main::lxdebug->leave_sub();
607 sub create_or_refresh_session {
608 $session_id ||= shift->_create_session_id;
612 $::lxdebug->enter_sub;
614 my $provided_dbh = shift;
616 my $dbh = $provided_dbh || $self->dbconnect(1);
618 $::lxdebug->leave_sub && return unless $dbh && $session_id;
620 $dbh->begin_work unless $provided_dbh;
622 do_query($::form, $dbh, qq|LOCK auth.session_content|);
623 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
625 my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
627 my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
630 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
632 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
635 if (%{ $self->{SESSION} }) {
636 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
637 my $sth = prepare_query($::form, $dbh, $query);
639 foreach my $key (sort keys %{ $self->{SESSION} }) {
640 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
646 $dbh->commit() unless $provided_dbh;
647 $::lxdebug->leave_sub;
650 sub set_session_value {
651 $main::lxdebug->enter_sub();
656 $self->{SESSION} ||= { };
658 while (my ($key, $value) = each %params) {
659 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
662 $main::lxdebug->leave_sub();
667 sub delete_session_value {
668 $main::lxdebug->enter_sub();
672 $self->{SESSION} ||= { };
673 delete @{ $self->{SESSION} }{ @_ };
675 $main::lxdebug->leave_sub();
680 sub get_session_value {
681 $main::lxdebug->enter_sub();
684 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
686 $main::lxdebug->leave_sub();
688 return $params->{data};
691 sub create_unique_sesion_value {
692 my ($self, $value, %params) = @_;
694 $self->{SESSION} ||= { };
696 my @now = gettimeofday();
697 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
698 $self->{unique_counter} ||= 0;
700 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
701 $self->{unique_counter}++;
703 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
707 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
709 return $key . $self->{unique_counter};
712 sub save_form_in_session {
713 my ($self, %params) = @_;
715 my $form = delete($params{form}) || $::form;
716 my $non_scalars = delete $params{non_scalars};
719 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
721 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
722 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
725 return $self->create_unique_sesion_value($data, %params);
728 sub restore_form_from_session {
729 my ($self, $key, %params) = @_;
731 my $data = $self->get_session_value($key);
732 return $self unless $data;
734 my $form = delete($params{form}) || $::form;
735 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
737 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
742 sub expire_session_keys {
745 $self->{SESSION} ||= { };
747 my @now = gettimeofday();
748 my $now = $now[0] * 1000000 + $now[1];
750 $self->delete_session_value(map { $_->[0] }
751 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
752 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
753 keys %{ $self->{SESSION} });
758 sub _has_expiration {
760 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
763 sub set_cookie_environment_variable {
765 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
768 sub get_session_cookie_name {
771 return $self->{cookie_name} || 'lx_office_erp_session_id';
778 sub session_tables_present {
779 $main::lxdebug->enter_sub();
782 my $dbh = $self->dbconnect(1);
785 $main::lxdebug->leave_sub();
792 WHERE (schemaname = 'auth')
793 AND (tablename IN ('session', 'session_content'))|;
795 my ($count) = selectrow_query($main::form, $dbh, $query);
797 $main::lxdebug->leave_sub();
802 # --------------------------------------
804 sub all_rights_full {
805 my $locale = $main::locale;
808 ["--crm", $locale->text("CRM optional software")],
809 ["crm_search", $locale->text("CRM search")],
810 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
811 ["crm_service", $locale->text("CRM services")],
812 ["crm_admin", $locale->text("CRM admin")],
813 ["crm_adminuser", $locale->text("CRM user")],
814 ["crm_adminstatus", $locale->text("CRM status")],
815 ["crm_email", $locale->text("CRM send email")],
816 ["crm_termin", $locale->text("CRM termin")],
817 ["crm_opportunity", $locale->text("CRM opportunity")],
818 ["crm_knowhow", $locale->text("CRM know how")],
819 ["crm_follow", $locale->text("CRM follow up")],
820 ["crm_notices", $locale->text("CRM notices")],
821 ["crm_other", $locale->text("CRM other")],
822 ["--master_data", $locale->text("Master Data")],
823 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
824 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
825 ["project_edit", $locale->text("Create and edit projects")],
826 ["license_edit", $locale->text("Manage license keys")],
827 ["--ar", $locale->text("AR")],
828 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
829 ["sales_order_edit", $locale->text("Create and edit sales orders")],
830 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
831 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
832 ["dunning_edit", $locale->text("Create and edit dunnings")],
833 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
834 ["--ap", $locale->text("AP")],
835 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
836 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
837 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
838 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
839 ["--warehouse_management", $locale->text("Warehouse management")],
840 ["warehouse_contents", $locale->text("View warehouse content")],
841 ["warehouse_management", $locale->text("Warehouse management")],
842 ["--general_ledger_cash", $locale->text("General ledger and cash")],
843 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
844 ["datev_export", $locale->text("DATEV Export")],
845 ["cash", $locale->text("Receipt, payment, reconciliation")],
846 ["--reports", $locale->text('Reports')],
847 ["report", $locale->text('All reports')],
848 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
849 ["--batch_printing", $locale->text("Batch Printing")],
850 ["batch_printing", $locale->text("Batch Printing")],
851 ["--others", $locale->text("Others")],
852 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
853 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
860 return grep !/^--/, map { $_->[0] } all_rights_full();
864 $main::lxdebug->enter_sub();
868 my $form = $main::form;
870 my $dbh = $self->dbconnect();
872 my $query = 'SELECT * FROM auth."group"';
873 my $sth = prepare_execute_query($form, $dbh, $query);
877 while ($row = $sth->fetchrow_hashref()) {
878 $groups->{$row->{id}} = $row;
882 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
883 $sth = prepare_query($form, $dbh, $query);
885 foreach $group (values %{$groups}) {
888 do_statement($form, $sth, $query, $group->{id});
890 while ($row = $sth->fetchrow_hashref()) {
891 push @members, $row->{user_id};
893 $group->{members} = [ uniq @members ];
897 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
898 $sth = prepare_query($form, $dbh, $query);
900 foreach $group (values %{$groups}) {
901 $group->{rights} = {};
903 do_statement($form, $sth, $query, $group->{id});
905 while ($row = $sth->fetchrow_hashref()) {
906 $group->{rights}->{$row->{right}} |= $row->{granted};
909 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
913 $main::lxdebug->leave_sub();
919 $main::lxdebug->enter_sub();
924 my $form = $main::form;
925 my $dbh = $self->dbconnect();
929 my ($query, $sth, $row, $rights);
932 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
934 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
935 do_query($form, $dbh, $query, $group->{id});
938 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
940 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
942 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
943 $sth = prepare_query($form, $dbh, $query);
945 foreach my $user_id (uniq @{ $group->{members} }) {
946 do_statement($form, $sth, $query, $user_id, $group->{id});
950 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
952 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
953 $sth = prepare_query($form, $dbh, $query);
955 foreach my $right (keys %{ $group->{rights} }) {
956 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
962 $main::lxdebug->leave_sub();
966 $main::lxdebug->enter_sub();
971 my $form = $main::form;
973 my $dbh = $self->dbconnect();
976 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
977 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
978 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
982 $main::lxdebug->leave_sub();
985 sub evaluate_rights_ary {
986 $main::lxdebug->enter_sub(2);
993 foreach my $el (@{$ary}) {
994 if (ref $el eq "ARRAY") {
995 if ($action eq '|') {
996 $value |= evaluate_rights_ary($el);
998 $value &= evaluate_rights_ary($el);
1001 } elsif (($el eq '&') || ($el eq '|')) {
1004 } elsif ($action eq '|') {
1013 $main::lxdebug->leave_sub(2);
1018 sub _parse_rights_string {
1019 $main::lxdebug->enter_sub(2);
1029 push @stack, $cur_ary;
1031 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1033 substr($access, 0, length $1) = "";
1035 next if ($token =~ /\s/);
1037 if ($token eq "(") {
1038 my $new_cur_ary = [];
1039 push @stack, $new_cur_ary;
1040 push @{$cur_ary}, $new_cur_ary;
1041 $cur_ary = $new_cur_ary;
1043 } elsif ($token eq ")") {
1047 $main::lxdebug->leave_sub(2);
1051 $cur_ary = $stack[-1];
1053 } elsif (($token eq "|") || ($token eq "&")) {
1054 push @{$cur_ary}, $token;
1057 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1061 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1063 $main::lxdebug->leave_sub(2);
1069 $main::lxdebug->enter_sub(2);
1074 my $default = shift;
1076 $self->{FULL_RIGHTS} ||= { };
1077 $self->{FULL_RIGHTS}->{$login} ||= { };
1079 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1080 $self->{RIGHTS} ||= { };
1081 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1083 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1086 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1087 $granted = $default if (!defined $granted);
1089 $main::lxdebug->leave_sub(2);
1095 $::lxdebug->enter_sub(2);
1096 my ($self, $right, $dont_abort) = @_;
1098 if ($self->check_right($::myconfig{login}, $right)) {
1099 $::lxdebug->leave_sub(2);
1104 delete $::form->{title};
1105 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1108 $::lxdebug->leave_sub(2);
1113 sub load_rights_for_user {
1114 $::lxdebug->enter_sub;
1116 my ($self, $login) = @_;
1117 my $dbh = $self->dbconnect;
1118 my ($query, $sth, $row, $rights);
1120 $rights = { map { $_ => 0 } all_rights() };
1123 qq|SELECT gr."right", gr.granted
1124 FROM auth.group_rights gr
1127 FROM auth.user_group ug
1128 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1129 WHERE u.login = ?)|;
1131 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1133 while ($row = $sth->fetchrow_hashref()) {
1134 $rights->{$row->{right}} |= $row->{granted};
1138 $::lxdebug->leave_sub;
1152 SL::Auth - Authentication and session handling
1158 =item C<set_session_value %values>
1160 Store all key/value pairs in C<%values> in the session. All of these
1161 values are copied back into C<$::form> in the next request
1164 The values can be any Perl structure. They are stored as YAML dumps.
1166 =item C<get_session_value $key>
1168 Retrieve a value from the session. Returns C<undef> if the value
1171 =item C<create_unique_sesion_value $value, %params>
1173 Create a unique key in the session and store C<$value>
1176 If C<$params{expiration}> is set then it is interpreted as a number of
1177 seconds after which the value is removed from the session. It will
1178 never expire if that parameter is falsish.
1180 Returns the key created in the session.
1182 =item C<expire_session_keys>
1184 Removes all keys from the session that have an expiration time set and
1185 whose expiration time is in the past.
1187 =item C<save_session>
1189 Stores the session values in the database. This is the only function
1190 that actually stores stuff in the database. Neither the various
1191 setters nor the deleter access the database.
1193 =item <save_form_in_session %params>
1195 Stores the content of C<$params{form}> (default: C<$::form>) in the
1196 session using L</create_unique_sesion_value>.
1198 If C<$params{non_scalars}> is trueish then non-scalar values will be
1199 stored as well. Default is to only store scalar values.
1201 The following keys will never be saved: C<login>, C<password>,
1202 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1203 can be given as an array ref in C<$params{skip_keys}>.
1205 Returns the unique key under which the form is stored.
1207 =item <restore_form_from_session $key, %params>
1209 Restores the form from the session into C<$params{form}> (default:
1212 If C<$params{clobber}> is falsish then existing values with the same
1213 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1226 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>