Projekt

Allgemein

Profil

Herunterladen (38,7 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/Auth.pm @ 05463301

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;
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;
8c7e4493 Moritz Bunkus
use SL::DBUtils;

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);
e0ba33ff Moritz Bunkus
$self->reset;
8c7e4493 Moritz Bunkus
return $self;
}

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

e0ba33ff Moritz Bunkus
$self->{SESSION} = { };
$self->{FULL_RIGHTS} = { };
$self->{RIGHTS} = { };
$self->{unique_counter} = 0;
$self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
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
}

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}) {
print Form->create_http_response(content_type => 'text/html');
print "<pre>", join ('<br>', @msg), "</pre>";
} else {
print STDERR "Error: @msg\n";
}
::end_of_request();
}

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'};
$self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
}
8c7e4493 Moritz Bunkus
if ($self->{module} eq 'DB') {
$self->{authenticator} = SL::Auth::DB->new($self);

} elsif ($self->{module} eq 'LDAP') {
$self->{authenticator} = SL::Auth::LDAP->new($self);
}

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;
}

$password = SL::Auth::Password->hash(login => 'root', password => $password);
6bce748c Moritz Bunkus
my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{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}) {
$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};
}
}

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;

92800129 Moritz Bunkus
# Don't fail if the auth DB doesn't yet.
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
# 4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address
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;
$cookie_is_bad ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR} 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) = @_;

my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);

my $query = <<SQL;
SELECT sess_key, sess_value, auto_restore
FROM auth.session_content
WHERE (session_id = ?)
AND ( auto_restore
OR sess_key IN (${auto_restore_keys}))
SQL
my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);

while (my $ref = $sth->fetchrow_hashref) {
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;
c90b4dcd Moritz Bunkus
e0ba33ff Moritz Bunkus
next if defined $::form->{$ref->{sess_key}};
8fdebd9c Moritz Bunkus
e0ba33ff Moritz Bunkus
my $data = $value->get;
$::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
}

$sth->finish;

$query = <<SQL;
SELECT sess_key
FROM auth.session_content
WHERE (session_id = ?)
AND NOT COALESCE(auto_restore, FALSE)
AND (sess_key NOT IN (${auto_restore_keys}))
SQL
$sth = prepare_execute_query($::form, $dbh, $query, $session_id);

while (my $ref = $sth->fetchrow_hashref) {
my $value = SL::Auth::SessionValue->new(auth => $self,
key => $ref->{sess_key});
$self->{SESSION}->{ $ref->{sess_key} } = $value;
}
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 @unfetched_keys = map { $_->{key} }
grep { ! $_->{fetched} }
values %{ $self->{SESSION} };
# $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
# $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
$query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
8431ef24 Sven Schöling
e0ba33ff Moritz Bunkus
do_query($::form, $dbh, $query, $session_id, @unfetched_keys);

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;
}

e0ba33ff Moritz Bunkus
my @values_to_save = grep { $_->{fetched} }
values %{ $self->{SESSION} };
if (@values_to_save) {
my ($columns, $placeholders) = ('', '');
my $auto_restore = $self->{column_information}->has('auto_restore');
9ae27aae Moritz Bunkus
e0ba33ff Moritz Bunkus
if ($auto_restore) {
$columns .= ', auto_restore';
$placeholders .= ', ?';
}

$query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
my $sth = prepare_query($::form, $dbh, $query);

foreach my $value (@values_to_save) {
my @values = ($value->{key}, $value->get_dumped);
push @values, $value->{auto_restore} if $auto_restore;

do_statement($::form, $sth, $query, $session_id, @values);
9ae27aae Moritz Bunkus
}

$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},
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,
value => $value);
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 {
e0ba33ff Moritz Bunkus
my $self = shift;
my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
9ae27aae Moritz Bunkus
e0ba33ff Moritz Bunkus
return $data;
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);
}

8c7e4493 Moritz Bunkus
sub session_tables_present {
my $self = shift;
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.
if ($self->{session_tables_present}) {
return $self->{session_tables_present};
}

8c7e4493 Moritz Bunkus
my $dbh = $self->dbconnect(1);

if (!$dbh) {
return 0;
}

my $query =
qq|SELECT COUNT(*)
FROM pg_tables
WHERE (schemaname = 'auth')
AND (tablename IN ('session', 'session_content'))|;

my ($count) = selectrow_query($main::form, $dbh, $query);

9b327aff Moritz Bunkus
$self->{session_tables_present} = 2 == $count;

return $self->{session_tables_present};
8c7e4493 Moritz Bunkus
}

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

sub all_rights_full {
my $locale = $main::locale;

my @all_rights = (
["--master_data", $locale->text("Master Data")],
4f50aaa5 Jan Büren
["customer_vendor_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
["customer_vendor_all_edit", $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
8c7e4493 Moritz Bunkus
["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
db9a3208 Niclas Zimmermann
["part_service_assembly_details", $locale->text("Show details and reports of parts, services, assemblies")],
8c7e4493 Moritz Bunkus
["project_edit", $locale->text("Create and edit projects")],
["--ar", $locale->text("AR")],
8b4ff253 Moritz Bunkus
["requirement_spec_edit", $locale->text("Create and edit requirement specs")],
8c7e4493 Moritz Bunkus
["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
["sales_order_edit", $locale->text("Create and edit sales orders")],
["sales_delivery_order_edit", $locale->text("Create and edit sales delivery orders")],
["invoice_edit", $locale->text("Create and edit invoices and credit notes")],
["dunning_edit", $locale->text("Create and edit dunnings")],
a9b2cbe2 Jan Büren
["sales_letter_edit", $locale->text("Edit sales letters")],
c9e93ded Jan Büren
["sales_all_edit", $locale->text("View/edit all employees sales documents")],
2ff140f1 Jan Büren
["edit_prices", $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
e8d91442 Geoffrey Richardson
["show_ar_transactions", $locale->text("Show AR transactions as part of AR invoice report")],
64a2d791 Sven Schöling
["delivery_plan", $locale->text("Show delivery plan")],
2acbe8c6 Jan Büren
["delivery_value_report", $locale->text("Show delivery value report")],
a9b2cbe2 Jan Büren
["sales_letter_report", $locale->text("Show sales letters report")],
8c7e4493 Moritz Bunkus
["--ap", $locale->text("AP")],
["request_quotation_edit", $locale->text("Create and edit RFQs")],
["purchase_order_edit", $locale->text("Create and edit purchase orders")],
["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
e8d91442 Geoffrey Richardson
["show_ap_transactions", $locale->text("Show AP transactions as part of AP invoice report")],
83914eeb Moritz Bunkus
["--warehouse_management", $locale->text("Warehouse management")],
["warehouse_contents", $locale->text("View warehouse content")],
["warehouse_management", $locale->text("Warehouse management")],
8c7e4493 Moritz Bunkus
["--general_ledger_cash", $locale->text("General ledger and cash")],
["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
["datev_export", $locale->text("DATEV Export")],
["cash", $locale->text("Receipt, payment, reconciliation")],
6a12a968 Niclas Zimmermann
["bank_transaction", $locale->text("Bank transactions")],
8c7e4493 Moritz Bunkus
["--reports", $locale->text('Reports')],
["report", $locale->text('All reports')],
["advance_turnover_tax_return", $locale->text('Advance turnover tax return')],
95574521 Geoffrey Richardson
["--batch_printing", $locale->text("Batch Printing")],
["batch_printing", $locale->text("Batch Printing")],
62fb4564 Moritz Bunkus
["--configuration", $locale->text("Configuration")],
["config", $locale->text("Change kivitendo installation settings (most entries in the 'System' menu)")],
["admin", $locale->text("Client administration: configuration, editing templates, task server control, background jobs (remaining entries in the 'System' menu)")],
8c7e4493 Moritz Bunkus
["--others", $locale->text("Others")],
["email_bcc", $locale->text("May set the BCC field when sending emails")],
606032ad Niclas Zimmermann
["productivity", $locale->text("Productivity")],
["display_admin_link", $locale->text("Show administration link")],
8c7e4493 Moritz Bunkus
);

return @all_rights;
}

sub all_rights {
return grep !/^--/, map { $_->[0] } all_rights_full();
}

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};
}

map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
}
$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 = '|';

foreach my $el (@{$ary}) {
if (ref $el eq "ARRAY") {
if ($action eq '|') {
$value |= evaluate_rights_ary($el);
} else {
$value &= evaluate_rights_ary($el);
}

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

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

} else {
$value &= $el;

}
}

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 {
push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
}
}

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);

63e61ef5 Sven Schöling
$rights = { map { $_ => 0 } 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.

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