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);
22 $main::lxdebug->enter_sub();
29 $self->{SESSION} = { };
31 $self->_read_auth_config();
33 $main::lxdebug->leave_sub();
39 my ($self, $login) = @_;
40 my %user = $self->read_user($login);
41 my $dbh = DBI->connect(
46 pg_enable_utf8 => $::locale->is_utf8,
49 ) or $::form->dberror;
51 if ($user{dboptions}) {
52 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
61 $self->{dbh}->disconnect() if ($self->{dbh});
64 # form isn't loaded yet, so auth needs it's own error.
66 $::lxdebug->show_backtrace();
68 my ($self, @msg) = @_;
69 if ($ENV{HTTP_USER_AGENT}) {
70 print Form->create_http_response(content_type => 'text/html');
71 print "<pre>", join ('<br>', @msg), "</pre>";
73 print STDERR "Error: @msg\n";
78 sub _read_auth_config {
79 $main::lxdebug->enter_sub();
83 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
84 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
85 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
87 if ($self->{module} eq 'DB') {
88 $self->{authenticator} = SL::Auth::DB->new($self);
90 } elsif ($self->{module} eq 'LDAP') {
91 $self->{authenticator} = SL::Auth::LDAP->new($self);
94 if (!$self->{authenticator}) {
95 my $locale = Locale->new('en');
96 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
99 my $cfg = $self->{DB_config};
102 my $locale = Locale->new('en');
103 $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
106 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
107 my $locale = Locale->new('en');
108 $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
111 $self->{authenticator}->verify_config();
113 $self->{session_timeout} *= 1;
114 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
116 $main::lxdebug->leave_sub();
119 sub authenticate_root {
120 $main::lxdebug->enter_sub();
123 my $password = shift;
124 my $is_crypted = shift;
126 $password = crypt $password, 'ro' if (!$password || !$is_crypted);
127 my $admin_password = crypt "$self->{admin_password}", 'ro';
129 $main::lxdebug->leave_sub();
131 return OK if $password eq $admin_password;
137 $main::lxdebug->enter_sub();
139 my ($self, $login, $password) = @_;
141 $main::lxdebug->leave_sub();
143 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
144 return OK if $result eq OK;
150 $main::lxdebug->enter_sub(2);
153 my $may_fail = shift;
156 $main::lxdebug->leave_sub(2);
160 my $cfg = $self->{DB_config};
161 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
164 $dsn .= ';port=' . $cfg->{port};
167 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
169 $self->{dbh} = DBI->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
171 if (!$may_fail && !$self->{dbh}) {
172 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
175 $main::lxdebug->leave_sub(2);
181 $main::lxdebug->enter_sub();
186 $self->{dbh}->disconnect();
190 $main::lxdebug->leave_sub();
194 $main::lxdebug->enter_sub();
198 my $dbh = $self->dbconnect();
199 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
201 my ($count) = $dbh->selectrow_array($query);
203 $main::lxdebug->leave_sub();
209 $main::lxdebug->enter_sub();
213 my $dbh = $self->dbconnect(1);
215 $main::lxdebug->leave_sub();
220 sub create_database {
221 $main::lxdebug->enter_sub();
226 my $cfg = $self->{DB_config};
228 if (!$params{superuser}) {
229 $params{superuser} = $cfg->{user};
230 $params{superuser_password} = $cfg->{password};
233 $params{template} ||= 'template0';
234 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
236 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
239 $dsn .= ';port=' . $cfg->{port};
242 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
244 my $charset = $::lx_office_conf{system}->{dbcharset};
245 $charset ||= Common::DEFAULT_CHARSET;
246 my $encoding = $Common::charset_to_db_encoding{$charset};
247 $encoding ||= 'UNICODE';
249 my $dbh = DBI->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => $charset =~ m/^utf-?8$/i });
252 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
255 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
257 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
262 my $error = $dbh->errstr();
264 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
265 my ($cluster_encoding) = $dbh->selectrow_array($query);
267 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
268 $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.');
273 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
278 $main::lxdebug->leave_sub();
282 $main::lxdebug->enter_sub();
285 my $dbh = $self->dbconnect();
287 my $charset = $::lx_office_conf{system}->{dbcharset};
288 $charset ||= Common::DEFAULT_CHARSET;
291 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
293 $main::lxdebug->leave_sub();
297 $main::lxdebug->enter_sub();
303 my $form = $main::form;
305 my $dbh = $self->dbconnect();
307 my ($sth, $query, $user_id);
311 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
312 ($user_id) = selectrow_query($form, $dbh, $query, $login);
315 $query = qq|SELECT nextval('auth.user_id_seq')|;
316 ($user_id) = selectrow_query($form, $dbh, $query);
318 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
319 do_query($form, $dbh, $query, $user_id, $login);
322 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
323 do_query($form, $dbh, $query, $user_id);
325 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
326 $sth = prepare_query($form, $dbh, $query);
328 while (my ($cfg_key, $cfg_value) = each %params) {
329 next if ($cfg_key eq 'password');
331 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
336 $main::lxdebug->leave_sub();
339 sub can_change_password {
342 return $self->{authenticator}->can_change_password();
345 sub change_password {
346 $main::lxdebug->enter_sub();
349 my $result = $self->{authenticator}->change_password(@_);
351 $main::lxdebug->leave_sub();
357 $main::lxdebug->enter_sub();
361 my $dbh = $self->dbconnect();
362 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
363 FROM auth.user_config cfg
364 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
365 my $sth = prepare_execute_query($main::form, $dbh, $query);
369 while (my $ref = $sth->fetchrow_hashref()) {
370 $users{$ref->{login}} ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
371 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
376 $main::lxdebug->leave_sub();
382 $main::lxdebug->enter_sub();
387 my $dbh = $self->dbconnect();
388 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
389 FROM auth.user_config cfg
390 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
391 WHERE (u.login = ?)|;
392 my $sth = prepare_execute_query($main::form, $dbh, $query, $login);
396 while (my $ref = $sth->fetchrow_hashref()) {
397 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
398 @user_data{qw(id login)} = @{$ref}{qw(id login)};
403 $main::lxdebug->leave_sub();
409 $main::lxdebug->enter_sub();
414 my $dbh = $self->dbconnect();
415 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
417 $main::lxdebug->leave_sub();
423 $main::lxdebug->enter_sub();
428 my $form = $main::form;
430 my $dbh = $self->dbconnect();
434 my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
436 my ($id) = selectrow_query($form, $dbh, $query, $login);
438 $dbh->rollback and return $main::lxdebug->leave_sub() if (!$id);
440 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
441 do_query($form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
445 $main::lxdebug->leave_sub();
448 # --------------------------------------
452 sub restore_session {
453 $main::lxdebug->enter_sub();
457 my $cgi = $main::cgi;
458 $cgi ||= CGI->new('');
460 $session_id = $cgi->cookie($self->get_session_cookie_name());
461 $session_id =~ s|[^0-9a-f]||g;
463 $self->{SESSION} = { };
466 $main::lxdebug->leave_sub();
470 my ($dbh, $query, $sth, $cookie, $ref, $form);
474 $dbh = $self->dbconnect();
475 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
477 $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
479 if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
480 $self->destroy_session();
481 $main::lxdebug->leave_sub();
482 return $cookie ? SESSION_EXPIRED : SESSION_NONE;
485 $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
486 $sth = prepare_execute_query($form, $dbh, $query, $session_id);
488 while (my $ref = $sth->fetchrow_hashref()) {
489 $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
490 next if defined $form->{$ref->{sess_key}};
492 my $params = $self->_load_value($ref->{sess_value});
493 $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
498 $main::lxdebug->leave_sub();
504 my ($self, $value) = @_;
506 return { simple => 1, data => $value } if $value !~ m/^---/;
508 my %params = ( simple => 1 );
510 my $data = YAML::Load($value);
512 if (ref $data eq 'HASH') {
513 map { $params{$_} = $data->{$_} } keys %{ $data };
517 $params{data} = $data;
521 } or $params{data} = $value;
526 sub destroy_session {
527 $main::lxdebug->enter_sub();
532 my $dbh = $self->dbconnect();
536 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
537 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
542 $self->{SESSION} = { };
545 $main::lxdebug->leave_sub();
548 sub expire_sessions {
549 $main::lxdebug->enter_sub();
553 my $dbh = $self->dbconnect();
558 qq|DELETE FROM auth.session_content
562 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
564 do_query($main::form, $dbh, $query);
567 qq|DELETE FROM auth.session
568 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
570 do_query($main::form, $dbh, $query);
574 $main::lxdebug->leave_sub();
577 sub _create_session_id {
578 $main::lxdebug->enter_sub();
581 map { push @data, int(rand() * 255); } (1..32);
583 my $id = md5_hex(pack 'C*', @data);
585 $main::lxdebug->leave_sub();
590 sub create_or_refresh_session {
591 $main::lxdebug->enter_sub();
595 $session_id ||= $self->_create_session_id();
597 my ($form, $dbh, $query, $sth, $id);
600 $dbh = $self->dbconnect();
603 do_query($::form, $dbh, qq|LOCK auth.session_content|);
605 $query = qq|SELECT id FROM auth.session WHERE id = ?|;
607 ($id) = selectrow_query($form, $dbh, $query, $session_id);
610 do_query($form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
613 do_query($form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
617 $self->save_session($dbh);
621 $main::lxdebug->leave_sub();
626 my $provided_dbh = shift;
628 my $dbh = $provided_dbh || $self->dbconnect(1);
632 $dbh->begin_work unless $provided_dbh;
634 do_query($::form, $dbh, qq|LOCK auth.session_content|);
635 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
637 if (%{ $self->{SESSION} }) {
638 my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
639 my $sth = prepare_query($::form, $dbh, $query);
641 foreach my $key (sort keys %{ $self->{SESSION} }) {
642 do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
648 $dbh->commit() unless $provided_dbh;
651 sub set_session_value {
652 $main::lxdebug->enter_sub();
657 $self->{SESSION} ||= { };
659 while (my ($key, $value) = each %params) {
660 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
663 $main::lxdebug->leave_sub();
668 sub delete_session_value {
669 $main::lxdebug->enter_sub();
673 $self->{SESSION} ||= { };
674 delete @{ $self->{SESSION} }{ @_ };
676 $main::lxdebug->leave_sub();
681 sub get_session_value {
682 $main::lxdebug->enter_sub();
685 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
687 $main::lxdebug->leave_sub();
689 return $params->{data};
692 sub create_unique_sesion_value {
693 my ($self, $value, %params) = @_;
695 $self->{SESSION} ||= { };
697 my @now = gettimeofday();
698 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
699 $self->{unique_counter} ||= 0;
701 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
702 $self->{unique_counter}++;
704 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
705 no_auto => !$params{auto_restore},
709 $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
711 return $key . $self->{unique_counter};
714 sub save_form_in_session {
715 my ($self, %params) = @_;
717 my $form = delete($params{form}) || $::form;
718 my $non_scalars = delete $params{non_scalars};
721 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
723 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
724 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
727 return $self->create_unique_sesion_value($data, %params);
730 sub restore_form_from_session {
731 my ($self, $key, %params) = @_;
733 my $data = $self->get_session_value($key);
734 return $self unless $data;
736 my $form = delete($params{form}) || $::form;
737 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
739 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
744 sub expire_session_keys {
747 $self->{SESSION} ||= { };
749 my @now = gettimeofday();
750 my $now = $now[0] * 1000000 + $now[1];
752 $self->delete_session_value(map { $_->[0] }
753 grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
754 map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
755 keys %{ $self->{SESSION} });
760 sub _has_expiration {
762 return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
765 sub set_cookie_environment_variable {
767 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
770 sub get_session_cookie_name {
773 return $self->{cookie_name} || 'lx_office_erp_session_id';
780 sub session_tables_present {
781 $main::lxdebug->enter_sub();
784 my $dbh = $self->dbconnect(1);
787 $main::lxdebug->leave_sub();
794 WHERE (schemaname = 'auth')
795 AND (tablename IN ('session', 'session_content'))|;
797 my ($count) = selectrow_query($main::form, $dbh, $query);
799 $main::lxdebug->leave_sub();
804 # --------------------------------------
806 sub all_rights_full {
807 my $locale = $main::locale;
810 ["--crm", $locale->text("CRM optional software")],
811 ["crm_search", $locale->text("CRM search")],
812 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
813 ["crm_service", $locale->text("CRM services")],
814 ["crm_admin", $locale->text("CRM admin")],
815 ["crm_adminuser", $locale->text("CRM user")],
816 ["crm_adminstatus", $locale->text("CRM status")],
817 ["crm_email", $locale->text("CRM send email")],
818 ["crm_termin", $locale->text("CRM termin")],
819 ["crm_opportunity", $locale->text("CRM opportunity")],
820 ["crm_knowhow", $locale->text("CRM know how")],
821 ["crm_follow", $locale->text("CRM follow up")],
822 ["crm_notices", $locale->text("CRM notices")],
823 ["crm_other", $locale->text("CRM other")],
824 ["--master_data", $locale->text("Master Data")],
825 ["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
826 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
827 ["project_edit", $locale->text("Create and edit projects")],
828 ["license_edit", $locale->text("Manage license keys")],
829 ["--ar", $locale->text("AR")],
830 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
831 ["sales_order_edit", $locale->text("Create and edit sales orders")],
832 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
833 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
834 ["dunning_edit", $locale->text("Create and edit dunnings")],
835 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
836 ["--ap", $locale->text("AP")],
837 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
838 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
839 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
840 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
841 ["--warehouse_management", $locale->text("Warehouse management")],
842 ["warehouse_contents", $locale->text("View warehouse content")],
843 ["warehouse_management", $locale->text("Warehouse management")],
844 ["--general_ledger_cash", $locale->text("General ledger and cash")],
845 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
846 ["datev_export", $locale->text("DATEV Export")],
847 ["cash", $locale->text("Receipt, payment, reconciliation")],
848 ["--reports", $locale->text('Reports')],
849 ["report", $locale->text('All reports')],
850 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
851 ["--batch_printing", $locale->text("Batch Printing")],
852 ["batch_printing", $locale->text("Batch Printing")],
853 ["--others", $locale->text("Others")],
854 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
855 ["config", $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
862 return grep !/^--/, map { $_->[0] } all_rights_full();
866 $main::lxdebug->enter_sub();
870 my $form = $main::form;
872 my $dbh = $self->dbconnect();
874 my $query = 'SELECT * FROM auth."group"';
875 my $sth = prepare_execute_query($form, $dbh, $query);
879 while ($row = $sth->fetchrow_hashref()) {
880 $groups->{$row->{id}} = $row;
884 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
885 $sth = prepare_query($form, $dbh, $query);
887 foreach $group (values %{$groups}) {
890 do_statement($form, $sth, $query, $group->{id});
892 while ($row = $sth->fetchrow_hashref()) {
893 push @members, $row->{user_id};
895 $group->{members} = [ uniq @members ];
899 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
900 $sth = prepare_query($form, $dbh, $query);
902 foreach $group (values %{$groups}) {
903 $group->{rights} = {};
905 do_statement($form, $sth, $query, $group->{id});
907 while ($row = $sth->fetchrow_hashref()) {
908 $group->{rights}->{$row->{right}} |= $row->{granted};
911 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
915 $main::lxdebug->leave_sub();
921 $main::lxdebug->enter_sub();
926 my $form = $main::form;
927 my $dbh = $self->dbconnect();
931 my ($query, $sth, $row, $rights);
934 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
936 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
937 do_query($form, $dbh, $query, $group->{id});
940 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
942 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
944 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
945 $sth = prepare_query($form, $dbh, $query);
947 foreach my $user_id (uniq @{ $group->{members} }) {
948 do_statement($form, $sth, $query, $user_id, $group->{id});
952 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
954 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
955 $sth = prepare_query($form, $dbh, $query);
957 foreach my $right (keys %{ $group->{rights} }) {
958 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
964 $main::lxdebug->leave_sub();
968 $main::lxdebug->enter_sub();
973 my $form = $main::from;
975 my $dbh = $self->dbconnect();
978 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
979 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
980 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
984 $main::lxdebug->leave_sub();
987 sub evaluate_rights_ary {
988 $main::lxdebug->enter_sub(2);
995 foreach my $el (@{$ary}) {
996 if (ref $el eq "ARRAY") {
997 if ($action eq '|') {
998 $value |= evaluate_rights_ary($el);
1000 $value &= evaluate_rights_ary($el);
1003 } elsif (($el eq '&') || ($el eq '|')) {
1006 } elsif ($action eq '|') {
1015 $main::lxdebug->leave_sub(2);
1020 sub _parse_rights_string {
1021 $main::lxdebug->enter_sub(2);
1031 push @stack, $cur_ary;
1033 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1035 substr($access, 0, length $1) = "";
1037 next if ($token =~ /\s/);
1039 if ($token eq "(") {
1040 my $new_cur_ary = [];
1041 push @stack, $new_cur_ary;
1042 push @{$cur_ary}, $new_cur_ary;
1043 $cur_ary = $new_cur_ary;
1045 } elsif ($token eq ")") {
1049 $main::lxdebug->leave_sub(2);
1053 $cur_ary = $stack[-1];
1055 } elsif (($token eq "|") || ($token eq "&")) {
1056 push @{$cur_ary}, $token;
1059 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1063 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1065 $main::lxdebug->leave_sub(2);
1071 $main::lxdebug->enter_sub(2);
1076 my $default = shift;
1078 $self->{FULL_RIGHTS} ||= { };
1079 $self->{FULL_RIGHTS}->{$login} ||= { };
1081 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1082 $self->{RIGHTS} ||= { };
1083 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1085 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1088 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1089 $granted = $default if (!defined $granted);
1091 $main::lxdebug->leave_sub(2);
1097 $main::lxdebug->enter_sub(2);
1101 my $dont_abort = shift;
1103 my $form = $main::form;
1105 if ($self->check_right($form->{login}, $right)) {
1106 $main::lxdebug->leave_sub(2);
1111 delete $form->{title};
1112 $form->show_generic_error($main::locale->text("You do not have the permissions to access this function."));
1115 $main::lxdebug->leave_sub(2);
1120 sub load_rights_for_user {
1121 $main::lxdebug->enter_sub();
1126 my $form = $main::form;
1127 my $dbh = $self->dbconnect();
1129 my ($query, $sth, $row, $rights);
1134 qq|SELECT gr."right", gr.granted
1135 FROM auth.group_rights gr
1138 FROM auth.user_group ug
1139 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1140 WHERE u.login = ?)|;
1142 $sth = prepare_execute_query($form, $dbh, $query, $login);
1144 while ($row = $sth->fetchrow_hashref()) {
1145 $rights->{$row->{right}} |= $row->{granted};
1149 map({ $rights->{$_} = 0 unless (defined $rights->{$_}); } SL::Auth::all_rights());
1151 $main::lxdebug->leave_sub();
1165 SL::Auth - Authentication and session handling
1171 =item C<set_session_value %values>
1173 Store all key/value pairs in C<%values> in the session. All of these
1174 values are copied back into C<$::form> in the next request
1177 The values can be any Perl structure. They are stored as YAML dumps.
1179 =item C<get_session_value $key>
1181 Retrieve a value from the session. Returns C<undef> if the value
1184 =item C<create_unique_sesion_value $value, %params>
1186 Create a unique key in the session and store C<$value>
1189 If C<$params{expiration}> is set then it is interpreted as a number of
1190 seconds after which the value is removed from the session. It will
1191 never expire if that parameter is falsish.
1193 If C<$params{auto_restore}> is trueish then the value will be copied
1194 into C<$::form> upon the next request automatically. It defaults to
1195 C<false> and has therefore different behaviour than
1196 L</set_session_value>.
1198 Returns the key created in the session.
1200 =item C<expire_session_keys>
1202 Removes all keys from the session that have an expiration time set and
1203 whose expiration time is in the past.
1205 =item C<save_session>
1207 Stores the session values in the database. This is the only function
1208 that actually stores stuff in the database. Neither the various
1209 setters nor the deleter access the database.
1211 =item <save_form_in_session %params>
1213 Stores the content of C<$params{form}> (default: C<$::form>) in the
1214 session using L</create_unique_sesion_value>.
1216 If C<$params{non_scalars}> is trueish then non-scalar values will be
1217 stored as well. Default is to only store scalar values.
1219 The following keys will never be saved: C<login>, C<password>,
1220 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1221 can be given as an array ref in C<$params{skip_keys}>.
1223 Returns the unique key under which the form is stored.
1225 =item <restore_form_from_session $key, %params>
1227 Restores the form from the session into C<$params{form}> (default:
1230 If C<$params{clobber}> is falsish then existing values with the same
1231 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1244 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>