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 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
572 my $dbh = $self->dbconnect();
577 qq|DELETE FROM auth.session_content
581 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
583 do_query($main::form, $dbh, $query);
586 qq|DELETE FROM auth.session
587 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
589 do_query($main::form, $dbh, $query);
593 $main::lxdebug->leave_sub();
596 sub _create_session_id {
597 $main::lxdebug->enter_sub();
600 map { push @data, int(rand() * 255); } (1..32);
602 my $id = md5_hex(pack 'C*', @data);
604 $main::lxdebug->leave_sub();
609 sub create_or_refresh_session {
610 $session_id ||= shift->_create_session_id;
614 $::lxdebug->enter_sub;
616 my $provided_dbh = shift;
618 my $dbh = $provided_dbh || $self->dbconnect(1);
620 $::lxdebug->leave_sub && return unless $dbh && $session_id;
622 $dbh->begin_work unless $provided_dbh;
624 do_query($::form, $dbh, qq|LOCK auth.session_content|);
625 do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
627 my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
629 my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
632 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
634 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
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;
649 $::lxdebug->leave_sub;
652 sub set_session_value {
653 $main::lxdebug->enter_sub();
658 $self->{SESSION} ||= { };
660 while (my ($key, $value) = each %params) {
661 $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
664 $main::lxdebug->leave_sub();
669 sub delete_session_value {
670 $main::lxdebug->enter_sub();
674 $self->{SESSION} ||= { };
675 delete @{ $self->{SESSION} }{ @_ };
677 $main::lxdebug->leave_sub();
682 sub get_session_value {
683 $main::lxdebug->enter_sub();
686 my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
688 $main::lxdebug->leave_sub();
690 return $params->{data};
693 sub create_unique_sesion_value {
694 my ($self, $value, %params) = @_;
696 $self->{SESSION} ||= { };
698 my @now = gettimeofday();
699 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
700 $self->{unique_counter} ||= 0;
702 $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
703 $self->{unique_counter}++;
705 $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
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();
785 # Only re-check for the presence of auth tables if either the check
786 # hasn't been done before of if they weren't present.
787 if ($self->{session_tables_present}) {
788 $main::lxdebug->leave_sub();
789 return $self->{session_tables_present};
792 my $dbh = $self->dbconnect(1);
795 $main::lxdebug->leave_sub();
802 WHERE (schemaname = 'auth')
803 AND (tablename IN ('session', 'session_content'))|;
805 my ($count) = selectrow_query($main::form, $dbh, $query);
807 $self->{session_tables_present} = 2 == $count;
809 $main::lxdebug->leave_sub();
811 return $self->{session_tables_present};
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 $::lxdebug->enter_sub(2);
1108 my ($self, $right, $dont_abort) = @_;
1110 if ($self->check_right($::myconfig{login}, $right)) {
1111 $::lxdebug->leave_sub(2);
1116 delete $::form->{title};
1117 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1120 $::lxdebug->leave_sub(2);
1125 sub load_rights_for_user {
1126 $::lxdebug->enter_sub;
1128 my ($self, $login) = @_;
1129 my $dbh = $self->dbconnect;
1130 my ($query, $sth, $row, $rights);
1132 $rights = { map { $_ => 0 } all_rights() };
1135 qq|SELECT gr."right", gr.granted
1136 FROM auth.group_rights gr
1139 FROM auth.user_group ug
1140 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1141 WHERE u.login = ?)|;
1143 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1145 while ($row = $sth->fetchrow_hashref()) {
1146 $rights->{$row->{right}} |= $row->{granted};
1150 $::lxdebug->leave_sub;
1164 SL::Auth - Authentication and session handling
1170 =item C<set_session_value %values>
1172 Store all key/value pairs in C<%values> in the session. All of these
1173 values are copied back into C<$::form> in the next request
1176 The values can be any Perl structure. They are stored as YAML dumps.
1178 =item C<get_session_value $key>
1180 Retrieve a value from the session. Returns C<undef> if the value
1183 =item C<create_unique_sesion_value $value, %params>
1185 Create a unique key in the session and store C<$value>
1188 If C<$params{expiration}> is set then it is interpreted as a number of
1189 seconds after which the value is removed from the session. It will
1190 never expire if that parameter is falsish.
1192 Returns the key created in the session.
1194 =item C<expire_session_keys>
1196 Removes all keys from the session that have an expiration time set and
1197 whose expiration time is in the past.
1199 =item C<save_session>
1201 Stores the session values in the database. This is the only function
1202 that actually stores stuff in the database. Neither the various
1203 setters nor the deleter access the database.
1205 =item <save_form_in_session %params>
1207 Stores the content of C<$params{form}> (default: C<$::form>) in the
1208 session using L</create_unique_sesion_value>.
1210 If C<$params{non_scalars}> is trueish then non-scalar values will be
1211 stored as well. Default is to only store scalar values.
1213 The following keys will never be saved: C<login>, C<password>,
1214 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1215 can be given as an array ref in C<$params{skip_keys}>.
1217 Returns the unique key under which the form is stored.
1219 =item <restore_form_from_session $key, %params>
1221 Restores the form from the session into C<$params{form}> (default:
1224 If C<$params{clobber}> is falsish then existing values with the same
1225 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1238 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>