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';
30 $main::lxdebug->enter_sub();
37 $self->_read_auth_config();
40 $main::lxdebug->leave_sub();
46 my ($self, %params) = @_;
48 $self->{SESSION} = { };
49 $self->{FULL_RIGHTS} = { };
50 $self->{RIGHTS} = { };
51 $self->{unique_counter} = 0;
52 $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
53 $self->{authenticator}->reset;
57 my ($self, $login, %params) = @_;
58 my $may_fail = delete $params{may_fail};
60 my %user = $self->read_user(login => $login);
61 my $dbh = SL::DBConnect->connect(
66 pg_enable_utf8 => $::locale->is_utf8,
71 if (!$may_fail && !$dbh) {
72 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
75 if ($user{dboptions} && $dbh) {
76 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
85 $self->{dbh}->disconnect() if ($self->{dbh});
88 # form isn't loaded yet, so auth needs it's own error.
90 $::lxdebug->show_backtrace();
92 my ($self, @msg) = @_;
93 if ($ENV{HTTP_USER_AGENT}) {
94 print Form->create_http_response(content_type => 'text/html');
95 print "<pre>", join ('<br>', @msg), "</pre>";
97 print STDERR "Error: @msg\n";
102 sub _read_auth_config {
103 $main::lxdebug->enter_sub();
107 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
109 # Prevent password leakage to log files when dumping Auth instances.
110 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
112 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
113 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
115 if ($self->{module} eq 'DB') {
116 $self->{authenticator} = SL::Auth::DB->new($self);
118 } elsif ($self->{module} eq 'LDAP') {
119 $self->{authenticator} = SL::Auth::LDAP->new($self);
122 if (!$self->{authenticator}) {
123 my $locale = Locale->new('en');
124 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
127 my $cfg = $self->{DB_config};
130 my $locale = Locale->new('en');
131 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
134 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
135 my $locale = Locale->new('en');
136 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
139 $self->{authenticator}->verify_config();
141 $self->{session_timeout} *= 1;
142 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
144 $main::lxdebug->leave_sub();
147 sub authenticate_root {
148 $main::lxdebug->enter_sub();
150 my ($self, $password) = @_;
152 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
153 if (defined $session_root_auth && $session_root_auth == OK) {
154 $::lxdebug->leave_sub;
158 if (!defined $password) {
159 $::lxdebug->leave_sub;
163 $password = SL::Auth::Password->hash(login => 'root', password => $password);
164 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
166 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
167 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
169 $::lxdebug->leave_sub;
174 $main::lxdebug->enter_sub();
176 my ($self, $login, $password) = @_;
178 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
179 if (defined $session_auth && $session_auth == OK) {
180 $::lxdebug->leave_sub;
184 if (!defined $password) {
185 $::lxdebug->leave_sub;
189 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
190 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login);
192 $::lxdebug->leave_sub;
196 sub punish_wrong_login {
197 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
198 sleep $failed_login_penalty if $failed_login_penalty;
201 sub get_stored_password {
202 my ($self, $login) = @_;
204 my $dbh = $self->dbconnect;
206 return undef unless $dbh;
208 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
209 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
211 return $stored_password;
215 $main::lxdebug->enter_sub(2);
218 my $may_fail = shift;
221 $main::lxdebug->leave_sub(2);
225 my $cfg = $self->{DB_config};
226 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
229 $dsn .= ';port=' . $cfg->{port};
232 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
234 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
236 if (!$may_fail && !$self->{dbh}) {
237 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
240 $main::lxdebug->leave_sub(2);
246 $main::lxdebug->enter_sub();
251 $self->{dbh}->disconnect();
255 $main::lxdebug->leave_sub();
259 $main::lxdebug->enter_sub();
261 my ($self, $dbh) = @_;
263 $dbh ||= $self->dbconnect();
264 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
266 my ($count) = $dbh->selectrow_array($query);
268 $main::lxdebug->leave_sub();
274 $main::lxdebug->enter_sub();
278 my $dbh = $self->dbconnect(1);
280 $main::lxdebug->leave_sub();
285 sub create_database {
286 $main::lxdebug->enter_sub();
291 my $cfg = $self->{DB_config};
293 if (!$params{superuser}) {
294 $params{superuser} = $cfg->{user};
295 $params{superuser_password} = $cfg->{password};
298 $params{template} ||= 'template0';
299 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
301 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
304 $dsn .= ';port=' . $cfg->{port};
307 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
309 my $charset = $::lx_office_conf{system}->{dbcharset};
310 $charset ||= Common::DEFAULT_CHARSET;
311 my $encoding = $Common::charset_to_db_encoding{$charset};
312 $encoding ||= 'UNICODE';
314 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
317 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
320 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
322 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
327 my $error = $dbh->errstr();
329 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
330 my ($cluster_encoding) = $dbh->selectrow_array($query);
332 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
333 $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.');
338 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
343 $main::lxdebug->leave_sub();
347 $main::lxdebug->enter_sub();
350 my $dbh = $self->dbconnect();
352 my $charset = $::lx_office_conf{system}->{dbcharset};
353 $charset ||= Common::DEFAULT_CHARSET;
356 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
358 $main::lxdebug->leave_sub();
362 $main::lxdebug->enter_sub();
368 my $form = $main::form;
370 my $dbh = $self->dbconnect();
372 my ($sth, $query, $user_id);
376 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
377 ($user_id) = selectrow_query($form, $dbh, $query, $login);
380 $query = qq|SELECT nextval('auth.user_id_seq')|;
381 ($user_id) = selectrow_query($form, $dbh, $query);
383 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
384 do_query($form, $dbh, $query, $user_id, $login);
387 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
388 do_query($form, $dbh, $query, $user_id);
390 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
391 $sth = prepare_query($form, $dbh, $query);
393 while (my ($cfg_key, $cfg_value) = each %params) {
394 next if ($cfg_key eq 'password');
396 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
401 $main::lxdebug->leave_sub();
404 sub can_change_password {
407 return $self->{authenticator}->can_change_password();
410 sub change_password {
411 $main::lxdebug->enter_sub();
413 my ($self, $login, $new_password) = @_;
415 my $result = $self->{authenticator}->change_password($login, $new_password);
417 $main::lxdebug->leave_sub();
423 $main::lxdebug->enter_sub();
427 my $dbh = $self->dbconnect();
428 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
430 FROM auth."user" AS u
432 LEFT JOIN auth.user_config AS cfg
433 ON (cfg.user_id = u.id)
435 LEFT JOIN auth.session_content AS sc_login
436 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
438 LEFT JOIN auth.session AS s
439 ON (s.id = sc_login.session_id)
441 my $sth = prepare_execute_query($main::form, $dbh, $query);
445 while (my $ref = $sth->fetchrow_hashref()) {
447 $users{$ref->{login}} ||= {
448 'login' => $ref->{login},
450 'last_action' => $ref->{last_action},
452 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
457 $main::lxdebug->leave_sub();
463 $main::lxdebug->enter_sub();
465 my ($self, %params) = @_;
467 my $dbh = $self->dbconnect();
469 my (@where, @values);
470 if ($params{login}) {
471 push @where, 'u.login = ?';
472 push @values, $params{login};
475 push @where, 'u.id = ?';
476 push @values, $params{id};
478 my $where = join ' AND ', '1 = 1', @where;
479 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
480 FROM auth.user_config cfg
481 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
483 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
487 while (my $ref = $sth->fetchrow_hashref()) {
488 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
489 @user_data{qw(id login)} = @{$ref}{qw(id login)};
492 # The XUL/XML & 'CSS new' backed menus have been removed.
493 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
494 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
496 # The 'Win2000.css' stylesheet has been removed.
497 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
499 # Set default language if selected language does not exist (anymore).
500 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
504 $main::lxdebug->leave_sub();
510 $main::lxdebug->enter_sub();
515 my $dbh = $self->dbconnect();
516 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
518 $main::lxdebug->leave_sub();
524 $::lxdebug->enter_sub;
529 my $dbh = $self->dbconnect;
530 my $id = $self->get_user_id($login);
533 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
535 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
536 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
538 $u_dbh->begin_work if $u_dbh && $user_db_exists;
542 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
543 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
544 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
545 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
548 $u_dbh->commit if $u_dbh && $user_db_exists;
550 $::lxdebug->leave_sub;
553 # --------------------------------------
557 sub restore_session {
558 $main::lxdebug->enter_sub();
562 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
563 $session_id =~ s|[^0-9a-f]||g if $session_id;
565 $self->{SESSION} = { };
568 $main::lxdebug->leave_sub();
569 return $self->session_restore_result(SESSION_NONE());
572 my ($dbh, $query, $sth, $cookie, $ref, $form);
576 # Don't fail if the auth DB doesn't yet.
577 if (!( $dbh = $self->dbconnect(1) )) {
578 $::lxdebug->leave_sub;
579 return $self->session_restore_result(SESSION_NONE());
582 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
583 # admin is creating the session tables at the moment.
584 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
586 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
587 $sth->finish if $sth;
588 $::lxdebug->leave_sub;
589 return $self->session_restore_result(SESSION_NONE());
592 $cookie = $sth->fetchrow_hashref;
595 # The session ID provided is valid in the following cases:
596 # 1. session ID exists in the database
597 # 2. hasn't expired yet
598 # 3. if form field '{AUTH}api_token' is given: form field must equal database column 'auth.session.api_token' for the session ID
599 # 4. if form field '{AUTH}api_token' is NOT given then: the requestee's IP address must match the stored IP address
600 $self->{api_token} = $cookie->{api_token} if $cookie;
601 my $api_token_cookie = $self->get_api_token_cookie;
602 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
603 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
604 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie;
605 if ($cookie_is_bad) {
606 $self->destroy_session();
607 $main::lxdebug->leave_sub();
608 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
611 if ($self->{column_information}->has('auto_restore')) {
612 $self->_load_with_auto_restore_column($dbh, $session_id);
614 $self->_load_without_auto_restore_column($dbh, $session_id);
617 $main::lxdebug->leave_sub();
619 return $self->session_restore_result(SESSION_OK());
622 sub session_restore_result {
625 $self->{session_restore_result} = $_[0];
627 return $self->{session_restore_result};
630 sub _load_without_auto_restore_column {
631 my ($self, $dbh, $session_id) = @_;
634 SELECT sess_key, sess_value
635 FROM auth.session_content
636 WHERE (session_id = ?)
638 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
640 while (my $ref = $sth->fetchrow_hashref) {
641 my $value = SL::Auth::SessionValue->new(auth => $self,
642 key => $ref->{sess_key},
643 value => $ref->{sess_value},
645 $self->{SESSION}->{ $ref->{sess_key} } = $value;
647 next if defined $::form->{$ref->{sess_key}};
649 my $data = $value->get;
650 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
654 sub _load_with_auto_restore_column {
655 my ($self, $dbh, $session_id) = @_;
657 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
660 SELECT sess_key, sess_value, auto_restore
661 FROM auth.session_content
662 WHERE (session_id = ?)
664 OR sess_key IN (${auto_restore_keys}))
666 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
668 while (my $ref = $sth->fetchrow_hashref) {
669 my $value = SL::Auth::SessionValue->new(auth => $self,
670 key => $ref->{sess_key},
671 value => $ref->{sess_value},
672 auto_restore => $ref->{auto_restore},
674 $self->{SESSION}->{ $ref->{sess_key} } = $value;
676 next if defined $::form->{$ref->{sess_key}};
678 my $data = $value->get;
679 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
686 FROM auth.session_content
687 WHERE (session_id = ?)
688 AND NOT COALESCE(auto_restore, FALSE)
689 AND (sess_key NOT IN (${auto_restore_keys}))
691 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
693 while (my $ref = $sth->fetchrow_hashref) {
694 my $value = SL::Auth::SessionValue->new(auth => $self,
695 key => $ref->{sess_key});
696 $self->{SESSION}->{ $ref->{sess_key} } = $value;
700 sub destroy_session {
701 $main::lxdebug->enter_sub();
706 my $dbh = $self->dbconnect();
710 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
711 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
715 SL::SessionFile->destroy_session($session_id);
718 $self->{SESSION} = { };
721 $main::lxdebug->leave_sub();
724 sub active_session_ids {
726 my $dbh = $self->dbconnect;
728 my $query = qq|SELECT id FROM auth.session|;
730 my @ids = selectall_array_query($::form, $dbh, $query);
735 sub expire_sessions {
736 $main::lxdebug->enter_sub();
740 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
742 my $dbh = $self->dbconnect();
744 my $query = qq|SELECT id
746 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
748 my @ids = selectall_array_query($::form, $dbh, $query);
753 SL::SessionFile->destroy_session($_) for @ids;
755 $query = qq|DELETE FROM auth.session_content
756 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
757 do_query($main::form, $dbh, $query, @ids);
759 $query = qq|DELETE FROM auth.session
760 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
761 do_query($main::form, $dbh, $query, @ids);
766 $main::lxdebug->leave_sub();
769 sub _create_session_id {
770 $main::lxdebug->enter_sub();
773 map { push @data, int(rand() * 255); } (1..32);
775 my $id = md5_hex(pack 'C*', @data);
777 $main::lxdebug->leave_sub();
782 sub create_or_refresh_session {
783 $session_id ||= shift->_create_session_id;
787 $::lxdebug->enter_sub;
789 my $provided_dbh = shift;
791 my $dbh = $provided_dbh || $self->dbconnect(1);
793 $::lxdebug->leave_sub && return unless $dbh && $session_id;
795 $dbh->begin_work unless $provided_dbh;
797 # If this fails then the "auth" schema might not exist yet, e.g. if
798 # the admin is just trying to create the auth database.
799 if (!$dbh->do(qq|LOCK auth.session_content|)) {
800 $dbh->rollback unless $provided_dbh;
801 $::lxdebug->leave_sub;
805 my @unfetched_keys = map { $_->{key} }
806 grep { ! $_->{fetched} }
807 values %{ $self->{SESSION} };
808 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
809 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
810 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
811 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
813 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
815 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
818 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
820 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
823 if ($self->{column_information}->has('api_token', 'session')) {
824 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
825 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
828 my @values_to_save = grep { $_->{fetched} }
829 values %{ $self->{SESSION} };
830 if (@values_to_save) {
831 my ($columns, $placeholders) = ('', '');
832 my $auto_restore = $self->{column_information}->has('auto_restore');
835 $columns .= ', auto_restore';
836 $placeholders .= ', ?';
839 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
840 my $sth = prepare_query($::form, $dbh, $query);
842 foreach my $value (@values_to_save) {
843 my @values = ($value->{key}, $value->get_dumped);
844 push @values, $value->{auto_restore} if $auto_restore;
846 do_statement($::form, $sth, $query, $session_id, @values);
852 $dbh->commit() unless $provided_dbh;
853 $::lxdebug->leave_sub;
856 sub set_session_value {
857 $main::lxdebug->enter_sub();
862 $self->{SESSION} ||= { };
865 my $key = shift @params;
867 if (ref $key eq 'HASH') {
868 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
869 value => $key->{value},
870 auto_restore => $key->{auto_restore});
873 my $value = shift @params;
874 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
879 $main::lxdebug->leave_sub();
884 sub delete_session_value {
885 $main::lxdebug->enter_sub();
889 $self->{SESSION} ||= { };
890 delete @{ $self->{SESSION} }{ @_ };
892 $main::lxdebug->leave_sub();
897 sub get_session_value {
898 $main::lxdebug->enter_sub();
901 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
903 $main::lxdebug->leave_sub();
908 sub create_unique_sesion_value {
909 my ($self, $value, %params) = @_;
911 $self->{SESSION} ||= { };
913 my @now = gettimeofday();
914 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
915 $self->{unique_counter} ||= 0;
919 $self->{unique_counter}++;
920 $hashed_key = md5_hex($key . $self->{unique_counter});
921 } while (exists $self->{SESSION}->{$hashed_key});
923 $self->set_session_value($hashed_key => $value);
928 sub save_form_in_session {
929 my ($self, %params) = @_;
931 my $form = delete($params{form}) || $::form;
932 my $non_scalars = delete $params{non_scalars};
935 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
937 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
938 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
941 return $self->create_unique_sesion_value($data, %params);
944 sub restore_form_from_session {
945 my ($self, $key, %params) = @_;
947 my $data = $self->get_session_value($key);
948 return $self unless $data;
950 my $form = delete($params{form}) || $::form;
951 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
953 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
958 sub set_cookie_environment_variable {
960 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
963 sub get_session_cookie_name {
964 my ($self, %params) = @_;
966 $params{type} ||= 'id';
967 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
968 $name .= '_api_token' if $params{type} eq 'api_token';
977 sub get_api_token_cookie {
980 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
983 sub session_tables_present {
984 $main::lxdebug->enter_sub();
988 # Only re-check for the presence of auth tables if either the check
989 # hasn't been done before of if they weren't present.
990 if ($self->{session_tables_present}) {
991 $main::lxdebug->leave_sub();
992 return $self->{session_tables_present};
995 my $dbh = $self->dbconnect(1);
998 $main::lxdebug->leave_sub();
1005 WHERE (schemaname = 'auth')
1006 AND (tablename IN ('session', 'session_content'))|;
1008 my ($count) = selectrow_query($main::form, $dbh, $query);
1010 $self->{session_tables_present} = 2 == $count;
1012 $main::lxdebug->leave_sub();
1014 return $self->{session_tables_present};
1017 # --------------------------------------
1019 sub all_rights_full {
1020 my $locale = $main::locale;
1023 ["--crm", $locale->text("CRM optional software")],
1024 ["crm_search", $locale->text("CRM search")],
1025 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
1026 ["crm_service", $locale->text("CRM services")],
1027 ["crm_admin", $locale->text("CRM admin")],
1028 ["crm_adminuser", $locale->text("CRM user")],
1029 ["crm_adminstatus", $locale->text("CRM status")],
1030 ["crm_email", $locale->text("CRM send email")],
1031 ["crm_termin", $locale->text("CRM termin")],
1032 ["crm_opportunity", $locale->text("CRM opportunity")],
1033 ["crm_knowhow", $locale->text("CRM know how")],
1034 ["crm_follow", $locale->text("CRM follow up")],
1035 ["crm_notices", $locale->text("CRM notices")],
1036 ["crm_other", $locale->text("CRM other")],
1037 ["--master_data", $locale->text("Master Data")],
1038 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
1039 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
1040 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
1041 ["project_edit", $locale->text("Create and edit projects")],
1042 ["--ar", $locale->text("AR")],
1043 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
1044 ["sales_order_edit", $locale->text("Create and edit sales orders")],
1045 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
1046 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
1047 ["dunning_edit", $locale->text("Create and edit dunnings")],
1048 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
1049 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
1050 ["--ap", $locale->text("AP")],
1051 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1052 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1053 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1054 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1055 ["--warehouse_management", $locale->text("Warehouse management")],
1056 ["warehouse_contents", $locale->text("View warehouse content")],
1057 ["warehouse_management", $locale->text("Warehouse management")],
1058 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1059 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1060 ["datev_export", $locale->text("DATEV Export")],
1061 ["cash", $locale->text("Receipt, payment, reconciliation")],
1062 ["--reports", $locale->text('Reports')],
1063 ["report", $locale->text('All reports')],
1064 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1065 ["--batch_printing", $locale->text("Batch Printing")],
1066 ["batch_printing", $locale->text("Batch Printing")],
1067 ["--others", $locale->text("Others")],
1068 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1069 ["config", $locale->text("Change kivitendo installation settings (all menu entries beneath 'System')")],
1070 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1071 ["productivity", $locale->text("Productivity")],
1072 ["display_admin_link", $locale->text("Show administration link")],
1079 return grep !/^--/, map { $_->[0] } all_rights_full();
1083 $main::lxdebug->enter_sub();
1087 my $form = $main::form;
1089 my $dbh = $self->dbconnect();
1091 my $query = 'SELECT * FROM auth."group"';
1092 my $sth = prepare_execute_query($form, $dbh, $query);
1096 while ($row = $sth->fetchrow_hashref()) {
1097 $groups->{$row->{id}} = $row;
1101 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1102 $sth = prepare_query($form, $dbh, $query);
1104 foreach $group (values %{$groups}) {
1107 do_statement($form, $sth, $query, $group->{id});
1109 while ($row = $sth->fetchrow_hashref()) {
1110 push @members, $row->{user_id};
1112 $group->{members} = [ uniq @members ];
1116 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1117 $sth = prepare_query($form, $dbh, $query);
1119 foreach $group (values %{$groups}) {
1120 $group->{rights} = {};
1122 do_statement($form, $sth, $query, $group->{id});
1124 while ($row = $sth->fetchrow_hashref()) {
1125 $group->{rights}->{$row->{right}} |= $row->{granted};
1128 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1132 $main::lxdebug->leave_sub();
1138 $main::lxdebug->enter_sub();
1143 my $form = $main::form;
1144 my $dbh = $self->dbconnect();
1148 my ($query, $sth, $row, $rights);
1150 if (!$group->{id}) {
1151 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1153 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1154 do_query($form, $dbh, $query, $group->{id});
1157 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1159 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1161 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1162 $sth = prepare_query($form, $dbh, $query);
1164 foreach my $user_id (uniq @{ $group->{members} }) {
1165 do_statement($form, $sth, $query, $user_id, $group->{id});
1169 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1171 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1172 $sth = prepare_query($form, $dbh, $query);
1174 foreach my $right (keys %{ $group->{rights} }) {
1175 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1181 $main::lxdebug->leave_sub();
1185 $main::lxdebug->enter_sub();
1190 my $form = $main::form;
1192 my $dbh = $self->dbconnect();
1195 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1196 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1197 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1201 $main::lxdebug->leave_sub();
1204 sub evaluate_rights_ary {
1205 $main::lxdebug->enter_sub(2);
1212 foreach my $el (@{$ary}) {
1213 if (ref $el eq "ARRAY") {
1214 if ($action eq '|') {
1215 $value |= evaluate_rights_ary($el);
1217 $value &= evaluate_rights_ary($el);
1220 } elsif (($el eq '&') || ($el eq '|')) {
1223 } elsif ($action eq '|') {
1232 $main::lxdebug->leave_sub(2);
1237 sub _parse_rights_string {
1238 $main::lxdebug->enter_sub(2);
1248 push @stack, $cur_ary;
1250 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1252 substr($access, 0, length $1) = "";
1254 next if ($token =~ /\s/);
1256 if ($token eq "(") {
1257 my $new_cur_ary = [];
1258 push @stack, $new_cur_ary;
1259 push @{$cur_ary}, $new_cur_ary;
1260 $cur_ary = $new_cur_ary;
1262 } elsif ($token eq ")") {
1266 $main::lxdebug->leave_sub(2);
1270 $cur_ary = $stack[-1];
1272 } elsif (($token eq "|") || ($token eq "&")) {
1273 push @{$cur_ary}, $token;
1276 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1280 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1282 $main::lxdebug->leave_sub(2);
1288 $main::lxdebug->enter_sub(2);
1293 my $default = shift;
1295 $self->{FULL_RIGHTS} ||= { };
1296 $self->{FULL_RIGHTS}->{$login} ||= { };
1298 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1299 $self->{RIGHTS} ||= { };
1300 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1302 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1305 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1306 $granted = $default if (!defined $granted);
1308 $main::lxdebug->leave_sub(2);
1314 $::lxdebug->enter_sub(2);
1315 my ($self, $right, $dont_abort) = @_;
1317 if ($self->check_right($::myconfig{login}, $right)) {
1318 $::lxdebug->leave_sub(2);
1323 delete $::form->{title};
1324 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1327 $::lxdebug->leave_sub(2);
1332 sub load_rights_for_user {
1333 $::lxdebug->enter_sub;
1335 my ($self, $login) = @_;
1336 my $dbh = $self->dbconnect;
1337 my ($query, $sth, $row, $rights);
1339 $rights = { map { $_ => 0 } all_rights() };
1342 qq|SELECT gr."right", gr.granted
1343 FROM auth.group_rights gr
1346 FROM auth.user_group ug
1347 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1348 WHERE u.login = ?)|;
1350 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1352 while ($row = $sth->fetchrow_hashref()) {
1353 $rights->{$row->{right}} |= $row->{granted};
1357 $::lxdebug->leave_sub;
1371 SL::Auth - Authentication and session handling
1377 =item C<set_session_value @values>
1379 =item C<set_session_value %values>
1381 Store all values of C<@values> or C<%values> in the session. Each
1382 member of C<@values> is tested if it is a hash reference. If it is
1383 then it must contain the keys C<key> and C<value> and can optionally
1384 contain the key C<auto_restore>. In this case C<value> is associated
1385 with C<key> and restored to C<$::form> upon the next request
1386 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1389 If the current member of C<@values> is not a hash reference then it
1390 will be used as the C<key> and the next entry of C<@values> is used as
1391 the C<value> to store. In this case setting C<auto_restore> is not
1394 Therefore the following two invocations are identical:
1396 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1397 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1399 All of these values are copied back into C<$::form> for the next
1400 request automatically if they're scalar values or if they have
1401 C<auto_restore> set to trueish.
1403 The values can be any Perl structure. They are stored as YAML dumps.
1405 =item C<get_session_value $key>
1407 Retrieve a value from the session. Returns C<undef> if the value
1410 =item C<create_unique_sesion_value $value, %params>
1412 Create a unique key in the session and store C<$value>
1415 Returns the key created in the session.
1417 =item C<save_session>
1419 Stores the session values in the database. This is the only function
1420 that actually stores stuff in the database. Neither the various
1421 setters nor the deleter access the database.
1423 =item <save_form_in_session %params>
1425 Stores the content of C<$params{form}> (default: C<$::form>) in the
1426 session using L</create_unique_sesion_value>.
1428 If C<$params{non_scalars}> is trueish then non-scalar values will be
1429 stored as well. Default is to only store scalar values.
1431 The following keys will never be saved: C<login>, C<password>,
1432 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1433 can be given as an array ref in C<$params{skip_keys}>.
1435 Returns the unique key under which the form is stored.
1437 =item <restore_form_from_session $key, %params>
1439 Restores the form from the session into C<$params{form}> (default:
1442 If C<$params{clobber}> is falsish then existing values with the same
1443 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1456 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>