/SL/Auth.pm - Annotieren - projekt kivitendo - wissen

| Zweig: | Markierung: | Revision:

kivitendo/SL/Auth.pm @ 4d015385

8c7e4493	Moritz Bunkus	package SL::Auth;

5d23fb60	Sven Schöling	use DBI;
8c7e4493	Moritz Bunkus
		use Digest::MD5 qw(md5_hex);
		use IO::File;
		use Time::HiRes qw(gettimeofday);
5c0c9e67	Sven Schöling	use List::MoreUtils qw(uniq);
8fdebd9c	Moritz Bunkus	use YAML;
c2f401aa	Sven Schöling	use Regexp::IPv6 qw($IPv6_re);
8c7e4493	Moritz Bunkus
e0ba33ff	Moritz Bunkus	use SL::Auth::ColumnInformation;
5d23fb60	Sven Schöling	use SL::Auth::Constants qw(:all);
8c7e4493	Moritz Bunkus	use SL::Auth::DB;
		use SL::Auth::LDAP;
d0c2cfbe	Moritz Bunkus	use SL::Auth::Password;
e0ba33ff	Moritz Bunkus	use SL::Auth::SessionValue;
8c7e4493	Moritz Bunkus
4344f4e3	Moritz Bunkus	use SL::SessionFile;
8c7e4493	Moritz Bunkus	use SL::User;
22c02125	Moritz Bunkus	use SL::DBConnect;
d89811fc	Moritz Bunkus	use SL::DBUpgrade2;
9b294bec	Sven Schöling	use SL::DBUtils qw(do_query do_statement prepare_execute_query prepare_query selectall_array_query selectrow_query selectall_ids);
8c7e4493	Moritz Bunkus
76c486e3	Sven Schöling	use strict;

eb8ba476	Sven Schöling	use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
		use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';

3e29b95e	Moritz Bunkus	use Rose::Object::MakeMethods::Generic (
		scalar => [ qw(client) ],
		);


8c7e4493	Moritz Bunkus	sub new {
94d3a3e9	Moritz Bunkus	my ($type, %params) = @_;
		my $self = bless {}, $type;
8c7e4493	Moritz Bunkus
94d3a3e9	Moritz Bunkus	$self->_read_auth_config(%params);
40f16528	Sven Schöling	$self->init;
8c7e4493	Moritz Bunkus
		return $self;
		}

40f16528	Sven Schöling	sub init {
		my ($self, %params) = @_;

		$self->{SESSION} = { };
		$self->{FULL_RIGHTS} = { };
		$self->{RIGHTS} = { };
		$self->{unique_counter} = 0;
		$self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
		}

a0945527	Sven Schöling	sub reset {
		my ($self, %params) = @_;

7ee061a6	Moritz Bunkus	$self->{SESSION} = { };
		$self->{FULL_RIGHTS} = { };
		$self->{RIGHTS} = { };
		$self->{unique_counter} = 0;
e476a9df	Moritz Bunkus
		if ($self->is_db_connected) {
		# reset is called during request shutdown already. In case of a
		# completely new auth DB this would fail and generate an error
		# message even if the user is currently trying to create said auth
		# DB. Therefore only fetch the column information if a connection
		# has been established.
		$self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
		$self->{column_information}->_fetch;
		} else {
		delete $self->{column_information};
		}

72887d24	Sven Schöling	$self->{authenticator}->reset;
3e29b95e	Moritz Bunkus
		$self->client(undef);
		}

		sub set_client {
		my ($self, $id_or_name) = @_;

		$self->client(undef);

722fee3c	Moritz Bunkus	return undef unless $id_or_name;

3e29b95e	Moritz Bunkus	my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
		my $dbh = $self->dbconnect;

		return undef unless $dbh;

		$self->client($dbh->selectrow_hashref(qq\|SELECT * FROM auth.clients WHERE ${column} = ?\|, undef, $id_or_name));

		return $self->client;
a0945527	Sven Schöling	}

4543999a	Moritz Bunkus	sub get_default_client_id {
		my ($self) = @_;

		my $dbh = $self->dbconnect;

		return unless $dbh;

		my $row = $dbh->selectrow_hashref(qq\|SELECT id FROM auth.clients WHERE is_default = TRUE LIMIT 1\|);

		return $row->{id} if $row;
		}

8c7e4493	Moritz Bunkus	sub DESTROY {
		my $self = shift;

		$self->{dbh}->disconnect() if ($self->{dbh});
		}

e46c6825	Sven Schöling	# form isn't loaded yet, so auth needs it's own error.
		sub mini_error {
		$::lxdebug->show_backtrace();

		my ($self, @msg) = @_;
		if ($ENV{HTTP_USER_AGENT}) {
4d015385	Moritz Bunkus	# $::form might not be initialized yet at this point — therefore
		# we cannot use "create_http_response" yet.
		my $cgi = CGI->new('');
		print $cgi->header('-type' => 'text/html', '-charset' => 'UTF-8');
e46c6825	Sven Schöling	print "<pre>", join ('<br>', @msg), "</pre>";
		} else {
		print STDERR "Error: @msg\n";
		}
09479f02	Moritz Bunkus	$::dispatcher->end_request;
e46c6825	Sven Schöling	}

8c7e4493	Moritz Bunkus	sub _read_auth_config {
94d3a3e9	Moritz Bunkus	my ($self, %params) = @_;
8c7e4493	Moritz Bunkus
dfa7a3a9	Moritz Bunkus	map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
6bce748c	Moritz Bunkus
		# Prevent password leakage to log files when dumping Auth instances.
		$self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };

94d3a3e9	Moritz Bunkus	if ($params{unit_tests_database}) {
		$self->{DB_config} = $::lx_office_conf{'testing/database'};
		$self->{module} = 'DB';

		} else {
		$self->{DB_config} = $::lx_office_conf{'authentication/database'};
		}
8c7e4493	Moritz Bunkus
		if ($self->{module} eq 'DB') {
		$self->{authenticator} = SL::Auth::DB->new($self);

		} elsif ($self->{module} eq 'LDAP') {
211f4e60	Moritz Bunkus	$self->{authenticator} = SL::Auth::LDAP->new($::lx_office_conf{'authentication/ldap'});
8c7e4493	Moritz Bunkus	}

		if (!$self->{authenticator}) {
e46c6825	Sven Schöling	my $locale = Locale->new('en');
4bacfb02	Moritz Bunkus	$self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
8c7e4493	Moritz Bunkus	}

		my $cfg = $self->{DB_config};

		if (!$cfg) {
e46c6825	Sven Schöling	my $locale = Locale->new('en');
4bacfb02	Moritz Bunkus	$self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
8c7e4493	Moritz Bunkus	}

		if (!$cfg->{host} \|\| !$cfg->{db} \|\| !$cfg->{user}) {
e46c6825	Sven Schöling	my $locale = Locale->new('en');
4bacfb02	Moritz Bunkus	$self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
8c7e4493	Moritz Bunkus	}

		$self->{authenticator}->verify_config();

5d275ec4	Moritz Bunkus	$self->{session_timeout} *= 1;
		$self->{session_timeout} = 8 * 60 if (!$self->{session_timeout});
8c7e4493	Moritz Bunkus	}

722fee3c	Moritz Bunkus	sub has_access_to_client {
		my ($self, $login) = @_;

		return 0 if !$self->client \|\| !$self->client->{id};

		my $sql = <<SQL;
		SELECT cu.client_id
		FROM auth.clients_users cu
		LEFT JOIN auth."user" u ON (cu.user_id = u.id)
		WHERE (u.login = ?)
		AND (cu.client_id = ?)
		SQL

		my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
		return $has_access;
		}

8c7e4493	Moritz Bunkus	sub authenticate_root {
38a4efa7	Moritz Bunkus	my ($self, $password) = @_;
8c7e4493	Moritz Bunkus
540c0b5e	Moritz Bunkus	my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
eb8ba476	Sven Schöling	if (defined $session_root_auth && $session_root_auth == OK) {
		return OK;
		}

		if (!defined $password) {
		return ERR_PASSWORD;
		}

6bce748c	Moritz Bunkus	my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
c157c911	Moritz Bunkus	$password = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
8c7e4493	Moritz Bunkus
eb8ba476	Sven Schöling	my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
540c0b5e	Moritz Bunkus	$self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
8c7e4493	Moritz Bunkus
eb8ba476	Sven Schöling	return $result;
8c7e4493	Moritz Bunkus	}

		sub authenticate {
686cba23	Moritz Bunkus	my ($self, $login, $password) = @_;
8c7e4493	Moritz Bunkus
722fee3c	Moritz Bunkus	if (!$self->client \|\| !$self->has_access_to_client($login)) {
		return ERR_PASSWORD;
		}

540c0b5e	Moritz Bunkus	my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
eb8ba476	Sven Schöling	if (defined $session_auth && $session_auth == OK) {
		return OK;
		}
d0c2cfbe	Moritz Bunkus
eb8ba476	Sven Schöling	if (!defined $password) {
		return ERR_PASSWORD;
d3d6cb31	Moritz Bunkus	}
d0c2cfbe	Moritz Bunkus
eb8ba476	Sven Schöling	my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
722fee3c	Moritz Bunkus	$self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
eb8ba476	Sven Schöling	return $result;
38a4efa7	Moritz Bunkus	}

540c0b5e	Moritz Bunkus	sub punish_wrong_login {
5289cdd7	Moritz Bunkus	my $failed_login_penalty = ($::lx_office_conf{authentication} \|\| {})->{failed_login_penalty};
		sleep $failed_login_penalty if $failed_login_penalty;
540c0b5e	Moritz Bunkus	}

d3d6cb31	Moritz Bunkus	sub get_stored_password {
		my ($self, $login) = @_;

		my $dbh = $self->dbconnect;

		return undef unless $dbh;

		my $query = qq\|SELECT password FROM auth."user" WHERE login = ?\|;
		my ($stored_password) = $dbh->selectrow_array($query, undef, $login);

		return $stored_password;
		}

8c7e4493	Moritz Bunkus	sub dbconnect {
		my $self = shift;
		my $may_fail = shift;

		if ($self->{dbh}) {
		return $self->{dbh};
		}

		my $cfg = $self->{DB_config};
		my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};

		if ($cfg->{port}) {
		$dsn .= ';port=' . $cfg->{port};
		}

76c486e3	Sven Schöling	$main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
8c7e4493	Moritz Bunkus
dbda14c2	Moritz Bunkus	$self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
8c7e4493	Moritz Bunkus
		if (!$may_fail && !$self->{dbh}) {
e476a9df	Moritz Bunkus	delete $self->{dbh};
8c7e4493	Moritz Bunkus	$main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
		}

		return $self->{dbh};
		}

		sub dbdisconnect {
		my $self = shift;

		if ($self->{dbh}) {
		$self->{dbh}->disconnect();
		delete $self->{dbh};
		}
		}

e476a9df	Moritz Bunkus	sub is_db_connected {
		my ($self) = @_;
		return !!$self->{dbh};
		}

8c7e4493	Moritz Bunkus	sub check_tables {
4531a6c7	Sven Schöling	my ($self, $dbh) = @_;
8c7e4493	Moritz Bunkus
4531a6c7	Sven Schöling	$dbh \|\|= $self->dbconnect();
8c7e4493	Moritz Bunkus	my $query = qq\|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')\|;

		my ($count) = $dbh->selectrow_array($query);

		return $count > 0;
		}

		sub check_database {
		my $self = shift;

		my $dbh = $self->dbconnect(1);

		return $dbh ? 1 : 0;
		}

		sub create_database {
		my $self = shift;
		my %params = @_;

		my $cfg = $self->{DB_config};

		if (!$params{superuser}) {
		$params{superuser} = $cfg->{user};
		$params{superuser_password} = $cfg->{password};
		}

		$params{template} \|\|= 'template0';
		$params{template} =~ s\|[^a-zA-Z0-9_\-]\|\|g;

		my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};

		if ($cfg->{port}) {
		$dsn .= ';port=' . $cfg->{port};
		}

76c486e3	Sven Schöling	$main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
8c7e4493	Moritz Bunkus
dbda14c2	Moritz Bunkus	my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
7b13e2ea	Moritz Bunkus
		if (!$dbh) {
		$main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
		}

dbda14c2	Moritz Bunkus	my $query = qq\|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'\|;
8c7e4493	Moritz Bunkus
76c486e3	Sven Schöling	$main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
8c7e4493	Moritz Bunkus
		$dbh->do($query);

		if ($dbh->err) {
c87608ab	Moritz Bunkus	my $error = $dbh->errstr();

		$query = qq\|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'\|;
		my ($cluster_encoding) = $dbh->selectrow_array($query);

dbda14c2	Moritz Bunkus	if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8\|UNICODE)$/i)) {
		$error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
c87608ab	Moritz Bunkus	}

8c7e4493	Moritz Bunkus	$dbh->disconnect();

c87608ab	Moritz Bunkus	$main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
8c7e4493	Moritz Bunkus	}

		$dbh->disconnect();
		}

		sub create_tables {
		my $self = shift;
		my $dbh = $self->dbconnect();

		$dbh->rollback();
dbda14c2	Moritz Bunkus	SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
8c7e4493	Moritz Bunkus	}

		sub save_user {
		my $self = shift;
		my $login = shift;
		my %params = @_;

		my $form = $main::form;

		my $dbh = $self->dbconnect();

		my ($sth, $query, $user_id);

0c32dd23	Moritz Bunkus	$dbh->begin_work;

8c7e4493	Moritz Bunkus	$query = qq\|SELECT id FROM auth."user" WHERE login = ?\|;
		($user_id) = selectrow_query($form, $dbh, $query, $login);

		if (!$user_id) {
		$query = qq\|SELECT nextval('auth.user_id_seq')\|;
		($user_id) = selectrow_query($form, $dbh, $query);

		$query = qq\|INSERT INTO auth."user" (id, login) VALUES (?, ?)\|;
		do_query($form, $dbh, $query, $user_id, $login);
		}

		$query = qq\|DELETE FROM auth.user_config WHERE (user_id = ?)\|;
		do_query($form, $dbh, $query, $user_id);

		$query = qq\|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)\|;
		$sth = prepare_query($form, $dbh, $query);

		while (my ($cfg_key, $cfg_value) = each %params) {
		next if ($cfg_key eq 'password');

		do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
		}

		$dbh->commit();
		}

		sub can_change_password {
		my $self = shift;

		return $self->{authenticator}->can_change_password();
		}

		sub change_password {
8ed92861	Moritz Bunkus	my ($self, $login, $new_password) = @_;

		my $result = $self->{authenticator}->change_password($login, $new_password);

8c7e4493	Moritz Bunkus	return $result;
		}

		sub read_all_users {
		my $self = shift;

		my $dbh = $self->dbconnect();
02118682	Thomas Heck	my $query = qq\|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action

		FROM auth."user" AS u

		LEFT JOIN auth.user_config AS cfg
		ON (cfg.user_id = u.id)

		LEFT JOIN auth.session_content AS sc_login
		ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \\|\\| u.login \\|\\| '\n'))

		LEFT JOIN auth.session AS s
		ON (s.id = sc_login.session_id)
		\|;
8c7e4493	Moritz Bunkus	my $sth = prepare_execute_query($main::form, $dbh, $query);

		my %users;

		while (my $ref = $sth->fetchrow_hashref()) {
02118682	Thomas Heck
		$users{$ref->{login}} \|\|= {
		'login' => $ref->{login},
		'id' => $ref->{id},
		'last_action' => $ref->{last_action},
		};
0e6ac5bb	Sven Schöling	$users{$ref->{login}}->{$ref->{cfg_key}} = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
8c7e4493	Moritz Bunkus	}

		$sth->finish();

		return %users;
		}

		sub read_user {
4531a6c7	Sven Schöling	my ($self, %params) = @_;
8c7e4493	Moritz Bunkus
		my $dbh = $self->dbconnect();
4531a6c7	Sven Schöling
		my (@where, @values);
		if ($params{login}) {
		push @where, 'u.login = ?';
		push @values, $params{login};
		}
		if ($params{id}) {
		push @where, 'u.id = ?';
		push @values, $params{id};
		}
		my $where = join ' AND ', '1 = 1', @where;
99b28796	Moritz Bunkus	my $query = qq\|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
8c7e4493	Moritz Bunkus	FROM auth.user_config cfg
		LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
4531a6c7	Sven Schöling	WHERE $where\|;
		my $sth = prepare_execute_query($main::form, $dbh, $query, @values);
8c7e4493	Moritz Bunkus
		my %user_data;

		while (my $ref = $sth->fetchrow_hashref()) {
		$user_data{$ref->{cfg_key}} = $ref->{cfg_value};
94beb18a	Moritz Bunkus	@user_data{qw(id login)} = @{$ref}{qw(id login)};
8c7e4493	Moritz Bunkus	}

871a70f0	Moritz Bunkus	# The XUL/XML & 'CSS new' backed menus have been removed.
		my %menustyle_map = ( xml => 'new', v4 => 'v3' );
		$user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} \|\| '')} \|\| $user_data{menustyle};
adf1b8cb	Moritz Bunkus
56ed2f99	Moritz Bunkus	# The 'Win2000.css' stylesheet has been removed.
		$user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} \|\| '') =~ m/win2000/i;

d8ad641c	Moritz Bunkus	# Set default language if selected language does not exist (anymore).
		$user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";

8c7e4493	Moritz Bunkus	$sth->finish();

		return %user_data;
		}

		sub get_user_id {
		my $self = shift;
		my $login = shift;

		my $dbh = $self->dbconnect();
		my ($id) = selectrow_query($main::form, $dbh, qq\|SELECT id FROM auth."user" WHERE login = ?\|, $login);

		return $id;
		}

		sub delete_user {
		my $self = shift;
		my $login = shift;

f3f0322b	Sven Schöling	my $dbh = $self->dbconnect;
4531a6c7	Sven Schöling	my $id = $self->get_user_id($login);
0c32dd23	Moritz Bunkus
7ed4b336	Moritz Bunkus	if (!$id) {
		$dbh->rollback;
		return;
		}
0c32dd23	Moritz Bunkus
4531a6c7	Sven Schöling	$dbh->begin_work;
8c7e4493	Moritz Bunkus
f3f0322b	Sven Schöling	do_query($::form, $dbh, qq\|DELETE FROM auth.user_group WHERE user_id = ?\|, $id);
		do_query($::form, $dbh, qq\|DELETE FROM auth.user_config WHERE user_id = ?\|, $id);
4531a6c7	Sven Schöling	do_query($::form, $dbh, qq\|DELETE FROM auth.user WHERE id = ?\|, $id);
722fee3c	Moritz Bunkus
		# TODO: SL::Auth::delete_user
		# do_query($::form, $u_dbh, qq\|UPDATE employee SET deleted = 't' WHERE login = ?\|, $login) if $u_dbh && $user_db_exists;
8c7e4493	Moritz Bunkus
02bec6bd	Sven Schöling	$dbh->commit;
8c7e4493	Moritz Bunkus	}

		# --------------------------------------

		my $session_id;

		sub restore_session {
		my $self = shift;

5494f687	Sven Schöling	$session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
9b9ed1dd	Sven Schöling	$session_id =~ s\|[^0-9a-f]\|\|g if $session_id;
8c7e4493	Moritz Bunkus
		$self->{SESSION} = { };

33c1a7f1	Moritz Bunkus	if (!$session_id) {
d8ac0828	Moritz Bunkus	return $self->session_restore_result(SESSION_NONE());
33c1a7f1	Moritz Bunkus	}
8c7e4493	Moritz Bunkus
		my ($dbh, $query, $sth, $cookie, $ref, $form);

		$form = $main::form;

be096dae	Geoffrey Richardson	# Don't fail if the auth DB doesn't exist yet.
92800129	Moritz Bunkus	if (!( $dbh = $self->dbconnect(1) )) {
d8ac0828	Moritz Bunkus	return $self->session_restore_result(SESSION_NONE());
92800129	Moritz Bunkus	}

		# Don't fail if the "auth" schema doesn't exist yet, e.g. if the
		# admin is creating the session tables at the moment.
5d275ec4	Moritz Bunkus	$query = qq\|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?\|;
8c7e4493	Moritz Bunkus
92800129	Moritz Bunkus	if (!($sth = $dbh->prepare($query)) \|\| !$sth->execute($session_id)) {
		$sth->finish if $sth;
d8ac0828	Moritz Bunkus	return $self->session_restore_result(SESSION_NONE());
92800129	Moritz Bunkus	}

		$cookie = $sth->fetchrow_hashref;
		$sth->finish;
8c7e4493	Moritz Bunkus
6c21fd13	Moritz Bunkus	# The session ID provided is valid in the following cases:
		# 1. session ID exists in the database
		# 2. hasn't expired yet
77fda875	Moritz Bunkus	# 3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
6c21fd13	Moritz Bunkus	$self->{api_token} = $cookie->{api_token} if $cookie;
		my $api_token_cookie = $self->get_api_token_cookie;
		my $cookie_is_bad = !$cookie \|\| $cookie->{is_expired};
		$cookie_is_bad \|\|= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if $api_token_cookie;
		if ($cookie_is_bad) {
8c7e4493	Moritz Bunkus	$self->destroy_session();
d8ac0828	Moritz Bunkus	return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
8c7e4493	Moritz Bunkus	}

e0ba33ff	Moritz Bunkus	if ($self->{column_information}->has('auto_restore')) {
		$self->_load_with_auto_restore_column($dbh, $session_id);
		} else {
		$self->_load_without_auto_restore_column($dbh, $session_id);
8c7e4493	Moritz Bunkus	}

d8ac0828	Moritz Bunkus	return $self->session_restore_result(SESSION_OK());
		}

		sub session_restore_result {
		my $self = shift;
		if (@_) {
		$self->{session_restore_result} = $_[0];
		}
		return $self->{session_restore_result};
8c7e4493	Moritz Bunkus	}

e0ba33ff	Moritz Bunkus	sub _load_without_auto_restore_column {
		my ($self, $dbh, $session_id) = @_;
c90b4dcd	Moritz Bunkus
e0ba33ff	Moritz Bunkus	my $query = <<SQL;
		SELECT sess_key, sess_value
		FROM auth.session_content
		WHERE (session_id = ?)
		SQL
		my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
8fdebd9c	Moritz Bunkus
e0ba33ff	Moritz Bunkus	while (my $ref = $sth->fetchrow_hashref) {
		my $value = SL::Auth::SessionValue->new(auth => $self,
		key => $ref->{sess_key},
		value => $ref->{sess_value},
		raw => 1);
		$self->{SESSION}->{ $ref->{sess_key} } = $value;
c90b4dcd	Moritz Bunkus
e0ba33ff	Moritz Bunkus	next if defined $::form->{$ref->{sess_key}};
c90b4dcd	Moritz Bunkus
e0ba33ff	Moritz Bunkus	my $data = $value->get;
		$::form->{$ref->{sess_key}} = $data if $value->{auto_restore} \|\| !ref $data;
		}
		}

		sub _load_with_auto_restore_column {
		my ($self, $dbh, $session_id) = @_;

81a9ce9b	Sven Schöling	my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
e0ba33ff	Moritz Bunkus
		my $query = <<SQL;
		SELECT sess_key, sess_value, auto_restore
		FROM auth.session_content
109b7f30	Moritz Bunkus	WHERE (session_id = ?) AND (auto_restore OR sess_key IN (@{[ join ',', ("?") x keys %auto_restore_keys ]}))
e0ba33ff	Moritz Bunkus	SQL
9b294bec	Sven Schöling	my $sth = prepare_execute_query($::form, $dbh, $query, $session_id, keys %auto_restore_keys);
e0ba33ff	Moritz Bunkus
9b294bec	Sven Schöling	my $need_delete;
e0ba33ff	Moritz Bunkus	while (my $ref = $sth->fetchrow_hashref) {
9b294bec	Sven Schöling	$need_delete = 1 if $ref->{auto_restore};
		my $value = SL::Auth::SessionValue->new(auth => $self,
		key => $ref->{sess_key},
		value => $ref->{sess_value},
		auto_restore => $ref->{auto_restore},
		raw => 1);
		$self->{SESSION}->{ $ref->{sess_key} } = $value;

		next if defined $::form->{$ref->{sess_key}};

		my $data = $value->get;
		$::form->{$ref->{sess_key}} = $data if $value->{auto_restore} \|\| !ref $data;
e0ba33ff	Moritz Bunkus	}

		$sth->finish;
9b294bec	Sven Schöling
		if ($need_delete) {
		do_query($::form, $dbh, 'DELETE FROM auth.session_content WHERE auto_restore AND session_id = ?', $session_id);
		}
8fdebd9c	Moritz Bunkus	}

8c7e4493	Moritz Bunkus	sub destroy_session {
		my $self = shift;

		if ($session_id) {
		my $dbh = $self->dbconnect();

0c32dd23	Moritz Bunkus	$dbh->begin_work;

8c7e4493	Moritz Bunkus	do_query($main::form, $dbh, qq\|DELETE FROM auth.session_content WHERE session_id = ?\|, $session_id);
		do_query($main::form, $dbh, qq\|DELETE FROM auth.session WHERE id = ?\|, $session_id);

		$dbh->commit();

4344f4e3	Moritz Bunkus	SL::SessionFile->destroy_session($session_id);

8c7e4493	Moritz Bunkus	$session_id = undef;
		$self->{SESSION} = { };
		}
		}

d001c791	Sven Schöling	sub active_session_ids {
		my $self = shift;
		my $dbh = $self->dbconnect;

		my $query = qq\|SELECT id FROM auth.session\|;

		my @ids = selectall_array_query($::form, $dbh, $query);

		return @ids;
		}

8c7e4493	Moritz Bunkus	sub expire_sessions {
		my $self = shift;

7ed4b336	Moritz Bunkus	return if !$self->session_tables_present;
9b327aff	Moritz Bunkus
8c7e4493	Moritz Bunkus	my $dbh = $self->dbconnect();
0c32dd23	Moritz Bunkus
4344f4e3	Moritz Bunkus	my $query = qq\|SELECT id
		FROM auth.session
		WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))\|;
0c32dd23	Moritz Bunkus
4344f4e3	Moritz Bunkus	my @ids = selectall_array_query($::form, $dbh, $query);
8c7e4493	Moritz Bunkus
4344f4e3	Moritz Bunkus	if (@ids) {
		$dbh->begin_work;
8c7e4493	Moritz Bunkus
4344f4e3	Moritz Bunkus	SL::SessionFile->destroy_session($_) for @ids;
8c7e4493	Moritz Bunkus
4344f4e3	Moritz Bunkus	$query = qq\|DELETE FROM auth.session_content
		WHERE session_id IN (\| . join(', ', ('?') x scalar(@ids)) . qq\|)\|;
		do_query($main::form, $dbh, $query, @ids);
8c7e4493	Moritz Bunkus
4344f4e3	Moritz Bunkus	$query = qq\|DELETE FROM auth.session
		WHERE id IN (\| . join(', ', ('?') x scalar(@ids)) . qq\|)\|;
		do_query($main::form, $dbh, $query, @ids);

		$dbh->commit();
		}
8c7e4493	Moritz Bunkus	}

		sub _create_session_id {
		my @data;
		map { push @data, int(rand() * 255); } (1..32);

		my $id = md5_hex(pack 'C*', @data);

		return $id;
		}

		sub create_or_refresh_session {
8431ef24	Sven Schöling	$session_id \|\|= shift->_create_session_id;
2ecce44c	Moritz Bunkus	}

		sub save_session {
		my $self = shift;
		my $provided_dbh = shift;

57cf17b9	Moritz Bunkus	my $dbh = $provided_dbh \|\| $self->dbconnect(1);

7ed4b336	Moritz Bunkus	return unless $dbh && $session_id;
2ecce44c	Moritz Bunkus
0c32dd23	Moritz Bunkus	$dbh->begin_work unless $provided_dbh;

92800129	Moritz Bunkus	# If this fails then the "auth" schema might not exist yet, e.g. if
		# the admin is just trying to create the auth database.
		if (!$dbh->do(qq\|LOCK auth.session_content\|)) {
		$dbh->rollback unless $provided_dbh;
		return;
		}
8c7e4493	Moritz Bunkus
e0ba33ff	Moritz Bunkus	my ($id) = selectrow_query($::form, $dbh, qq\|SELECT id FROM auth.session WHERE id = ?\|, $session_id);
8431ef24	Sven Schöling
		if ($id) {
		do_query($::form, $dbh, qq\|UPDATE auth.session SET mtime = now() WHERE id = ?\|, $session_id);
		} else {
		do_query($::form, $dbh, qq\|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())\|, $session_id, $ENV{REMOTE_ADDR});
		}

6c21fd13	Moritz Bunkus	if ($self->{column_information}->has('api_token', 'session')) {
		my ($stored_api_token) = $dbh->selectrow_array(qq\|SELECT api_token FROM auth.session WHERE id = ?\|, undef, $session_id);
		do_query($::form, $dbh, qq\|UPDATE auth.session SET api_token = ? WHERE id = ?\|, $self->_create_session_id, $session_id) unless $stored_api_token;
		}

9b294bec	Sven Schöling	my @values_to_save = grep { $_->{modified} }
e0ba33ff	Moritz Bunkus	values %{ $self->{SESSION} };
		if (@values_to_save) {
9b294bec	Sven Schöling	my %known_keys = map { $_ => 1 }
		selectall_ids($::form, $dbh, qq\|SELECT sess_key FROM auth.session_content WHERE session_id = ?\|, 'sess_key', $session_id);
e0ba33ff	Moritz Bunkus	my $auto_restore = $self->{column_information}->has('auto_restore');
9ae27aae	Moritz Bunkus
9b294bec	Sven Schöling	my $insert_query = $auto_restore
		? "INSERT INTO auth.session_content (session_id, sess_key, sess_value, auto_restore) VALUES (?, ?, ?, ?)"
		: "INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)";
		my $insert_sth = prepare_query($::form, $dbh, $insert_query);
e0ba33ff	Moritz Bunkus
9b294bec	Sven Schöling	my $update_query = $auto_restore
		? "UPDATE auth.session_content SET sess_value = ?, auto_restore = ? WHERE session_id = ? AND sess_key = ?"
		: "UPDATE auth.session_content SET sess_value = ? WHERE session_id = ? AND sess_key = ?";
		my $update_sth = prepare_query($::form, $dbh, $update_query);
e0ba33ff	Moritz Bunkus
		foreach my $value (@values_to_save) {
		my @values = ($value->{key}, $value->get_dumped);
		push @values, $value->{auto_restore} if $auto_restore;

9b294bec	Sven Schöling	if ($known_keys{$value->{key}}) {
		do_statement($::form, $update_sth, $update_query,
		$value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore, $session_id, $value->{key}
		);
		} else {
		do_statement($::form, $insert_sth, $insert_query,
		$session_id, $value->{key}, $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore
		);
		}
9ae27aae	Moritz Bunkus	}

9b294bec	Sven Schöling	$insert_sth->finish;
		$update_sth->finish;
8c7e4493	Moritz Bunkus	}

9ae27aae	Moritz Bunkus	$dbh->commit() unless $provided_dbh;
8c7e4493	Moritz Bunkus	}

		sub set_session_value {
8fdebd9c	Moritz Bunkus	my $self = shift;
bc9d2f36	Moritz Bunkus	my @params = @_;
8c7e4493	Moritz Bunkus
		$self->{SESSION} \|\|= { };

bc9d2f36	Moritz Bunkus	while (@params) {
		my $key = shift @params;

		if (ref $key eq 'HASH') {
e0ba33ff	Moritz Bunkus	$self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
		value => $key->{value},
9b294bec	Sven Schöling	modified => 1,
e0ba33ff	Moritz Bunkus	auto_restore => $key->{auto_restore});
bc9d2f36	Moritz Bunkus
		} else {
		my $value = shift @params;
e0ba33ff	Moritz Bunkus	$self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
9b294bec	Sven Schöling	value => $value,
		modified => 1);
bc9d2f36	Moritz Bunkus	}
8c7e4493	Moritz Bunkus	}

9ae27aae	Moritz Bunkus	return $self;
		}

		sub delete_session_value {
		my $self = shift;

		$self->{SESSION} \|\|= { };
		delete @{ $self->{SESSION} }{ @_ };

		return $self;
		}

		sub get_session_value {
9b294bec	Sven Schöling	my ($self, $key) = @_;

		return if !$self->{SESSION};
9ae27aae	Moritz Bunkus
9b294bec	Sven Schöling	($self->{SESSION}{$key} //= SL::Auth::SessionValue->new(auth => $self, key => $key))->get
c90b4dcd	Moritz Bunkus	}

		sub create_unique_sesion_value {
		my ($self, $value, %params) = @_;

		$self->{SESSION} \|\|= { };

		my @now = gettimeofday();
		my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
		$self->{unique_counter} \|\|= 0;

cdacfe1c	Moritz Bunkus	my $hashed_key;
		do {
		$self->{unique_counter}++;
		$hashed_key = md5_hex($key . $self->{unique_counter});
		} while (exists $self->{SESSION}->{$hashed_key});
c90b4dcd	Moritz Bunkus
cdacfe1c	Moritz Bunkus	$self->set_session_value($hashed_key => $value);
c90b4dcd	Moritz Bunkus
cdacfe1c	Moritz Bunkus	return $hashed_key;
c90b4dcd	Moritz Bunkus	}

		sub save_form_in_session {
		my ($self, %params) = @_;

		my $form = delete($params{form}) \|\| $::form;
		my $non_scalars = delete $params{non_scalars};
		my $data = {};

		my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} \|\| [] });

		foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
		$data->{$key} = $form->{$key} if !ref($form->{$key}) \|\| $non_scalars;
		}

		return $self->create_unique_sesion_value($data, %params);
		}

		sub restore_form_from_session {
		my ($self, $key, %params) = @_;

		my $data = $self->get_session_value($key);
		return $self unless $data;

		my $form = delete($params{form}) \|\| $::form;
		my $clobber = exists $params{clobber} ? $params{clobber} : 1;

		map { $form->{$_} = $data->{$_} if $clobber \|\| !exists $form->{$_} } keys %{ $data };

		return $self;
		}

8c7e4493	Moritz Bunkus	sub set_cookie_environment_variable {
		my $self = shift;
		$ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
		}

		sub get_session_cookie_name {
6c21fd13	Moritz Bunkus	my ($self, %params) = @_;
8c7e4493	Moritz Bunkus
6c21fd13	Moritz Bunkus	$params{type} \|\|= 'id';
		my $name = $self->{cookie_name} \|\| 'lx_office_erp_session_id';
		$name .= '_api_token' if $params{type} eq 'api_token';

		return $name;
8c7e4493	Moritz Bunkus	}

		sub get_session_id {
		return $session_id;
		}

6c21fd13	Moritz Bunkus	sub get_api_token_cookie {
		my ($self) = @_;

		$::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
		}

77fda875	Moritz Bunkus	sub is_api_token_cookie_valid {
		my ($self) = @_;
		my $provided_api_token = $self->get_api_token_cookie;
		return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
		}

a1ea659f	Sven Schöling	sub _tables_present {
		my ($self, @tables) = @_;
		my $cache_key = join '_', @tables;
9b327aff	Moritz Bunkus
		# Only re-check for the presence of auth tables if either the check
		# hasn't been done before of if they weren't present.
a1ea659f	Sven Schöling	return $self->{"$cache_key\_tables_present"} \|\|= do {
		my $dbh = $self->dbconnect(1);
9b327aff	Moritz Bunkus
a1ea659f	Sven Schöling	if (!$dbh) {
		return 0;
		}
8c7e4493	Moritz Bunkus
a1ea659f	Sven Schöling	my $query =
		qq\|SELECT COUNT(*)
		FROM pg_tables
		WHERE (schemaname = 'auth')
		AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))\|;
8c7e4493	Moritz Bunkus
a1ea659f	Sven Schöling	my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
8c7e4493	Moritz Bunkus
2e8e0934	Sven Schöling	scalar @tables == $count;
a1ea659f	Sven Schöling	}
		}
8c7e4493	Moritz Bunkus
a1ea659f	Sven Schöling	sub session_tables_present {
		$_[0]->_tables_present('session', 'session_content');
		}
9b327aff	Moritz Bunkus
a1ea659f	Sven Schöling	sub master_rights_present {
		$_[0]->_tables_present('master_rights');
8c7e4493	Moritz Bunkus	}

		# --------------------------------------

		sub all_rights_full {
a1ea659f	Sven Schöling	my ($self) = @_;

		@{ $self->{master_rights} \|\|= do {
e0f5deea	Martin Helmling	$self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position");
a1ea659f	Sven Schöling	}
		}
8c7e4493	Moritz Bunkus	}

		sub all_rights {
a1ea659f	Sven Schöling	return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
8c7e4493	Moritz Bunkus	}

		sub read_groups {
		my $self = shift;

		my $form = $main::form;
		my $groups = {};
		my $dbh = $self->dbconnect();

		my $query = 'SELECT * FROM auth."group"';
		my $sth = prepare_execute_query($form, $dbh, $query);

		my ($row, $group);

		while ($row = $sth->fetchrow_hashref()) {
		$groups->{$row->{id}} = $row;
		}
		$sth->finish();

		$query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
		$sth = prepare_query($form, $dbh, $query);

		foreach $group (values %{$groups}) {
5c0c9e67	Sven Schöling	my @members;
8c7e4493	Moritz Bunkus
		do_statement($form, $sth, $query, $group->{id});

		while ($row = $sth->fetchrow_hashref()) {
5c0c9e67	Sven Schöling	push @members, $row->{user_id};
8c7e4493	Moritz Bunkus	}
5c0c9e67	Sven Schöling	$group->{members} = [ uniq @members ];
8c7e4493	Moritz Bunkus	}
		$sth->finish();

		$query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
		$sth = prepare_query($form, $dbh, $query);

		foreach $group (values %{$groups}) {
		$group->{rights} = {};

		do_statement($form, $sth, $query, $group->{id});

		while ($row = $sth->fetchrow_hashref()) {
		$group->{rights}->{$row->{right}} \|= $row->{granted};
		}

a1ea659f	Sven Schöling	map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
8c7e4493	Moritz Bunkus	}
		$sth->finish();

		return $groups;
		}

		sub save_group {
		my $self = shift;
		my $group = shift;

		my $form = $main::form;
		my $dbh = $self->dbconnect();

0c32dd23	Moritz Bunkus	$dbh->begin_work;

8c7e4493	Moritz Bunkus	my ($query, $sth, $row, $rights);

		if (!$group->{id}) {
		($group->{id}) = selectrow_query($form, $dbh, qq\|SELECT nextval('auth.group_id_seq')\|);

		$query = qq\|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')\|;
		do_query($form, $dbh, $query, $group->{id});
		}

		do_query($form, $dbh, qq\|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?\|, map { $group->{$_} } qw(name description id));

		do_query($form, $dbh, qq\|DELETE FROM auth.user_group WHERE group_id = ?\|, $group->{id});

		$query = qq\|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)\|;
		$sth = prepare_query($form, $dbh, $query);

5c0c9e67	Sven Schöling	foreach my $user_id (uniq @{ $group->{members} }) {
8c7e4493	Moritz Bunkus	do_statement($form, $sth, $query, $user_id, $group->{id});
		}
		$sth->finish();

		do_query($form, $dbh, qq\|DELETE FROM auth.group_rights WHERE group_id = ?\|, $group->{id});

		$query = qq\|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)\|;
		$sth = prepare_query($form, $dbh, $query);

		foreach my $right (keys %{ $group->{rights} }) {
		do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
		}
		$sth->finish();

		$dbh->commit();
		}

		sub delete_group {
		my $self = shift;
		my $id = shift;

dcfdf5de	Sven Schöling	my $form = $main::form;
8c7e4493	Moritz Bunkus
		my $dbh = $self->dbconnect();
0c32dd23	Moritz Bunkus	$dbh->begin_work;
8c7e4493	Moritz Bunkus
		do_query($form, $dbh, qq\|DELETE FROM auth.user_group WHERE group_id = ?\|, $id);
		do_query($form, $dbh, qq\|DELETE FROM auth.group_rights WHERE group_id = ?\|, $id);
		do_query($form, $dbh, qq\|DELETE FROM auth."group" WHERE id = ?\|, $id);

		$dbh->commit();
		}

		sub evaluate_rights_ary {
		my $ary = shift;

		my $value = 0;
		my $action = '\|';
78b23538	Bernd Bleßmann	my $negate = 0;
8c7e4493	Moritz Bunkus
		foreach my $el (@{$ary}) {
		if (ref $el eq "ARRAY") {
78b23538	Bernd Bleßmann	my $val = evaluate_rights_ary($el);
		$val = !$val if $negate;
		$negate = 0;
8c7e4493	Moritz Bunkus	if ($action eq '\|') {
78b23538	Bernd Bleßmann	$value \|= $val;
8c7e4493	Moritz Bunkus	} else {
78b23538	Bernd Bleßmann	$value &= $val;
8c7e4493	Moritz Bunkus	}

		} elsif (($el eq '&') \|\| ($el eq '\|')) {
		$action = $el;

78b23538	Bernd Bleßmann	} elsif ($el eq '!') {
		$negate = !$negate;

8c7e4493	Moritz Bunkus	} elsif ($action eq '\|') {
78b23538	Bernd Bleßmann	my $val = $el;
		$val = !$val if $negate;
		$negate = 0;
		$value \|= $val;
8c7e4493	Moritz Bunkus
		} else {
78b23538	Bernd Bleßmann	my $val = $el;
		$val = !$val if $negate;
		$negate = 0;
		$value &= $val;
8c7e4493	Moritz Bunkus
		}
		}

		return $value;
		}

		sub _parse_rights_string {
		my $self = shift;

		my $login = shift;
		my $access = shift;

		my @stack;
		my $cur_ary = [];

		push @stack, $cur_ary;

		while ($access =~ m/^([a-z_0-9]+\|\\|\|\&\|$\|$\|\s+)/) {
		my $token = $1;
		substr($access, 0, length $1) = "";

		next if ($token =~ /\s/);

		if ($token eq "(") {
		my $new_cur_ary = [];
		push @stack, $new_cur_ary;
		push @{$cur_ary}, $new_cur_ary;
		$cur_ary = $new_cur_ary;

		} elsif ($token eq ")") {
		pop @stack;

		if (!@stack) {
		return 0;
		}

		$cur_ary = $stack[-1];

		} elsif (($token eq "\|") \|\| ($token eq "&")) {
		push @{$cur_ary}, $token;

		} else {
8f3e8a02	Moritz Bunkus	push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
8c7e4493	Moritz Bunkus	}
		}

		my $result = ($access \|\| (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);

		return $result;
		}

		sub check_right {
		my $self = shift;
		my $login = shift;
		my $right = shift;
		my $default = shift;

		$self->{FULL_RIGHTS} \|\|= { };
		$self->{FULL_RIGHTS}->{$login} \|\|= { };

		if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
		$self->{RIGHTS} \|\|= { };
		$self->{RIGHTS}->{$login} \|\|= $self->load_rights_for_user($login);

		$self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
		}

		my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
		$granted = $default if (!defined $granted);

		return $granted;
		}

		sub assert {
f90fcfb9	Sven Schöling	my ($self, $right, $dont_abort) = @_;
8c7e4493	Moritz Bunkus
9c887306	Sven Schöling	if ($self->check_right($::myconfig{login}, $right)) {
8c7e4493	Moritz Bunkus	return 1;
		}

		if (!$dont_abort) {
f90fcfb9	Sven Schöling	delete $::form->{title};
		$::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
8c7e4493	Moritz Bunkus	}

		return 0;
		}

		sub load_rights_for_user {
9e428908	Sven Schöling	my ($self, $login) = @_;
		my $dbh = $self->dbconnect;
8c7e4493	Moritz Bunkus	my ($query, $sth, $row, $rights);

a1ea659f	Sven Schöling	$rights = { map { $_ => 0 } $self->all_rights };
8c7e4493	Moritz Bunkus
f9c91009	Moritz Bunkus	return $rights if !$self->client \|\| !$login;

8c7e4493	Moritz Bunkus	$query =
		qq\|SELECT gr."right", gr.granted
		FROM auth.group_rights gr
		WHERE group_id IN
		(SELECT ug.group_id
		FROM auth.user_group ug
		LEFT JOIN auth."user" u ON (ug.user_id = u.id)
9fdaa1e3	Moritz Bunkus	WHERE u.login = ?)
		AND group_id IN
		(SELECT cg.group_id
		FROM auth.clients_groups cg
		WHERE cg.client_id = ?)\|;
8c7e4493	Moritz Bunkus
9fdaa1e3	Moritz Bunkus	$sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
8c7e4493	Moritz Bunkus
		while ($row = $sth->fetchrow_hashref()) {
		$rights->{$row->{right}} \|= $row->{granted};
		}
		$sth->finish();

		return $rights;
		}

		1;
c90b4dcd	Moritz Bunkus	__END__

		=pod

		=encoding utf8

		=head1 NAME

		SL::Auth - Authentication and session handling

b8c19cc7	Sven Schöling	=head1 METHODS
c90b4dcd	Moritz Bunkus
		=over 4

bc9d2f36	Moritz Bunkus	=item C<set_session_value @values>
07b14d1f	Sven Schöling
c90b4dcd	Moritz Bunkus	=item C<set_session_value %values>

bc9d2f36	Moritz Bunkus	Store all values of C<@values> or C<%values> in the session. Each
		member of C<@values> is tested if it is a hash reference. If it is
		then it must contain the keys C<key> and C<value> and can optionally
		contain the key C<auto_restore>. In this case C<value> is associated
		with C<key> and restored to C<$::form> upon the next request
		automatically if C<auto_restore> is trueish or if C<value> is a scalar
		value.

		If the current member of C<@values> is not a hash reference then it
		will be used as the C<key> and the next entry of C<@values> is used as
		the C<value> to store. In this case setting C<auto_restore> is not
		possible.

		Therefore the following two invocations are identical:

		$::auth-E<gt>set_session_value(name =E<gt> "Charlie");
		$::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });

		All of these values are copied back into C<$::form> for the next
		request automatically if they're scalar values or if they have
		C<auto_restore> set to trueish.
c90b4dcd	Moritz Bunkus
		The values can be any Perl structure. They are stored as YAML dumps.

		=item C<get_session_value $key>

		Retrieve a value from the session. Returns C<undef> if the value
		doesn't exist.

		=item C<create_unique_sesion_value $value, %params>

		Create a unique key in the session and store C<$value>
		there.

		Returns the key created in the session.

		=item C<save_session>

		Stores the session values in the database. This is the only function
		that actually stores stuff in the database. Neither the various
		setters nor the deleter access the database.

b8c19cc7	Sven Schöling	=item C<save_form_in_session %params>
c90b4dcd	Moritz Bunkus
		Stores the content of C<$params{form}> (default: C<$::form>) in the
		session using L</create_unique_sesion_value>.

		If C<$params{non_scalars}> is trueish then non-scalar values will be
		stored as well. Default is to only store scalar values.

		The following keys will never be saved: C<login>, C<password>,
		C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
		can be given as an array ref in C<$params{skip_keys}>.

		Returns the unique key under which the form is stored.

b8c19cc7	Sven Schöling	=item C<restore_form_from_session $key, %params>
c90b4dcd	Moritz Bunkus
		Restores the form from the session into C<$params{form}> (default:
		C<$::form>).

		If C<$params{clobber}> is falsish then existing values with the same
		key in C<$params{form}> will not be overwritten. C<$params{clobber}>
		is on by default.

		Returns C<$self>.

b8c19cc7	Sven Schöling	=item C<reset>

		C<reset> deletes every state information from previous requests, but does not
		close the database connection.

		Creating a new database handle on each request can take up to 30% of the
		pre-request startup time, so we want to avoid that for fast ajax calls.

46c22b43	Jan Büren	=item C<assert, $right, $dont_abort>

		Checks if current user has the C<$right>. If C<$dont_abort> is falsish
		the request dies with a access denied error, otherwise returns true or false.

c90b4dcd	Moritz Bunkus	=back

		=head1 BUGS

		Nothing here yet.

		=head1 AUTHOR
402bcb73	Moritz Bunkus
c90b4dcd	Moritz Bunkus	Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

		=cut

Projekt

Allgemein

Profil

projekt kivitendo