5 use Digest::MD5 qw(md5_hex);
7 use Time::HiRes qw(gettimeofday);
8 use List::MoreUtils qw(uniq);
11 use SL::Auth::ColumnInformation;
12 use SL::Auth::Constants qw(:all);
15 use SL::Auth::Password;
16 use SL::Auth::SessionValue;
26 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
27 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
29 use Rose::Object::MakeMethods::Generic (
30 scalar => [ qw(client) ],
35 $main::lxdebug->enter_sub();
42 $self->_read_auth_config();
45 $main::lxdebug->leave_sub();
51 my ($self, %params) = @_;
53 $self->{SESSION} = { };
54 $self->{FULL_RIGHTS} = { };
55 $self->{RIGHTS} = { };
56 $self->{unique_counter} = 0;
57 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
58 $self->{authenticator}->reset;
64 my ($self, $id_or_name) = @_;
68 return undef unless $id_or_name;
70 my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
71 my $dbh = $self->dbconnect;
73 return undef unless $dbh;
75 $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
83 $self->{dbh}->disconnect() if ($self->{dbh});
86 # form isn't loaded yet, so auth needs it's own error.
88 $::lxdebug->show_backtrace();
90 my ($self, @msg) = @_;
91 if ($ENV{HTTP_USER_AGENT}) {
92 print Form->create_http_response(content_type => 'text/html');
93 print "<pre>", join ('<br>', @msg), "</pre>";
95 print STDERR "Error: @msg\n";
100 sub _read_auth_config {
101 $main::lxdebug->enter_sub();
105 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
107 # Prevent password leakage to log files when dumping Auth instances.
108 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
110 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
111 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
113 if ($self->{module} eq 'DB') {
114 $self->{authenticator} = SL::Auth::DB->new($self);
116 } elsif ($self->{module} eq 'LDAP') {
117 $self->{authenticator} = SL::Auth::LDAP->new($self);
120 if (!$self->{authenticator}) {
121 my $locale = Locale->new('en');
122 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
125 my $cfg = $self->{DB_config};
128 my $locale = Locale->new('en');
129 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
132 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
133 my $locale = Locale->new('en');
134 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
137 $self->{authenticator}->verify_config();
139 $self->{session_timeout} *= 1;
140 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
142 $main::lxdebug->leave_sub();
145 sub has_access_to_client {
146 my ($self, $login) = @_;
148 return 0 if !$self->client || !$self->client->{id};
152 FROM auth.clients_users cu
153 LEFT JOIN auth."user" u ON (cu.user_id = u.id)
155 AND (cu.client_id = ?)
158 my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
162 sub authenticate_root {
163 $main::lxdebug->enter_sub();
165 my ($self, $password) = @_;
167 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
168 if (defined $session_root_auth && $session_root_auth == OK) {
169 $::lxdebug->leave_sub;
173 if (!defined $password) {
174 $::lxdebug->leave_sub;
178 $password = SL::Auth::Password->hash(login => 'root', password => $password);
179 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
181 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
182 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
184 $::lxdebug->leave_sub;
189 $main::lxdebug->enter_sub();
191 my ($self, $login, $password) = @_;
193 if (!$self->client || !$self->has_access_to_client($login)) {
194 $::lxdebug->leave_sub;
198 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
199 if (defined $session_auth && $session_auth == OK) {
200 $::lxdebug->leave_sub;
204 if (!defined $password) {
205 $::lxdebug->leave_sub;
209 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
210 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
212 $::lxdebug->leave_sub;
216 sub punish_wrong_login {
217 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
218 sleep $failed_login_penalty if $failed_login_penalty;
221 sub get_stored_password {
222 my ($self, $login) = @_;
224 my $dbh = $self->dbconnect;
226 return undef unless $dbh;
228 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
229 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
231 return $stored_password;
235 $main::lxdebug->enter_sub(2);
238 my $may_fail = shift;
241 $main::lxdebug->leave_sub(2);
245 my $cfg = $self->{DB_config};
246 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
249 $dsn .= ';port=' . $cfg->{port};
252 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
254 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
256 if (!$may_fail && !$self->{dbh}) {
257 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
260 $main::lxdebug->leave_sub(2);
266 $main::lxdebug->enter_sub();
271 $self->{dbh}->disconnect();
275 $main::lxdebug->leave_sub();
279 $main::lxdebug->enter_sub();
281 my ($self, $dbh) = @_;
283 $dbh ||= $self->dbconnect();
284 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
286 my ($count) = $dbh->selectrow_array($query);
288 $main::lxdebug->leave_sub();
294 $main::lxdebug->enter_sub();
298 my $dbh = $self->dbconnect(1);
300 $main::lxdebug->leave_sub();
305 sub create_database {
306 $main::lxdebug->enter_sub();
311 my $cfg = $self->{DB_config};
313 if (!$params{superuser}) {
314 $params{superuser} = $cfg->{user};
315 $params{superuser_password} = $cfg->{password};
318 $params{template} ||= 'template0';
319 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
321 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
324 $dsn .= ';port=' . $cfg->{port};
327 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
329 my $charset = $::lx_office_conf{system}->{dbcharset};
330 $charset ||= Common::DEFAULT_CHARSET;
331 my $encoding = $Common::charset_to_db_encoding{$charset};
332 $encoding ||= 'UNICODE';
334 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
337 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
340 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
342 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
347 my $error = $dbh->errstr();
349 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
350 my ($cluster_encoding) = $dbh->selectrow_array($query);
352 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
353 $error = $main::locale->text('Your PostgreSQL installationen uses UTF-8 as its encoding. Therefore you have to configure kivitendo to use UTF-8 as well.');
358 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
363 $main::lxdebug->leave_sub();
367 $main::lxdebug->enter_sub();
370 my $dbh = $self->dbconnect();
372 my $charset = $::lx_office_conf{system}->{dbcharset};
373 $charset ||= Common::DEFAULT_CHARSET;
376 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
378 $main::lxdebug->leave_sub();
382 $main::lxdebug->enter_sub();
388 my $form = $main::form;
390 my $dbh = $self->dbconnect();
392 my ($sth, $query, $user_id);
396 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
397 ($user_id) = selectrow_query($form, $dbh, $query, $login);
400 $query = qq|SELECT nextval('auth.user_id_seq')|;
401 ($user_id) = selectrow_query($form, $dbh, $query);
403 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
404 do_query($form, $dbh, $query, $user_id, $login);
407 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
408 do_query($form, $dbh, $query, $user_id);
410 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
411 $sth = prepare_query($form, $dbh, $query);
413 while (my ($cfg_key, $cfg_value) = each %params) {
414 next if ($cfg_key eq 'password');
416 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
421 $main::lxdebug->leave_sub();
424 sub can_change_password {
427 return $self->{authenticator}->can_change_password();
430 sub change_password {
431 $main::lxdebug->enter_sub();
433 my ($self, $login, $new_password) = @_;
435 my $result = $self->{authenticator}->change_password($login, $new_password);
437 $main::lxdebug->leave_sub();
443 $main::lxdebug->enter_sub();
447 my $dbh = $self->dbconnect();
448 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
450 FROM auth."user" AS u
452 LEFT JOIN auth.user_config AS cfg
453 ON (cfg.user_id = u.id)
455 LEFT JOIN auth.session_content AS sc_login
456 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
458 LEFT JOIN auth.session AS s
459 ON (s.id = sc_login.session_id)
461 my $sth = prepare_execute_query($main::form, $dbh, $query);
465 while (my $ref = $sth->fetchrow_hashref()) {
467 $users{$ref->{login}} ||= {
468 'login' => $ref->{login},
470 'last_action' => $ref->{last_action},
472 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
477 $main::lxdebug->leave_sub();
483 $main::lxdebug->enter_sub();
485 my ($self, %params) = @_;
487 my $dbh = $self->dbconnect();
489 my (@where, @values);
490 if ($params{login}) {
491 push @where, 'u.login = ?';
492 push @values, $params{login};
495 push @where, 'u.id = ?';
496 push @values, $params{id};
498 my $where = join ' AND ', '1 = 1', @where;
499 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
500 FROM auth.user_config cfg
501 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
503 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
507 while (my $ref = $sth->fetchrow_hashref()) {
508 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
509 @user_data{qw(id login)} = @{$ref}{qw(id login)};
512 # The XUL/XML & 'CSS new' backed menus have been removed.
513 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
514 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
516 # The 'Win2000.css' stylesheet has been removed.
517 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
519 # Set default language if selected language does not exist (anymore).
520 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
524 $main::lxdebug->leave_sub();
530 $main::lxdebug->enter_sub();
535 my $dbh = $self->dbconnect();
536 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
538 $main::lxdebug->leave_sub();
544 $::lxdebug->enter_sub;
549 my $dbh = $self->dbconnect;
550 my $id = $self->get_user_id($login);
552 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
556 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
557 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
558 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
560 # TODO: SL::Auth::delete_user
561 # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
565 $::lxdebug->leave_sub;
568 # --------------------------------------
572 sub restore_session {
573 $main::lxdebug->enter_sub();
577 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
578 $session_id =~ s|[^0-9a-f]||g if $session_id;
580 $self->{SESSION} = { };
583 $main::lxdebug->leave_sub();
584 return $self->session_restore_result(SESSION_NONE());
587 my ($dbh, $query, $sth, $cookie, $ref, $form);
591 # Don't fail if the auth DB doesn't yet.
592 if (!( $dbh = $self->dbconnect(1) )) {
593 $::lxdebug->leave_sub;
594 return $self->session_restore_result(SESSION_NONE());
597 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
598 # admin is creating the session tables at the moment.
599 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
601 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
602 $sth->finish if $sth;
603 $::lxdebug->leave_sub;
604 return $self->session_restore_result(SESSION_NONE());
607 $cookie = $sth->fetchrow_hashref;
610 # The session ID provided is valid in the following cases:
611 # 1. session ID exists in the database
612 # 2. hasn't expired yet
613 # 3. if form field '{AUTH}api_token' is given: form field must equal database column 'auth.session.api_token' for the session ID
614 # 4. if form field '{AUTH}api_token' is NOT given then: the requestee's IP address must match the stored IP address
615 $self->{api_token} = $cookie->{api_token} if $cookie;
616 my $api_token_cookie = $self->get_api_token_cookie;
617 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
618 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
619 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie;
620 if ($cookie_is_bad) {
621 $self->destroy_session();
622 $main::lxdebug->leave_sub();
623 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
626 if ($self->{column_information}->has('auto_restore')) {
627 $self->_load_with_auto_restore_column($dbh, $session_id);
629 $self->_load_without_auto_restore_column($dbh, $session_id);
632 $main::lxdebug->leave_sub();
634 return $self->session_restore_result(SESSION_OK());
637 sub session_restore_result {
640 $self->{session_restore_result} = $_[0];
642 return $self->{session_restore_result};
645 sub _load_without_auto_restore_column {
646 my ($self, $dbh, $session_id) = @_;
649 SELECT sess_key, sess_value
650 FROM auth.session_content
651 WHERE (session_id = ?)
653 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
655 while (my $ref = $sth->fetchrow_hashref) {
656 my $value = SL::Auth::SessionValue->new(auth => $self,
657 key => $ref->{sess_key},
658 value => $ref->{sess_value},
660 $self->{SESSION}->{ $ref->{sess_key} } = $value;
662 next if defined $::form->{$ref->{sess_key}};
664 my $data = $value->get;
665 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
669 sub _load_with_auto_restore_column {
670 my ($self, $dbh, $session_id) = @_;
672 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
675 SELECT sess_key, sess_value, auto_restore
676 FROM auth.session_content
677 WHERE (session_id = ?)
679 OR sess_key IN (${auto_restore_keys}))
681 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
683 while (my $ref = $sth->fetchrow_hashref) {
684 my $value = SL::Auth::SessionValue->new(auth => $self,
685 key => $ref->{sess_key},
686 value => $ref->{sess_value},
687 auto_restore => $ref->{auto_restore},
689 $self->{SESSION}->{ $ref->{sess_key} } = $value;
691 next if defined $::form->{$ref->{sess_key}};
693 my $data = $value->get;
694 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
701 FROM auth.session_content
702 WHERE (session_id = ?)
703 AND NOT COALESCE(auto_restore, FALSE)
704 AND (sess_key NOT IN (${auto_restore_keys}))
706 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
708 while (my $ref = $sth->fetchrow_hashref) {
709 my $value = SL::Auth::SessionValue->new(auth => $self,
710 key => $ref->{sess_key});
711 $self->{SESSION}->{ $ref->{sess_key} } = $value;
715 sub destroy_session {
716 $main::lxdebug->enter_sub();
721 my $dbh = $self->dbconnect();
725 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
726 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
730 SL::SessionFile->destroy_session($session_id);
733 $self->{SESSION} = { };
736 $main::lxdebug->leave_sub();
739 sub active_session_ids {
741 my $dbh = $self->dbconnect;
743 my $query = qq|SELECT id FROM auth.session|;
745 my @ids = selectall_array_query($::form, $dbh, $query);
750 sub expire_sessions {
751 $main::lxdebug->enter_sub();
755 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
757 my $dbh = $self->dbconnect();
759 my $query = qq|SELECT id
761 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
763 my @ids = selectall_array_query($::form, $dbh, $query);
768 SL::SessionFile->destroy_session($_) for @ids;
770 $query = qq|DELETE FROM auth.session_content
771 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
772 do_query($main::form, $dbh, $query, @ids);
774 $query = qq|DELETE FROM auth.session
775 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
776 do_query($main::form, $dbh, $query, @ids);
781 $main::lxdebug->leave_sub();
784 sub _create_session_id {
785 $main::lxdebug->enter_sub();
788 map { push @data, int(rand() * 255); } (1..32);
790 my $id = md5_hex(pack 'C*', @data);
792 $main::lxdebug->leave_sub();
797 sub create_or_refresh_session {
798 $session_id ||= shift->_create_session_id;
802 $::lxdebug->enter_sub;
804 my $provided_dbh = shift;
806 my $dbh = $provided_dbh || $self->dbconnect(1);
808 $::lxdebug->leave_sub && return unless $dbh && $session_id;
810 $dbh->begin_work unless $provided_dbh;
812 # If this fails then the "auth" schema might not exist yet, e.g. if
813 # the admin is just trying to create the auth database.
814 if (!$dbh->do(qq|LOCK auth.session_content|)) {
815 $dbh->rollback unless $provided_dbh;
816 $::lxdebug->leave_sub;
820 my @unfetched_keys = map { $_->{key} }
821 grep { ! $_->{fetched} }
822 values %{ $self->{SESSION} };
823 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
824 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
825 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
826 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
828 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
830 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
833 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
835 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
838 if ($self->{column_information}->has('api_token', 'session')) {
839 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
840 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
843 my @values_to_save = grep { $_->{fetched} }
844 values %{ $self->{SESSION} };
845 if (@values_to_save) {
846 my ($columns, $placeholders) = ('', '');
847 my $auto_restore = $self->{column_information}->has('auto_restore');
850 $columns .= ', auto_restore';
851 $placeholders .= ', ?';
854 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
855 my $sth = prepare_query($::form, $dbh, $query);
857 foreach my $value (@values_to_save) {
858 my @values = ($value->{key}, $value->get_dumped);
859 push @values, $value->{auto_restore} if $auto_restore;
861 do_statement($::form, $sth, $query, $session_id, @values);
867 $dbh->commit() unless $provided_dbh;
868 $::lxdebug->leave_sub;
871 sub set_session_value {
872 $main::lxdebug->enter_sub();
877 $self->{SESSION} ||= { };
880 my $key = shift @params;
882 if (ref $key eq 'HASH') {
883 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
884 value => $key->{value},
885 auto_restore => $key->{auto_restore});
888 my $value = shift @params;
889 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
894 $main::lxdebug->leave_sub();
899 sub delete_session_value {
900 $main::lxdebug->enter_sub();
904 $self->{SESSION} ||= { };
905 delete @{ $self->{SESSION} }{ @_ };
907 $main::lxdebug->leave_sub();
912 sub get_session_value {
913 $main::lxdebug->enter_sub();
916 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
918 $main::lxdebug->leave_sub();
923 sub create_unique_sesion_value {
924 my ($self, $value, %params) = @_;
926 $self->{SESSION} ||= { };
928 my @now = gettimeofday();
929 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
930 $self->{unique_counter} ||= 0;
934 $self->{unique_counter}++;
935 $hashed_key = md5_hex($key . $self->{unique_counter});
936 } while (exists $self->{SESSION}->{$hashed_key});
938 $self->set_session_value($hashed_key => $value);
943 sub save_form_in_session {
944 my ($self, %params) = @_;
946 my $form = delete($params{form}) || $::form;
947 my $non_scalars = delete $params{non_scalars};
950 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
952 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
953 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
956 return $self->create_unique_sesion_value($data, %params);
959 sub restore_form_from_session {
960 my ($self, $key, %params) = @_;
962 my $data = $self->get_session_value($key);
963 return $self unless $data;
965 my $form = delete($params{form}) || $::form;
966 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
968 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
973 sub set_cookie_environment_variable {
975 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
978 sub get_session_cookie_name {
979 my ($self, %params) = @_;
981 $params{type} ||= 'id';
982 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
983 $name .= '_api_token' if $params{type} eq 'api_token';
992 sub get_api_token_cookie {
995 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
998 sub session_tables_present {
999 $main::lxdebug->enter_sub();
1003 # Only re-check for the presence of auth tables if either the check
1004 # hasn't been done before of if they weren't present.
1005 if ($self->{session_tables_present}) {
1006 $main::lxdebug->leave_sub();
1007 return $self->{session_tables_present};
1010 my $dbh = $self->dbconnect(1);
1013 $main::lxdebug->leave_sub();
1020 WHERE (schemaname = 'auth')
1021 AND (tablename IN ('session', 'session_content'))|;
1023 my ($count) = selectrow_query($main::form, $dbh, $query);
1025 $self->{session_tables_present} = 2 == $count;
1027 $main::lxdebug->leave_sub();
1029 return $self->{session_tables_present};
1032 # --------------------------------------
1034 sub all_rights_full {
1035 my $locale = $main::locale;
1038 ["--crm", $locale->text("CRM optional software")],
1039 ["crm_search", $locale->text("CRM search")],
1040 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
1041 ["crm_service", $locale->text("CRM services")],
1042 ["crm_admin", $locale->text("CRM admin")],
1043 ["crm_adminuser", $locale->text("CRM user")],
1044 ["crm_adminstatus", $locale->text("CRM status")],
1045 ["crm_email", $locale->text("CRM send email")],
1046 ["crm_termin", $locale->text("CRM termin")],
1047 ["crm_opportunity", $locale->text("CRM opportunity")],
1048 ["crm_knowhow", $locale->text("CRM know how")],
1049 ["crm_follow", $locale->text("CRM follow up")],
1050 ["crm_notices", $locale->text("CRM notices")],
1051 ["crm_other", $locale->text("CRM other")],
1052 ["--master_data", $locale->text("Master Data")],
1053 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
1054 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
1055 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
1056 ["project_edit", $locale->text("Create and edit projects")],
1057 ["--ar", $locale->text("AR")],
1058 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
1059 ["sales_order_edit", $locale->text("Create and edit sales orders")],
1060 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
1061 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
1062 ["dunning_edit", $locale->text("Create and edit dunnings")],
1063 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
1064 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
1065 ["--ap", $locale->text("AP")],
1066 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1067 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1068 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1069 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1070 ["--warehouse_management", $locale->text("Warehouse management")],
1071 ["warehouse_contents", $locale->text("View warehouse content")],
1072 ["warehouse_management", $locale->text("Warehouse management")],
1073 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1074 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1075 ["datev_export", $locale->text("DATEV Export")],
1076 ["cash", $locale->text("Receipt, payment, reconciliation")],
1077 ["--reports", $locale->text('Reports')],
1078 ["report", $locale->text('All reports')],
1079 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1080 ["--batch_printing", $locale->text("Batch Printing")],
1081 ["batch_printing", $locale->text("Batch Printing")],
1082 ["--others", $locale->text("Others")],
1083 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1084 ["config", $locale->text("Change kivitendo installation settings (all menu entries beneath 'System')")],
1085 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1086 ["productivity", $locale->text("Productivity")],
1087 ["display_admin_link", $locale->text("Show administration link")],
1094 return grep !/^--/, map { $_->[0] } all_rights_full();
1098 $main::lxdebug->enter_sub();
1102 my $form = $main::form;
1104 my $dbh = $self->dbconnect();
1106 my $query = 'SELECT * FROM auth."group"';
1107 my $sth = prepare_execute_query($form, $dbh, $query);
1111 while ($row = $sth->fetchrow_hashref()) {
1112 $groups->{$row->{id}} = $row;
1116 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1117 $sth = prepare_query($form, $dbh, $query);
1119 foreach $group (values %{$groups}) {
1122 do_statement($form, $sth, $query, $group->{id});
1124 while ($row = $sth->fetchrow_hashref()) {
1125 push @members, $row->{user_id};
1127 $group->{members} = [ uniq @members ];
1131 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1132 $sth = prepare_query($form, $dbh, $query);
1134 foreach $group (values %{$groups}) {
1135 $group->{rights} = {};
1137 do_statement($form, $sth, $query, $group->{id});
1139 while ($row = $sth->fetchrow_hashref()) {
1140 $group->{rights}->{$row->{right}} |= $row->{granted};
1143 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1147 $main::lxdebug->leave_sub();
1153 $main::lxdebug->enter_sub();
1158 my $form = $main::form;
1159 my $dbh = $self->dbconnect();
1163 my ($query, $sth, $row, $rights);
1165 if (!$group->{id}) {
1166 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1168 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1169 do_query($form, $dbh, $query, $group->{id});
1172 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1174 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1176 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1177 $sth = prepare_query($form, $dbh, $query);
1179 foreach my $user_id (uniq @{ $group->{members} }) {
1180 do_statement($form, $sth, $query, $user_id, $group->{id});
1184 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1186 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1187 $sth = prepare_query($form, $dbh, $query);
1189 foreach my $right (keys %{ $group->{rights} }) {
1190 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1196 $main::lxdebug->leave_sub();
1200 $main::lxdebug->enter_sub();
1205 my $form = $main::form;
1207 my $dbh = $self->dbconnect();
1210 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1211 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1212 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1216 $main::lxdebug->leave_sub();
1219 sub evaluate_rights_ary {
1220 $main::lxdebug->enter_sub(2);
1227 foreach my $el (@{$ary}) {
1228 if (ref $el eq "ARRAY") {
1229 if ($action eq '|') {
1230 $value |= evaluate_rights_ary($el);
1232 $value &= evaluate_rights_ary($el);
1235 } elsif (($el eq '&') || ($el eq '|')) {
1238 } elsif ($action eq '|') {
1247 $main::lxdebug->leave_sub(2);
1252 sub _parse_rights_string {
1253 $main::lxdebug->enter_sub(2);
1263 push @stack, $cur_ary;
1265 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1267 substr($access, 0, length $1) = "";
1269 next if ($token =~ /\s/);
1271 if ($token eq "(") {
1272 my $new_cur_ary = [];
1273 push @stack, $new_cur_ary;
1274 push @{$cur_ary}, $new_cur_ary;
1275 $cur_ary = $new_cur_ary;
1277 } elsif ($token eq ")") {
1281 $main::lxdebug->leave_sub(2);
1285 $cur_ary = $stack[-1];
1287 } elsif (($token eq "|") || ($token eq "&")) {
1288 push @{$cur_ary}, $token;
1291 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1295 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1297 $main::lxdebug->leave_sub(2);
1303 $main::lxdebug->enter_sub(2);
1308 my $default = shift;
1310 $self->{FULL_RIGHTS} ||= { };
1311 $self->{FULL_RIGHTS}->{$login} ||= { };
1313 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1314 $self->{RIGHTS} ||= { };
1315 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1317 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1320 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1321 $granted = $default if (!defined $granted);
1323 $main::lxdebug->leave_sub(2);
1329 $::lxdebug->enter_sub(2);
1330 my ($self, $right, $dont_abort) = @_;
1332 if ($self->check_right($::myconfig{login}, $right)) {
1333 $::lxdebug->leave_sub(2);
1338 delete $::form->{title};
1339 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1342 $::lxdebug->leave_sub(2);
1347 sub load_rights_for_user {
1348 $::lxdebug->enter_sub;
1350 my ($self, $login) = @_;
1351 my $dbh = $self->dbconnect;
1352 my ($query, $sth, $row, $rights);
1354 $rights = { map { $_ => 0 } all_rights() };
1357 qq|SELECT gr."right", gr.granted
1358 FROM auth.group_rights gr
1361 FROM auth.user_group ug
1362 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1366 FROM auth.clients_groups cg
1367 WHERE cg.client_id = ?)|;
1369 $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1371 while ($row = $sth->fetchrow_hashref()) {
1372 $rights->{$row->{right}} |= $row->{granted};
1376 $::lxdebug->leave_sub;
1390 SL::Auth - Authentication and session handling
1396 =item C<set_session_value @values>
1398 =item C<set_session_value %values>
1400 Store all values of C<@values> or C<%values> in the session. Each
1401 member of C<@values> is tested if it is a hash reference. If it is
1402 then it must contain the keys C<key> and C<value> and can optionally
1403 contain the key C<auto_restore>. In this case C<value> is associated
1404 with C<key> and restored to C<$::form> upon the next request
1405 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1408 If the current member of C<@values> is not a hash reference then it
1409 will be used as the C<key> and the next entry of C<@values> is used as
1410 the C<value> to store. In this case setting C<auto_restore> is not
1413 Therefore the following two invocations are identical:
1415 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1416 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1418 All of these values are copied back into C<$::form> for the next
1419 request automatically if they're scalar values or if they have
1420 C<auto_restore> set to trueish.
1422 The values can be any Perl structure. They are stored as YAML dumps.
1424 =item C<get_session_value $key>
1426 Retrieve a value from the session. Returns C<undef> if the value
1429 =item C<create_unique_sesion_value $value, %params>
1431 Create a unique key in the session and store C<$value>
1434 Returns the key created in the session.
1436 =item C<save_session>
1438 Stores the session values in the database. This is the only function
1439 that actually stores stuff in the database. Neither the various
1440 setters nor the deleter access the database.
1442 =item <save_form_in_session %params>
1444 Stores the content of C<$params{form}> (default: C<$::form>) in the
1445 session using L</create_unique_sesion_value>.
1447 If C<$params{non_scalars}> is trueish then non-scalar values will be
1448 stored as well. Default is to only store scalar values.
1450 The following keys will never be saved: C<login>, C<password>,
1451 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1452 can be given as an array ref in C<$params{skip_keys}>.
1454 Returns the unique key under which the form is stored.
1456 =item <restore_form_from_session $key, %params>
1458 Restores the form from the session into C<$params{form}> (default:
1461 If C<$params{clobber}> is falsish then existing values with the same
1462 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1475 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>