use SL::Auth::Constants qw(:all);
use SL::Auth::DB;
use SL::Auth::LDAP;
+use SL::Auth::Password;
+use SL::SessionFile;
use SL::User;
+use SL::DBConnect;
use SL::DBUpgrade2;
use SL::DBUtils;
return $self;
}
+sub reset {
+ my ($self, %params) = @_;
+
+ $self->{SESSION} = { };
+ $self->{FULL_RIGHTS} = { };
+ $self->{RIGHTS} = { };
+ $self->{unique_counter} = 0;
+}
+
sub get_user_dbh {
- my ($self, $login) = @_;
+ my ($self, $login, %params) = @_;
+ my $may_fail = delete $params{may_fail};
+
my %user = $self->read_user($login);
- my $dbh = DBI->connect(
+ my $dbh = SL::DBConnect->connect(
$user{dbconnect},
$user{dbuser},
$user{dbpasswd},
pg_enable_utf8 => $::locale->is_utf8,
AutoCommit => 0
}
- ) or $::form->dberror;
+ );
- if ($user{dboptions}) {
+ if (!$may_fail && !$dbh) {
+ $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
+ }
+
+ if ($user{dboptions} && $dbh) {
$dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
}
sub authenticate_root {
$main::lxdebug->enter_sub();
- my $self = shift;
- my $password = shift;
- my $is_crypted = shift;
+ my ($self, $password) = @_;
- $password = crypt $password, 'ro' if (!$password || !$is_crypted);
- my $admin_password = crypt "$self->{admin_password}", 'ro';
+ $password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
+ my $admin_password = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password});
$main::lxdebug->leave_sub();
return $result;
}
+sub store_credentials_in_session {
+ my ($self, %params) = @_;
+
+ $params{password} = SL::Auth::Password->hash_if_unhashed(login => $params{login}, password => $params{password})
+ unless $self->{authenticator}->requires_cleartext_password;
+
+ $self->set_session_value(login => $params{login}, password => $params{password});
+}
+
+sub store_root_credentials_in_session {
+ my ($self, $rpw) = @_;
+
+ $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
+}
+
sub dbconnect {
$main::lxdebug->enter_sub(2);
$main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
- $self->{dbh} = DBI->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
+ $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
if (!$may_fail && !$self->{dbh}) {
$main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
my $encoding = $Common::charset_to_db_encoding{$charset};
$encoding ||= 'UNICODE';
- my $dbh = DBI->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => $charset =~ m/^utf-?8$/i });
+ my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
if (!$dbh) {
$main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
}
sub delete_user {
- $main::lxdebug->enter_sub();
+ $::lxdebug->enter_sub;
my $self = shift;
my $login = shift;
- my $form = $main::form;
-
- my $dbh = $self->dbconnect();
+ my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
+ my $dbh = $self->dbconnect;
$dbh->begin_work;
my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
- my ($id) = selectrow_query($form, $dbh, $query, $login);
+ my ($id) = selectrow_query($::form, $dbh, $query, $login);
- $dbh->rollback and return $main::lxdebug->leave_sub() if (!$id);
+ $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
- 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);
+ 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);
+ do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
- $dbh->commit();
+ $dbh->commit;
+ $u_dbh->commit if $u_dbh;
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
# --------------------------------------
$dbh->commit();
+ SL::SessionFile->destroy_session($session_id);
+
$session_id = undef;
$self->{SESSION} = { };
}
my $self = shift;
+ $main::lxdebug->leave_sub and return if !$self->session_tables_present;
+
my $dbh = $self->dbconnect();
- $dbh->begin_work;
+ my $query = qq|SELECT id
+ FROM auth.session
+ WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
- my $query =
- qq|DELETE FROM auth.session_content
- WHERE session_id IN
- (SELECT id
- FROM auth.session
- WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
+ my @ids = selectall_array_query($::form, $dbh, $query);
- do_query($main::form, $dbh, $query);
+ if (@ids) {
+ $dbh->begin_work;
- $query =
- qq|DELETE FROM auth.session
- WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
+ SL::SessionFile->destroy_session($_) for @ids;
- do_query($main::form, $dbh, $query);
+ $query = qq|DELETE FROM auth.session_content
+ WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
+ do_query($main::form, $dbh, $query, @ids);
- $dbh->commit();
+ $query = qq|DELETE FROM auth.session
+ WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
+ do_query($main::form, $dbh, $query, @ids);
+
+ $dbh->commit();
+ }
$main::lxdebug->leave_sub();
}
}
sub create_or_refresh_session {
- $main::lxdebug->enter_sub();
-
- my $self = shift;
-
- $session_id ||= $self->_create_session_id();
-
- my ($form, $dbh, $query, $sth, $id);
-
- $form = $main::form;
- $dbh = $self->dbconnect();
-
- $dbh->begin_work;
- do_query($::form, $dbh, qq|LOCK auth.session_content|);
-
- $query = qq|SELECT id FROM auth.session WHERE id = ?|;
-
- ($id) = selectrow_query($form, $dbh, $query, $session_id);
-
- 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});
-
- }
-
- $self->save_session($dbh);
-
- $dbh->commit();
-
- $main::lxdebug->leave_sub();
+ $session_id ||= shift->_create_session_id;
}
sub save_session {
+ $::lxdebug->enter_sub;
my $self = shift;
my $provided_dbh = shift;
my $dbh = $provided_dbh || $self->dbconnect(1);
- return unless $dbh;
+ $::lxdebug->leave_sub && return unless $dbh && $session_id;
$dbh->begin_work unless $provided_dbh;
do_query($::form, $dbh, qq|LOCK auth.session_content|);
do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
+ my $query = qq|SELECT id FROM auth.session WHERE id = ?|;
+
+ my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
+
+ 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});
+ }
+
if (%{ $self->{SESSION} }) {
my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
my $sth = prepare_query($::form, $dbh, $query);
}
$dbh->commit() unless $provided_dbh;
+ $::lxdebug->leave_sub;
}
sub set_session_value {
$main::lxdebug->enter_sub();
my $self = shift;
- my %params = @_;
+ my @params = @_;
$self->{SESSION} ||= { };
- while (my ($key, $value) = each %params) {
- $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
+ while (@params) {
+ my $key = shift @params;
+
+ if (ref $key eq 'HASH') {
+ my $value = { data => $key->{value},
+ auto_restore => $key->{auto_restore},
+ };
+ $self->{SESSION}->{ $key->{key} } = YAML::Dump($value);
+
+ } else {
+ my $value = shift @params;
+ $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
+ }
}
$main::lxdebug->leave_sub();
$self->{unique_counter}++;
$value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
- no_auto => !$params{auto_restore},
data => $value,
};
$main::lxdebug->enter_sub();
my $self = shift;
+
+ # 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}) {
+ $main::lxdebug->leave_sub();
+ return $self->{session_tables_present};
+ }
+
my $dbh = $self->dbconnect(1);
if (!$dbh) {
my ($count) = selectrow_query($main::form, $dbh, $query);
+ $self->{session_tables_present} = 2 == $count;
+
$main::lxdebug->leave_sub();
- return 2 == $count;
+ return $self->{session_tables_present};
}
# --------------------------------------
["customer_vendor_edit", $locale->text("Create and edit customers and vendors")],
["part_service_assembly_edit", $locale->text("Create and edit parts, services, assemblies")],
["project_edit", $locale->text("Create and edit projects")],
- ["license_edit", $locale->text("Manage license keys")],
["--ar", $locale->text("AR")],
["sales_quotation_edit", $locale->text("Create and edit sales quotations")],
["sales_order_edit", $locale->text("Create and edit sales orders")],
my $self = shift;
my $id = shift;
- my $form = $main::from;
+ my $form = $main::form;
my $dbh = $self->dbconnect();
$dbh->begin_work;
}
sub assert {
- $main::lxdebug->enter_sub(2);
+ $::lxdebug->enter_sub(2);
+ my ($self, $right, $dont_abort) = @_;
- my $self = shift;
- my $right = shift;
- my $dont_abort = shift;
-
- my $form = $main::form;
-
- if ($self->check_right($form->{login}, $right)) {
- $main::lxdebug->leave_sub(2);
+ if ($self->check_right($::myconfig{login}, $right)) {
+ $::lxdebug->leave_sub(2);
return 1;
}
if (!$dont_abort) {
- delete $form->{title};
- $form->show_generic_error($main::locale->text("You do not have the permissions to access this function."));
+ delete $::form->{title};
+ $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
}
- $main::lxdebug->leave_sub(2);
+ $::lxdebug->leave_sub(2);
return 0;
}
sub load_rights_for_user {
- $main::lxdebug->enter_sub();
-
- my $self = shift;
- my $login = shift;
-
- my $form = $main::form;
- my $dbh = $self->dbconnect();
+ $::lxdebug->enter_sub;
+ my ($self, $login) = @_;
+ my $dbh = $self->dbconnect;
my ($query, $sth, $row, $rights);
- $rights = {};
+ $rights = { map { $_ => 0 } all_rights() };
$query =
qq|SELECT gr."right", gr.granted
LEFT JOIN auth."user" u ON (ug.user_id = u.id)
WHERE u.login = ?)|;
- $sth = prepare_execute_query($form, $dbh, $query, $login);
+ $sth = prepare_execute_query($::form, $dbh, $query, $login);
while ($row = $sth->fetchrow_hashref()) {
$rights->{$row->{right}} |= $row->{granted};
}
$sth->finish();
- map({ $rights->{$_} = 0 unless (defined $rights->{$_}); } SL::Auth::all_rights());
-
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
return $rights;
}
=over 4
+=item C<set_session_value @values>
=item C<set_session_value %values>
-Store all key/value pairs in C<%values> in the session. All of these
-values are copied back into C<$::form> in the next request
-automatically.
+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.
The values can be any Perl structure. They are stored as YAML dumps.
seconds after which the value is removed from the session. It will
never expire if that parameter is falsish.
-If C<$params{auto_restore}> is trueish then the value will be copied
-into C<$::form> upon the next request automatically. It defaults to
-C<false> and has therefore different behaviour than
-L</set_session_value>.
-
Returns the key created in the session.
=item C<expire_session_keys>
projects / mfinanz.git / blobdiff