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;
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);
$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();
}
$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();
$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 $dbh = $self->dbconnect;
my ($query, $sth, $row, $rights);
- $rights = { map { $rights->{$_} => 0 } all_rights() };
+ $rights = { map { $_ => 0 } all_rights() };
$query =
qq|SELECT gr."right", gr.granted
=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.
projects / mfinanz.git / blobdiff