kivitendo/SL/Auth.pm @ 7749e0e6
| 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;
|
||
| 78c6fdee | Sven Schöling | use SL::DBUtils qw(do_query do_statement prepare_execute_query prepare_query selectall_array_query selectrow_query);
|
||
| 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}) {
|
||||
print Form->create_http_response(content_type => 'text/html');
|
||||
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'};
|
||||
$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;
|
||||
}
|
||||
| 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
|
||||
WHERE (session_id = ?)
|
||||
SQL
|
||||
my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
|
||||
while (my $ref = $sth->fetchrow_hashref) {
|
||||
| 81a9ce9b | Sven Schöling | if ($ref->{auto_restore} || $auto_restore_keys{$ref->{sess_key}}) {
|
||
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;
|
||||
} else {
|
||||
my $value = SL::Auth::SessionValue->new(auth => $self,
|
||||
key => $ref->{sess_key});
|
||||
$self->{SESSION}->{ $ref->{sess_key} } = $value;
|
||||
}
|
||||
| e0ba33ff | Moritz Bunkus | }
|
||
$sth->finish;
|
||||
| 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);
|
||||
}
|
||||
| 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
|