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 my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
69 my $dbh = $self->dbconnect;
71 return undef unless $dbh;
73 $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
79 my ($self, $login, %params) = @_;
80 my $may_fail = delete $params{may_fail};
82 my %user = $self->read_user(login => $login);
83 my $dbh = SL::DBConnect->connect(
88 pg_enable_utf8 => $::locale->is_utf8,
93 if (!$may_fail && !$dbh) {
94 $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
97 if ($user{dboptions} && $dbh) {
98 $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
107 $self->{dbh}->disconnect() if ($self->{dbh});
110 # form isn't loaded yet, so auth needs it's own error.
112 $::lxdebug->show_backtrace();
114 my ($self, @msg) = @_;
115 if ($ENV{HTTP_USER_AGENT}) {
116 print Form->create_http_response(content_type => 'text/html');
117 print "<pre>", join ('<br>', @msg), "</pre>";
119 print STDERR "Error: @msg\n";
124 sub _read_auth_config {
125 $main::lxdebug->enter_sub();
129 map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
131 # Prevent password leakage to log files when dumping Auth instances.
132 $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
134 $self->{DB_config} = $::lx_office_conf{'authentication/database'};
135 $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
137 if ($self->{module} eq 'DB') {
138 $self->{authenticator} = SL::Auth::DB->new($self);
140 } elsif ($self->{module} eq 'LDAP') {
141 $self->{authenticator} = SL::Auth::LDAP->new($self);
144 if (!$self->{authenticator}) {
145 my $locale = Locale->new('en');
146 $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
149 my $cfg = $self->{DB_config};
152 my $locale = Locale->new('en');
153 $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
156 if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
157 my $locale = Locale->new('en');
158 $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
161 $self->{authenticator}->verify_config();
163 $self->{session_timeout} *= 1;
164 $self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
166 $main::lxdebug->leave_sub();
169 sub authenticate_root {
170 $main::lxdebug->enter_sub();
172 my ($self, $password) = @_;
174 my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
175 if (defined $session_root_auth && $session_root_auth == OK) {
176 $::lxdebug->leave_sub;
180 if (!defined $password) {
181 $::lxdebug->leave_sub;
185 $password = SL::Auth::Password->hash(login => 'root', password => $password);
186 my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
188 my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
189 $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
191 $::lxdebug->leave_sub;
196 $main::lxdebug->enter_sub();
198 my ($self, $login, $password) = @_;
200 my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
201 if (defined $session_auth && $session_auth == OK) {
202 $::lxdebug->leave_sub;
206 if (!defined $password) {
207 $::lxdebug->leave_sub;
211 my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
212 $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login);
214 $::lxdebug->leave_sub;
218 sub punish_wrong_login {
219 my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
220 sleep $failed_login_penalty if $failed_login_penalty;
223 sub get_stored_password {
224 my ($self, $login) = @_;
226 my $dbh = $self->dbconnect;
228 return undef unless $dbh;
230 my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
231 my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
233 return $stored_password;
237 $main::lxdebug->enter_sub(2);
240 my $may_fail = shift;
243 $main::lxdebug->leave_sub(2);
247 my $cfg = $self->{DB_config};
248 my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
251 $dsn .= ';port=' . $cfg->{port};
254 $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
256 $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
258 if (!$may_fail && !$self->{dbh}) {
259 $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
262 $main::lxdebug->leave_sub(2);
268 $main::lxdebug->enter_sub();
273 $self->{dbh}->disconnect();
277 $main::lxdebug->leave_sub();
281 $main::lxdebug->enter_sub();
283 my ($self, $dbh) = @_;
285 $dbh ||= $self->dbconnect();
286 my $query = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
288 my ($count) = $dbh->selectrow_array($query);
290 $main::lxdebug->leave_sub();
296 $main::lxdebug->enter_sub();
300 my $dbh = $self->dbconnect(1);
302 $main::lxdebug->leave_sub();
307 sub create_database {
308 $main::lxdebug->enter_sub();
313 my $cfg = $self->{DB_config};
315 if (!$params{superuser}) {
316 $params{superuser} = $cfg->{user};
317 $params{superuser_password} = $cfg->{password};
320 $params{template} ||= 'template0';
321 $params{template} =~ s|[^a-zA-Z0-9_\-]||g;
323 my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
326 $dsn .= ';port=' . $cfg->{port};
329 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
331 my $charset = $::lx_office_conf{system}->{dbcharset};
332 $charset ||= Common::DEFAULT_CHARSET;
333 my $encoding = $Common::charset_to_db_encoding{$charset};
334 $encoding ||= 'UNICODE';
336 my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
339 $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
342 my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
344 $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
349 my $error = $dbh->errstr();
351 $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
352 my ($cluster_encoding) = $dbh->selectrow_array($query);
354 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
355 $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.');
360 $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
365 $main::lxdebug->leave_sub();
369 $main::lxdebug->enter_sub();
372 my $dbh = $self->dbconnect();
374 my $charset = $::lx_office_conf{system}->{dbcharset};
375 $charset ||= Common::DEFAULT_CHARSET;
378 SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
380 $main::lxdebug->leave_sub();
384 $main::lxdebug->enter_sub();
390 my $form = $main::form;
392 my $dbh = $self->dbconnect();
394 my ($sth, $query, $user_id);
398 $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
399 ($user_id) = selectrow_query($form, $dbh, $query, $login);
402 $query = qq|SELECT nextval('auth.user_id_seq')|;
403 ($user_id) = selectrow_query($form, $dbh, $query);
405 $query = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
406 do_query($form, $dbh, $query, $user_id, $login);
409 $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
410 do_query($form, $dbh, $query, $user_id);
412 $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
413 $sth = prepare_query($form, $dbh, $query);
415 while (my ($cfg_key, $cfg_value) = each %params) {
416 next if ($cfg_key eq 'password');
418 do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
423 $main::lxdebug->leave_sub();
426 sub can_change_password {
429 return $self->{authenticator}->can_change_password();
432 sub change_password {
433 $main::lxdebug->enter_sub();
435 my ($self, $login, $new_password) = @_;
437 my $result = $self->{authenticator}->change_password($login, $new_password);
439 $main::lxdebug->leave_sub();
445 $main::lxdebug->enter_sub();
449 my $dbh = $self->dbconnect();
450 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
452 FROM auth."user" AS u
454 LEFT JOIN auth.user_config AS cfg
455 ON (cfg.user_id = u.id)
457 LEFT JOIN auth.session_content AS sc_login
458 ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
460 LEFT JOIN auth.session AS s
461 ON (s.id = sc_login.session_id)
463 my $sth = prepare_execute_query($main::form, $dbh, $query);
467 while (my $ref = $sth->fetchrow_hashref()) {
469 $users{$ref->{login}} ||= {
470 'login' => $ref->{login},
472 'last_action' => $ref->{last_action},
474 $users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
479 $main::lxdebug->leave_sub();
485 $main::lxdebug->enter_sub();
487 my ($self, %params) = @_;
489 my $dbh = $self->dbconnect();
491 my (@where, @values);
492 if ($params{login}) {
493 push @where, 'u.login = ?';
494 push @values, $params{login};
497 push @where, 'u.id = ?';
498 push @values, $params{id};
500 my $where = join ' AND ', '1 = 1', @where;
501 my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
502 FROM auth.user_config cfg
503 LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
505 my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
509 while (my $ref = $sth->fetchrow_hashref()) {
510 $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
511 @user_data{qw(id login)} = @{$ref}{qw(id login)};
514 # The XUL/XML & 'CSS new' backed menus have been removed.
515 my %menustyle_map = ( xml => 'new', v4 => 'v3' );
516 $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
518 # The 'Win2000.css' stylesheet has been removed.
519 $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
521 # Set default language if selected language does not exist (anymore).
522 $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
526 $main::lxdebug->leave_sub();
532 $main::lxdebug->enter_sub();
537 my $dbh = $self->dbconnect();
538 my ($id) = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
540 $main::lxdebug->leave_sub();
546 $::lxdebug->enter_sub;
551 my $dbh = $self->dbconnect;
552 my $id = $self->get_user_id($login);
555 $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
557 my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
558 $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
560 $u_dbh->begin_work if $u_dbh && $user_db_exists;
564 do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
565 do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
566 do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
567 do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
570 $u_dbh->commit if $u_dbh && $user_db_exists;
572 $::lxdebug->leave_sub;
575 # --------------------------------------
579 sub restore_session {
580 $main::lxdebug->enter_sub();
584 $session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
585 $session_id =~ s|[^0-9a-f]||g if $session_id;
587 $self->{SESSION} = { };
590 $main::lxdebug->leave_sub();
591 return $self->session_restore_result(SESSION_NONE());
594 my ($dbh, $query, $sth, $cookie, $ref, $form);
598 # Don't fail if the auth DB doesn't yet.
599 if (!( $dbh = $self->dbconnect(1) )) {
600 $::lxdebug->leave_sub;
601 return $self->session_restore_result(SESSION_NONE());
604 # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
605 # admin is creating the session tables at the moment.
606 $query = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
608 if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
609 $sth->finish if $sth;
610 $::lxdebug->leave_sub;
611 return $self->session_restore_result(SESSION_NONE());
614 $cookie = $sth->fetchrow_hashref;
617 # The session ID provided is valid in the following cases:
618 # 1. session ID exists in the database
619 # 2. hasn't expired yet
620 # 3. if form field '{AUTH}api_token' is given: form field must equal database column 'auth.session.api_token' for the session ID
621 # 4. if form field '{AUTH}api_token' is NOT given then: the requestee's IP address must match the stored IP address
622 $self->{api_token} = $cookie->{api_token} if $cookie;
623 my $api_token_cookie = $self->get_api_token_cookie;
624 my $cookie_is_bad = !$cookie || $cookie->{is_expired};
625 $cookie_is_bad ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
626 $cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} if !$api_token_cookie;
627 if ($cookie_is_bad) {
628 $self->destroy_session();
629 $main::lxdebug->leave_sub();
630 return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
633 if ($self->{column_information}->has('auto_restore')) {
634 $self->_load_with_auto_restore_column($dbh, $session_id);
636 $self->_load_without_auto_restore_column($dbh, $session_id);
639 $main::lxdebug->leave_sub();
641 return $self->session_restore_result(SESSION_OK());
644 sub session_restore_result {
647 $self->{session_restore_result} = $_[0];
649 return $self->{session_restore_result};
652 sub _load_without_auto_restore_column {
653 my ($self, $dbh, $session_id) = @_;
656 SELECT sess_key, sess_value
657 FROM auth.session_content
658 WHERE (session_id = ?)
660 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
662 while (my $ref = $sth->fetchrow_hashref) {
663 my $value = SL::Auth::SessionValue->new(auth => $self,
664 key => $ref->{sess_key},
665 value => $ref->{sess_value},
667 $self->{SESSION}->{ $ref->{sess_key} } = $value;
669 next if defined $::form->{$ref->{sess_key}};
671 my $data = $value->get;
672 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
676 sub _load_with_auto_restore_column {
677 my ($self, $dbh, $session_id) = @_;
679 my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
682 SELECT sess_key, sess_value, auto_restore
683 FROM auth.session_content
684 WHERE (session_id = ?)
686 OR sess_key IN (${auto_restore_keys}))
688 my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
690 while (my $ref = $sth->fetchrow_hashref) {
691 my $value = SL::Auth::SessionValue->new(auth => $self,
692 key => $ref->{sess_key},
693 value => $ref->{sess_value},
694 auto_restore => $ref->{auto_restore},
696 $self->{SESSION}->{ $ref->{sess_key} } = $value;
698 next if defined $::form->{$ref->{sess_key}};
700 my $data = $value->get;
701 $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
708 FROM auth.session_content
709 WHERE (session_id = ?)
710 AND NOT COALESCE(auto_restore, FALSE)
711 AND (sess_key NOT IN (${auto_restore_keys}))
713 $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
715 while (my $ref = $sth->fetchrow_hashref) {
716 my $value = SL::Auth::SessionValue->new(auth => $self,
717 key => $ref->{sess_key});
718 $self->{SESSION}->{ $ref->{sess_key} } = $value;
722 sub destroy_session {
723 $main::lxdebug->enter_sub();
728 my $dbh = $self->dbconnect();
732 do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
733 do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
737 SL::SessionFile->destroy_session($session_id);
740 $self->{SESSION} = { };
743 $main::lxdebug->leave_sub();
746 sub active_session_ids {
748 my $dbh = $self->dbconnect;
750 my $query = qq|SELECT id FROM auth.session|;
752 my @ids = selectall_array_query($::form, $dbh, $query);
757 sub expire_sessions {
758 $main::lxdebug->enter_sub();
762 $main::lxdebug->leave_sub and return if !$self->session_tables_present;
764 my $dbh = $self->dbconnect();
766 my $query = qq|SELECT id
768 WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
770 my @ids = selectall_array_query($::form, $dbh, $query);
775 SL::SessionFile->destroy_session($_) for @ids;
777 $query = qq|DELETE FROM auth.session_content
778 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
779 do_query($main::form, $dbh, $query, @ids);
781 $query = qq|DELETE FROM auth.session
782 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
783 do_query($main::form, $dbh, $query, @ids);
788 $main::lxdebug->leave_sub();
791 sub _create_session_id {
792 $main::lxdebug->enter_sub();
795 map { push @data, int(rand() * 255); } (1..32);
797 my $id = md5_hex(pack 'C*', @data);
799 $main::lxdebug->leave_sub();
804 sub create_or_refresh_session {
805 $session_id ||= shift->_create_session_id;
809 $::lxdebug->enter_sub;
811 my $provided_dbh = shift;
813 my $dbh = $provided_dbh || $self->dbconnect(1);
815 $::lxdebug->leave_sub && return unless $dbh && $session_id;
817 $dbh->begin_work unless $provided_dbh;
819 # If this fails then the "auth" schema might not exist yet, e.g. if
820 # the admin is just trying to create the auth database.
821 if (!$dbh->do(qq|LOCK auth.session_content|)) {
822 $dbh->rollback unless $provided_dbh;
823 $::lxdebug->leave_sub;
827 my @unfetched_keys = map { $_->{key} }
828 grep { ! $_->{fetched} }
829 values %{ $self->{SESSION} };
830 # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
831 # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
832 my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
833 $query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
835 do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
837 my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
840 do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
842 do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
845 if ($self->{column_information}->has('api_token', 'session')) {
846 my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
847 do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
850 my @values_to_save = grep { $_->{fetched} }
851 values %{ $self->{SESSION} };
852 if (@values_to_save) {
853 my ($columns, $placeholders) = ('', '');
854 my $auto_restore = $self->{column_information}->has('auto_restore');
857 $columns .= ', auto_restore';
858 $placeholders .= ', ?';
861 $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
862 my $sth = prepare_query($::form, $dbh, $query);
864 foreach my $value (@values_to_save) {
865 my @values = ($value->{key}, $value->get_dumped);
866 push @values, $value->{auto_restore} if $auto_restore;
868 do_statement($::form, $sth, $query, $session_id, @values);
874 $dbh->commit() unless $provided_dbh;
875 $::lxdebug->leave_sub;
878 sub set_session_value {
879 $main::lxdebug->enter_sub();
884 $self->{SESSION} ||= { };
887 my $key = shift @params;
889 if (ref $key eq 'HASH') {
890 $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
891 value => $key->{value},
892 auto_restore => $key->{auto_restore});
895 my $value = shift @params;
896 $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
901 $main::lxdebug->leave_sub();
906 sub delete_session_value {
907 $main::lxdebug->enter_sub();
911 $self->{SESSION} ||= { };
912 delete @{ $self->{SESSION} }{ @_ };
914 $main::lxdebug->leave_sub();
919 sub get_session_value {
920 $main::lxdebug->enter_sub();
923 my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
925 $main::lxdebug->leave_sub();
930 sub create_unique_sesion_value {
931 my ($self, $value, %params) = @_;
933 $self->{SESSION} ||= { };
935 my @now = gettimeofday();
936 my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
937 $self->{unique_counter} ||= 0;
941 $self->{unique_counter}++;
942 $hashed_key = md5_hex($key . $self->{unique_counter});
943 } while (exists $self->{SESSION}->{$hashed_key});
945 $self->set_session_value($hashed_key => $value);
950 sub save_form_in_session {
951 my ($self, %params) = @_;
953 my $form = delete($params{form}) || $::form;
954 my $non_scalars = delete $params{non_scalars};
957 my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
959 foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
960 $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
963 return $self->create_unique_sesion_value($data, %params);
966 sub restore_form_from_session {
967 my ($self, $key, %params) = @_;
969 my $data = $self->get_session_value($key);
970 return $self unless $data;
972 my $form = delete($params{form}) || $::form;
973 my $clobber = exists $params{clobber} ? $params{clobber} : 1;
975 map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
980 sub set_cookie_environment_variable {
982 $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
985 sub get_session_cookie_name {
986 my ($self, %params) = @_;
988 $params{type} ||= 'id';
989 my $name = $self->{cookie_name} || 'lx_office_erp_session_id';
990 $name .= '_api_token' if $params{type} eq 'api_token';
999 sub get_api_token_cookie {
1002 $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
1005 sub session_tables_present {
1006 $main::lxdebug->enter_sub();
1010 # Only re-check for the presence of auth tables if either the check
1011 # hasn't been done before of if they weren't present.
1012 if ($self->{session_tables_present}) {
1013 $main::lxdebug->leave_sub();
1014 return $self->{session_tables_present};
1017 my $dbh = $self->dbconnect(1);
1020 $main::lxdebug->leave_sub();
1027 WHERE (schemaname = 'auth')
1028 AND (tablename IN ('session', 'session_content'))|;
1030 my ($count) = selectrow_query($main::form, $dbh, $query);
1032 $self->{session_tables_present} = 2 == $count;
1034 $main::lxdebug->leave_sub();
1036 return $self->{session_tables_present};
1039 # --------------------------------------
1041 sub all_rights_full {
1042 my $locale = $main::locale;
1045 ["--crm", $locale->text("CRM optional software")],
1046 ["crm_search", $locale->text("CRM search")],
1047 ["crm_new", $locale->text("CRM create customers, vendors and contacts")],
1048 ["crm_service", $locale->text("CRM services")],
1049 ["crm_admin", $locale->text("CRM admin")],
1050 ["crm_adminuser", $locale->text("CRM user")],
1051 ["crm_adminstatus", $locale->text("CRM status")],
1052 ["crm_email", $locale->text("CRM send email")],
1053 ["crm_termin", $locale->text("CRM termin")],
1054 ["crm_opportunity", $locale->text("CRM opportunity")],
1055 ["crm_knowhow", $locale->text("CRM know how")],
1056 ["crm_follow", $locale->text("CRM follow up")],
1057 ["crm_notices", $locale->text("CRM notices")],
1058 ["crm_other", $locale->text("CRM other")],
1059 ["--master_data", $locale->text("Master Data")],
1060 ["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
1061 ["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
1062 ["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
1063 ["project_edit", $locale->text("Create and edit projects")],
1064 ["--ar", $locale->text("AR")],
1065 ["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
1066 ["sales_order_edit", $locale->text("Create and edit sales orders")],
1067 ["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
1068 ["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
1069 ["dunning_edit", $locale->text("Create and edit dunnings")],
1070 ["sales_all_edit", $locale->text("View/edit all employees sales documents")],
1071 ["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
1072 ["--ap", $locale->text("AP")],
1073 ["request_quotation_edit", $locale->text("Create and edit RFQs")],
1074 ["purchase_order_edit", $locale->text("Create and edit purchase orders")],
1075 ["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
1076 ["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
1077 ["--warehouse_management", $locale->text("Warehouse management")],
1078 ["warehouse_contents", $locale->text("View warehouse content")],
1079 ["warehouse_management", $locale->text("Warehouse management")],
1080 ["--general_ledger_cash", $locale->text("General ledger and cash")],
1081 ["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
1082 ["datev_export", $locale->text("DATEV Export")],
1083 ["cash", $locale->text("Receipt, payment, reconciliation")],
1084 ["--reports", $locale->text('Reports')],
1085 ["report", $locale->text('All reports')],
1086 ["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
1087 ["--batch_printing", $locale->text("Batch Printing")],
1088 ["batch_printing", $locale->text("Batch Printing")],
1089 ["--others", $locale->text("Others")],
1090 ["email_bcc", $locale->text("May set the BCC field when sending emails")],
1091 ["config", $locale->text("Change kivitendo installation settings (all menu entries beneath 'System')")],
1092 ["admin", $locale->text("Administration (Used to access instance administration from user logins)")],
1093 ["productivity", $locale->text("Productivity")],
1094 ["display_admin_link", $locale->text("Show administration link")],
1101 return grep !/^--/, map { $_->[0] } all_rights_full();
1105 $main::lxdebug->enter_sub();
1109 my $form = $main::form;
1111 my $dbh = $self->dbconnect();
1113 my $query = 'SELECT * FROM auth."group"';
1114 my $sth = prepare_execute_query($form, $dbh, $query);
1118 while ($row = $sth->fetchrow_hashref()) {
1119 $groups->{$row->{id}} = $row;
1123 $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1124 $sth = prepare_query($form, $dbh, $query);
1126 foreach $group (values %{$groups}) {
1129 do_statement($form, $sth, $query, $group->{id});
1131 while ($row = $sth->fetchrow_hashref()) {
1132 push @members, $row->{user_id};
1134 $group->{members} = [ uniq @members ];
1138 $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1139 $sth = prepare_query($form, $dbh, $query);
1141 foreach $group (values %{$groups}) {
1142 $group->{rights} = {};
1144 do_statement($form, $sth, $query, $group->{id});
1146 while ($row = $sth->fetchrow_hashref()) {
1147 $group->{rights}->{$row->{right}} |= $row->{granted};
1150 map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1154 $main::lxdebug->leave_sub();
1160 $main::lxdebug->enter_sub();
1165 my $form = $main::form;
1166 my $dbh = $self->dbconnect();
1170 my ($query, $sth, $row, $rights);
1172 if (!$group->{id}) {
1173 ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1175 $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1176 do_query($form, $dbh, $query, $group->{id});
1179 do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1181 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1183 $query = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1184 $sth = prepare_query($form, $dbh, $query);
1186 foreach my $user_id (uniq @{ $group->{members} }) {
1187 do_statement($form, $sth, $query, $user_id, $group->{id});
1191 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1193 $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1194 $sth = prepare_query($form, $dbh, $query);
1196 foreach my $right (keys %{ $group->{rights} }) {
1197 do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1203 $main::lxdebug->leave_sub();
1207 $main::lxdebug->enter_sub();
1212 my $form = $main::form;
1214 my $dbh = $self->dbconnect();
1217 do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1218 do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1219 do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1223 $main::lxdebug->leave_sub();
1226 sub evaluate_rights_ary {
1227 $main::lxdebug->enter_sub(2);
1234 foreach my $el (@{$ary}) {
1235 if (ref $el eq "ARRAY") {
1236 if ($action eq '|') {
1237 $value |= evaluate_rights_ary($el);
1239 $value &= evaluate_rights_ary($el);
1242 } elsif (($el eq '&') || ($el eq '|')) {
1245 } elsif ($action eq '|') {
1254 $main::lxdebug->leave_sub(2);
1259 sub _parse_rights_string {
1260 $main::lxdebug->enter_sub(2);
1270 push @stack, $cur_ary;
1272 while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1274 substr($access, 0, length $1) = "";
1276 next if ($token =~ /\s/);
1278 if ($token eq "(") {
1279 my $new_cur_ary = [];
1280 push @stack, $new_cur_ary;
1281 push @{$cur_ary}, $new_cur_ary;
1282 $cur_ary = $new_cur_ary;
1284 } elsif ($token eq ")") {
1288 $main::lxdebug->leave_sub(2);
1292 $cur_ary = $stack[-1];
1294 } elsif (($token eq "|") || ($token eq "&")) {
1295 push @{$cur_ary}, $token;
1298 push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1302 my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1304 $main::lxdebug->leave_sub(2);
1310 $main::lxdebug->enter_sub(2);
1315 my $default = shift;
1317 $self->{FULL_RIGHTS} ||= { };
1318 $self->{FULL_RIGHTS}->{$login} ||= { };
1320 if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1321 $self->{RIGHTS} ||= { };
1322 $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1324 $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1327 my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1328 $granted = $default if (!defined $granted);
1330 $main::lxdebug->leave_sub(2);
1336 $::lxdebug->enter_sub(2);
1337 my ($self, $right, $dont_abort) = @_;
1339 if ($self->check_right($::myconfig{login}, $right)) {
1340 $::lxdebug->leave_sub(2);
1345 delete $::form->{title};
1346 $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1349 $::lxdebug->leave_sub(2);
1354 sub load_rights_for_user {
1355 $::lxdebug->enter_sub;
1357 my ($self, $login) = @_;
1358 my $dbh = $self->dbconnect;
1359 my ($query, $sth, $row, $rights);
1361 $rights = { map { $_ => 0 } all_rights() };
1364 qq|SELECT gr."right", gr.granted
1365 FROM auth.group_rights gr
1368 FROM auth.user_group ug
1369 LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1370 WHERE u.login = ?)|;
1372 $sth = prepare_execute_query($::form, $dbh, $query, $login);
1374 while ($row = $sth->fetchrow_hashref()) {
1375 $rights->{$row->{right}} |= $row->{granted};
1379 $::lxdebug->leave_sub;
1393 SL::Auth - Authentication and session handling
1399 =item C<set_session_value @values>
1401 =item C<set_session_value %values>
1403 Store all values of C<@values> or C<%values> in the session. Each
1404 member of C<@values> is tested if it is a hash reference. If it is
1405 then it must contain the keys C<key> and C<value> and can optionally
1406 contain the key C<auto_restore>. In this case C<value> is associated
1407 with C<key> and restored to C<$::form> upon the next request
1408 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1411 If the current member of C<@values> is not a hash reference then it
1412 will be used as the C<key> and the next entry of C<@values> is used as
1413 the C<value> to store. In this case setting C<auto_restore> is not
1416 Therefore the following two invocations are identical:
1418 $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1419 $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1421 All of these values are copied back into C<$::form> for the next
1422 request automatically if they're scalar values or if they have
1423 C<auto_restore> set to trueish.
1425 The values can be any Perl structure. They are stored as YAML dumps.
1427 =item C<get_session_value $key>
1429 Retrieve a value from the session. Returns C<undef> if the value
1432 =item C<create_unique_sesion_value $value, %params>
1434 Create a unique key in the session and store C<$value>
1437 Returns the key created in the session.
1439 =item C<save_session>
1441 Stores the session values in the database. This is the only function
1442 that actually stores stuff in the database. Neither the various
1443 setters nor the deleter access the database.
1445 =item <save_form_in_session %params>
1447 Stores the content of C<$params{form}> (default: C<$::form>) in the
1448 session using L</create_unique_sesion_value>.
1450 If C<$params{non_scalars}> is trueish then non-scalar values will be
1451 stored as well. Default is to only store scalar values.
1453 The following keys will never be saved: C<login>, C<password>,
1454 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1455 can be given as an array ref in C<$params{skip_keys}>.
1457 Returns the unique key under which the form is stored.
1459 =item <restore_form_from_session $key, %params>
1461 Restores the form from the session into C<$params{form}> (default:
1464 If C<$params{clobber}> is falsish then existing values with the same
1465 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1478 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>