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 $main::lxdebug->enter_sub();
605 $session_id ||= $self->_create_session_id();
607 my ($form, $dbh, $query, $sth, $id);
610 $dbh = $self->dbconnect();
613 do_query($::form, $dbh, qq|LOCK auth.session_content|);
615 $query = qq|SELECT id FROM auth.session WHERE id = ?|;
617 ($id) = selectrow_query($form, $dbh, $query, $session_id);
620 do_query($form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
623 do_query($form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
627 $self->save_session($dbh);
631 $main::lxdebug->leave_sub();
636 my $provided_dbh = shift;
638 my $dbh = $provided_dbh || $self->dbconnect(1);
642 $dbh->begin_work unless $provided_dbh;
644 do_query($::form, $dbh, qq|LOCK auth.session_content|);
645 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
647 if (%{ $self->{SESSION} }) {
648 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
649 my $sth = prepare_query($::form, $dbh, $query);
651 foreach my $key (sort keys %{ $self->{SESSION} }) {
652 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
658 $dbh->commit() unless $provided_dbh;
661 sub set_session_value {
662 $main::lxdebug->enter_sub();
667 $self->{SESSION} ||= { };
669 while (my ($key, $value) = each %params) {
670 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
673 $main::lxdebug->leave_sub();
678 sub delete_session_value {
679 $main::lxdebug->enter_sub();
683 $self->{SESSION} ||= { };
684 delete @{ $self->{SESSION} }{ @_ };
686 $main::lxdebug->leave_sub();
691 sub get_session_value {
692 $main::lxdebug->enter_sub();
695 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
697 $main::lxdebug->leave_sub();
699 return $params->{data};
702 sub create_unique_sesion_value {
703 my ($self, $value, %params) = @_;
705 $self->{SESSION} ||= { };
707 my @now = gettimeofday();
708 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
709 $self->{unique_counter} ||= 0;
711 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
712 $self->{unique_counter}++;
714 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
715 no_auto => !$params{auto_restore},
719 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
721 return $key . $self->{unique_counter};
724 sub save_form_in_session {
725 my ($self, %params) = @_;
727 my $form = delete($params{form}) || $::form;
728 my $non_scalars = delete $params{non_scalars};
731 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
733 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
734 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
737 return $self->create_unique_sesion_value($data, %params);
740 sub restore_form_from_session {
741 my ($self, $key, %params) = @_;
743 my $data = $self->get_session_value($key);
744 return $self unless $data;
746 my $form = delete($params{form}) || $::form;
747 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
749 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
754 sub expire_session_keys {
757 $self->{SESSION} ||= { };
759 my @now = gettimeofday();
760 my $now = $now[0] * 1000000 + $now[1];
762 $self->delete_session_value(map { $_->[0] }
763 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
764 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
765 keys %{ $self->{SESSION} });
770 sub _has_expiration {
772 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
775 sub set_cookie_environment_variable {
777 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
780 sub get_session_cookie_name {
783 return $self->{cookie_name} || 'lx_office_erp_session_id';
790 sub session_tables_present {
791 $main::lxdebug->enter_sub();
794 my $dbh = $self->dbconnect(1);
797 $main::lxdebug->leave_sub();
804 WHERE (schemaname = 'auth')
805 AND (tablename IN ('session', 'session_content'))|;
807 my ($count) = selectrow_query($main::form, $dbh, $query);
809 $main::lxdebug->leave_sub();
814 # --------------------------------------
816 sub all_rights_full {
817 my $locale = $main::locale;
820 ["--crm", $locale->text("CRM optional software")],
821 ["crm_search", $locale->text("CRM search")],
822 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
823 ["crm_service", $locale->text("CRM services")],
824 ["crm_admin", $locale->text("CRM admin")],
825 ["crm_adminuser", $locale->text("CRM user")],
826 ["crm_adminstatus", $locale->text("CRM status")],
827 ["crm_email", $locale->text("CRM send email")],
828 ["crm_termin", $locale->text("CRM termin")],
829 ["crm_opportunity", $locale->text("CRM opportunity")],
830 ["crm_knowhow", $locale->text("CRM know how")],
831 ["crm_follow", $locale->text("CRM follow up")],
832 ["crm_notices", $locale->text("CRM notices")],
833 ["crm_other", $locale->text("CRM other")],
834 ["--master_data", $locale->text("Master Data")],
835 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
836 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
837 ["project_edit", $locale->text("Create and edit projects")],
838 ["license_edit", $locale->text("Manage license keys")],
839 ["--ar", $locale->text("AR")],
840 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
841 ["sales_order_edit", $locale->text("Create and edit sales orders")],
842 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
843 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
844 ["dunning_edit", $locale->text("Create and edit dunnings")],
845 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
846 ["--ap", $locale->text("AP")],
847 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
848 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
849 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
850 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
851 ["--warehouse_management", $locale->text("Warehouse management")],
852 ["warehouse_contents", $locale->text("View warehouse content")],
853 ["warehouse_management", $locale->text("Warehouse management")],
854 ["--general_ledger_cash", $locale->text("General ledger and cash")],
855 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
856 ["datev_export", $locale->text("DATEV Export")],
857 ["cash", $locale->text("Receipt, payment, reconciliation")],
858 ["--reports", $locale->text('Reports')],
859 ["report", $locale->text('All reports')],
860 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
861 ["--batch_printing", $locale->text("Batch Printing")],
862 ["batch_printing", $locale->text("Batch Printing")],
863 ["--others", $locale->text("Others")],
864 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
865 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
872 return grep !/^--/, map { $_->[0] } all_rights_full();
876 $main::lxdebug->enter_sub();
880 my $form = $main::form;
882 my $dbh = $self->dbconnect();
884 my $query = 'SELECT * FROM auth."group"';
885 my $sth = prepare_execute_query($form, $dbh, $query);
889 while ($row = $sth->fetchrow_hashref()) {
890 $groups->{$row->{id}} = $row;
894 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
895 $sth = prepare_query($form, $dbh, $query);
897 foreach $group (values %{$groups}) {
900 do_statement($form, $sth, $query, $group->{id});
902 while ($row = $sth->fetchrow_hashref()) {
903 push @members, $row->{user_id};
905 $group->{members} = [ uniq @members ];
909 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
910 $sth = prepare_query($form, $dbh, $query);
912 foreach $group (values %{$groups}) {
913 $group->{rights} = {};
915 do_statement($form, $sth, $query, $group->{id});
917 while ($row = $sth->fetchrow_hashref()) {
918 $group->{rights}->{$row->{right}} |= $row->{granted};
921 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
925 $main::lxdebug->leave_sub();
931 $main::lxdebug->enter_sub();
936 my $form = $main::form;
937 my $dbh = $self->dbconnect();
941 my ($query, $sth, $row, $rights);
944 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
946 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
947 do_query($form, $dbh, $query, $group->{id});
950 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
952 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
954 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
955 $sth = prepare_query($form, $dbh, $query);
957 foreach my $user_id (uniq @{ $group->{members} }) {
958 do_statement($form, $sth, $query, $user_id, $group->{id});
962 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
964 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
965 $sth = prepare_query($form, $dbh, $query);
967 foreach my $right (keys %{ $group->{rights} }) {
968 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
974 $main::lxdebug->leave_sub();
978 $main::lxdebug->enter_sub();
983 my $form = $main::form;
985 my $dbh = $self->dbconnect();
988 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
989 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
990 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
994 $main::lxdebug->leave_sub();
997 sub evaluate_rights_ary {
998 $main::lxdebug->enter_sub(2);
1005 foreach my $el (@{$ary}) {
1006 if (ref $el eq "ARRAY") {
1007 if ($action eq '|') {
1008 $value |= evaluate_rights_ary($el);
1010 $value &= evaluate_rights_ary($el);
1013 } elsif (($el eq '&') || ($el eq '|')) {
1016 } elsif ($action eq '|') {
1025 $main::lxdebug->leave_sub(2);
1030 sub _parse_rights_string {
1031 $main::lxdebug->enter_sub(2);
1041 push @stack, $cur_ary;
1043 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1045 substr($access, 0, length $1) = "";
1047 next if ($token =~ /\s/);
1049 if ($token eq "(") {
1050 my $new_cur_ary = [];
1051 push @stack, $new_cur_ary;
1052 push @{$cur_ary}, $new_cur_ary;
1053 $cur_ary = $new_cur_ary;
1055 } elsif ($token eq ")") {
1059 $main::lxdebug->leave_sub(2);
1063 $cur_ary = $stack[-1];
1065 } elsif (($token eq "|") || ($token eq "&")) {
1066 push @{$cur_ary}, $token;
1069 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1073 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1075 $main::lxdebug->leave_sub(2);
1081 $main::lxdebug->enter_sub(2);
1086 my $default = shift;
1088 $self->{FULL_RIGHTS} ||= { };
1089 $self->{FULL_RIGHTS}->{$login} ||= { };
1091 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1092 $self->{RIGHTS} ||= { };
1093 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1095 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1098 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1099 $granted = $default if (!defined $granted);
1101 $main::lxdebug->leave_sub(2);
1107 $main::lxdebug->enter_sub(2);
1111 my $dont_abort = shift;
1113 my $form = $main::form;
1115 if ($self->check_right($form->{login}, $right)) {
1116 $main::lxdebug->leave_sub(2);
1121 delete $form->{title};
1122 $form->show_generic_error($main::locale->text("You do not have the permissions to access this function."));
1125 $main::lxdebug->leave_sub(2);
1130 sub load_rights_for_user {
1131 $main::lxdebug->enter_sub();
1136 my $form = $main::form;
1137 my $dbh = $self->dbconnect();
1139 my ($query, $sth, $row, $rights);
1144 qq|SELECT gr."right", gr.granted
1145 FROM auth.group_rights gr
1148 FROM auth.user_group ug
1149 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1150 WHERE u.login = ?)|;
1152 $sth = prepare_execute_query($form, $dbh, $query, $login);
1154 while ($row = $sth->fetchrow_hashref()) {
1155 $rights->{$row->{right}} |= $row->{granted};
1159 map({ $rights->{$_} = 0 unless (defined $rights->{$_}); } SL::Auth::all_rights());
1161 $main::lxdebug->leave_sub();
1175 SL::Auth - Authentication and session handling
1181 =item C<set_session_value %values>
1183 Store all key/value pairs in C<%values> in the session. All of these
1184 values are copied back into C<$::form> in the next request
1187 The values can be any Perl structure. They are stored as YAML dumps.
1189 =item C<get_session_value $key>
1191 Retrieve a value from the session. Returns C<undef> if the value
1194 =item C<create_unique_sesion_value $value, %params>
1196 Create a unique key in the session and store C<$value>
1199 If C<$params{expiration}> is set then it is interpreted as a number of
1200 seconds after which the value is removed from the session. It will
1201 never expire if that parameter is falsish.
1203 If C<$params{auto_restore}> is trueish then the value will be copied
1204 into C<$::form> upon the next request automatically. It defaults to
1205 C<false> and has therefore different behaviour than
1206 L</set_session_value>.
1208 Returns the key created in the session.
1210 =item C<expire_session_keys>
1212 Removes all keys from the session that have an expiration time set and
1213 whose expiration time is in the past.
1215 =item C<save_session>
1217 Stores the session values in the database. This is the only function
1218 that actually stores stuff in the database. Neither the various
1219 setters nor the deleter access the database.
1221 =item <save_form_in_session %params>
1223 Stores the content of C<$params{form}> (default: C<$::form>) in the
1224 session using L</create_unique_sesion_value>.
1226 If C<$params{non_scalars}> is trueish then non-scalar values will be
1227 stored as well. Default is to only store scalar values.
1229 The following keys will never be saved: C<login>, C<password>,
1230 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1231 can be given as an array ref in C<$params{skip_keys}>.
1233 Returns the unique key under which the form is stored.
1235 =item <restore_form_from_session $key, %params>
1237 Restores the form from the session into C<$params{form}> (default:
1240 If C<$params{clobber}> is falsish then existing values with the same
1241 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1254 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>