Revision e0ba33ff
Von Moritz Bunkus vor mehr als 13 Jahren hinzugefügt
| SL/Auth.pm | ||
|---|---|---|
|
use List::MoreUtils qw(uniq);
|
||
|
use YAML;
|
||
|
|
||
|
use SL::Auth::ColumnInformation;
|
||
|
use SL::Auth::Constants qw(:all);
|
||
|
use SL::Auth::DB;
|
||
|
use SL::Auth::LDAP;
|
||
|
use SL::Auth::Password;
|
||
|
use SL::Auth::SessionValue;
|
||
|
|
||
|
use SL::SessionFile;
|
||
|
use SL::User;
|
||
| ... | ... | |
|
|
||
|
bless $self, $type;
|
||
|
|
||
|
$self->{SESSION} = { };
|
||
|
|
||
|
$self->_read_auth_config();
|
||
|
$self->reset;
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
| ... | ... | |
|
sub reset {
|
||
|
my ($self, %params) = @_;
|
||
|
|
||
|
$self->{SESSION} = { };
|
||
|
$self->{FULL_RIGHTS} = { };
|
||
|
$self->{RIGHTS} = { };
|
||
|
$self->{unique_counter} = 0;
|
||
|
$self->{SESSION} = { };
|
||
|
$self->{FULL_RIGHTS} = { };
|
||
|
$self->{RIGHTS} = { };
|
||
|
$self->{unique_counter} = 0;
|
||
|
$self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
|
||
|
}
|
||
|
|
||
|
sub get_user_dbh {
|
||
| ... | ... | |
|
return $cookie ? SESSION_EXPIRED : SESSION_NONE;
|
||
|
}
|
||
|
|
||
|
$query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
|
||
|
$sth = prepare_execute_query($form, $dbh, $query, $session_id);
|
||
|
|
||
|
while (my $ref = $sth->fetchrow_hashref()) {
|
||
|
$self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
|
||
|
next if defined $form->{$ref->{sess_key}};
|
||
|
|
||
|
my $params = $self->_load_value($ref->{sess_value});
|
||
|
$form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
|
||
|
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);
|
||
|
}
|
||
|
|
||
|
$sth->finish();
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return SESSION_OK;
|
||
|
}
|
||
|
|
||
|
sub _load_value {
|
||
|
my ($self, $value) = @_;
|
||
|
sub _load_without_auto_restore_column {
|
||
|
my ($self, $dbh, $session_id) = @_;
|
||
|
|
||
|
return { simple => 1, data => $value } if $value !~ m/^---/;
|
||
|
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);
|
||
|
|
||
|
my %params = ( simple => 1 );
|
||
|
eval {
|
||
|
my $data = YAML::Load($value);
|
||
|
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;
|
||
|
|
||
|
if (ref $data eq 'HASH') {
|
||
|
map { $params{$_} = $data->{$_} } keys %{ $data };
|
||
|
$params{simple} = 0;
|
||
|
next if defined $::form->{$ref->{sess_key}};
|
||
|
|
||
|
} else {
|
||
|
$params{data} = $data;
|
||
|
}
|
||
|
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;
|
||
|
|
||
|
1;
|
||
|
} or $params{data} = $value;
|
||
|
next if defined $::form->{$ref->{sess_key}};
|
||
|
|
||
|
return \%params;
|
||
|
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;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub destroy_session {
|
||
| ... | ... | |
|
$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 @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;
|
||
|
|
||
|
my ($id) = selectrow_query($::form, $dbh, $query, $session_id);
|
||
|
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);
|
||
|
|
||
|
if ($id) {
|
||
|
do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
|
||
| ... | ... | |
|
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);
|
||
|
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');
|
||
|
|
||
|
foreach my $key (sort keys %{ $self->{SESSION} }) {
|
||
|
do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
|
||
|
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);
|
||
|
}
|
||
|
|
||
|
$sth->finish();
|
||
| ... | ... | |
|
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);
|
||
|
$self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key},
|
||
|
value => $key->{value},
|
||
|
auto_restore => $key->{auto_restore});
|
||
|
|
||
|
} else {
|
||
|
my $value = shift @params;
|
||
|
$self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
|
||
|
$self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key,
|
||
|
value => $value);
|
||
|
}
|
||
|
}
|
||
|
|
||
| ... | ... | |
|
sub get_session_value {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
|
||
|
my $self = shift;
|
||
|
my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $params->{data};
|
||
|
return $data;
|
||
|
}
|
||
|
|
||
|
sub create_unique_sesion_value {
|
||
| ... | ... | |
|
$self->{unique_counter}++ while exists $self->{SESSION}->{$key . ($self->{unique_counter} + 1)};
|
||
|
$self->{unique_counter}++;
|
||
|
|
||
|
$value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
|
||
|
data => $value,
|
||
|
};
|
||
|
|
||
|
$self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
|
||
|
$self->set_session_value($key . $self->{unique_counter} => $value);
|
||
|
|
||
|
return $key . $self->{unique_counter};
|
||
|
}
|
||
| ... | ... | |
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub expire_session_keys {
|
||
|
my ($self) = @_;
|
||
|
|
||
|
$self->{SESSION} ||= { };
|
||
|
|
||
|
my @now = gettimeofday();
|
||
|
my $now = $now[0] * 1000000 + $now[1];
|
||
|
|
||
|
$self->delete_session_value(map { $_->[0] }
|
||
|
grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
|
||
|
map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
|
||
|
keys %{ $self->{SESSION} });
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub _has_expiration {
|
||
|
my ($value) = @_;
|
||
|
return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
|
||
|
}
|
||
|
|
||
|
sub set_cookie_environment_variable {
|
||
|
my $self = shift;
|
||
|
$ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
|
||
| ... | ... | |
|
Create a unique key in the session and store C<$value>
|
||
|
there.
|
||
|
|
||
|
If C<$params{expiration}> is set then it is interpreted as a number of
|
||
|
seconds after which the value is removed from the session. It will
|
||
|
never expire if that parameter is falsish.
|
||
|
|
||
|
Returns the key created in the session.
|
||
|
|
||
|
=item C<expire_session_keys>
|
||
|
|
||
|
Removes all keys from the session that have an expiration time set and
|
||
|
whose expiration time is in the past.
|
||
|
|
||
|
=item C<save_session>
|
||
|
|
||
|
Stores the session values in the database. This is the only function
|
||
| SL/Auth/ColumnInformation.pm | ||
|---|---|---|
|
package SL::Auth::ColumnInformation;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use Carp;
|
||
|
use Scalar::Util qw(weaken);
|
||
|
|
||
|
use SL::DBUtils;
|
||
|
|
||
|
sub new {
|
||
|
my ($class, %params) = @_;
|
||
|
|
||
|
my $self = bless {}, $class;
|
||
|
|
||
|
$self->{auth} = $params{auth} || croak "Missing 'auth'";
|
||
|
weaken $self->{auth};
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub _fetch {
|
||
|
my ($self) = @_;
|
||
|
|
||
|
return $self if $self->{info};
|
||
|
|
||
|
my $query = <<SQL;
|
||
|
SELECT a.attname, format_type(a.atttypid, a.atttypmod) AS format_type, d.adsrc, a.attnotnull
|
||
|
FROM pg_attribute a
|
||
|
LEFT JOIN pg_attrdef d ON (a.attrelid = d.adrelid) AND (a.attnum = d.adnum)
|
||
|
WHERE (a.attrelid = 'auth.session_content'::regclass)
|
||
|
AND (a.attnum > 0)
|
||
|
AND NOT a.attisdropped
|
||
|
ORDER BY a.attnum
|
||
|
SQL
|
||
|
|
||
|
$self->{info} = { selectall_as_map($::form, $self->{auth}->dbconnect, $query, 'attname', [ qw(format_type adsrc attnotnull) ]) };
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub info {
|
||
|
my ($self) = @_;
|
||
|
return $self->_fetch->{info};
|
||
|
}
|
||
|
|
||
|
sub has {
|
||
|
my ($self, $column) = @_;
|
||
|
return $self->info->{$column};
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/Auth/SessionValue.pm | ||
|---|---|---|
|
package SL::Auth::SessionValue;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use Scalar::Util qw(weaken);
|
||
|
use YAML;
|
||
|
|
||
|
use SL::DBUtils;
|
||
|
|
||
|
sub new {
|
||
|
my ($class, %params) = @_;
|
||
|
|
||
|
my $self = bless {}, $class;
|
||
|
|
||
|
map { $self->{$_} = $params{$_} } qw(auth key value auto_restore);
|
||
|
|
||
|
$self->{fetched} = exists $params{value};
|
||
|
$self->{parsed} = !$params{raw} && exists $params{value};
|
||
|
|
||
|
# delete $self->{auth};
|
||
|
# $::lxdebug->dump(0, "NEW", $self);
|
||
|
# $self->{auth} = $params{auth};
|
||
|
|
||
|
weaken $self->{auth};
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub get {
|
||
|
my ($self) = @_;
|
||
|
return $self->_fetch->_parse->{value};
|
||
|
}
|
||
|
|
||
|
sub get_dumped {
|
||
|
my ($self) = @_;
|
||
|
return YAML::Dump($self->get);
|
||
|
}
|
||
|
|
||
|
sub _fetch {
|
||
|
my ($self) = @_;
|
||
|
|
||
|
return $self if $self->{fetched};
|
||
|
|
||
|
my $dbh = $self->{auth}->dbconnect;
|
||
|
my $query = qq|SELECT sess_value FROM auth.session_content WHERE (session_id = ?) AND (sess_key = ?)|;
|
||
|
($self->{value}) = selectfirst_array_query($::form, $dbh, $query, $self->{auth}->get_session_id, $self->{key});
|
||
|
$self->{fetched} = 1;
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub _parse {
|
||
|
my ($self) = @_;
|
||
|
|
||
|
$self->{value} = YAML::Load($self->{value}) unless $self->{parsed};
|
||
|
$self->{parsed} = 1;
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub _load_value {
|
||
|
my ($self, $value) = @_;
|
||
|
|
||
|
return { simple => 1, data => $value } if $value !~ m/^---/;
|
||
|
|
||
|
my %params = ( simple => 1 );
|
||
|
eval {
|
||
|
my $data = YAML::Load($value);
|
||
|
|
||
|
if (ref $data eq 'HASH') {
|
||
|
map { $params{$_} = $data->{$_} } keys %{ $data };
|
||
|
$params{simple} = 0;
|
||
|
|
||
|
} else {
|
||
|
$params{data} = $data;
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
} or $params{data} = $value;
|
||
|
|
||
|
return \%params;
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/Dispatcher.pm | ||
|---|---|---|
|
};
|
||
|
|
||
|
# cleanup
|
||
|
$::auth->expire_session_keys->save_session;
|
||
|
$::auth->save_session;
|
||
|
$::auth->expire_sessions;
|
||
|
$::auth->reset;
|
||
|
|
||
| sql/Pg-upgrade2-auth/session_content_auto_restore.sql | ||
|---|---|---|
|
-- @tag: session_content_auto_restore
|
||
|
-- @description: Spalte "auto_restore" in auth.session_content
|
||
|
-- @depends:
|
||
|
-- @charset: utf-8
|
||
|
ALTER TABLE auth.session_content ADD COLUMN auto_restore boolean;
|
||
|
UPDATE auth.session_content SET auto_restore = FALSE;
|
||
Auch abrufbar als: Unified diff
Nicht immer alle Session-Werte automatisch laden und parsen
Durch das Speichern ganzer Forms in der Session wurde das Laden sehr
langsam, weil bei jedem Request alle Session-Werte geladen und mit
YAML geparst wurden. Rief man z.B. ein Erzeugnis mit 50 Einzelteilen
auf, so erhöhte sich dadurch die Requestzeit um eine Sekunde -- bis
die Session gelöscht wird (Logout, Timeout oder bei nicht-FastCGI).
Lösung ist, dass nur diejenigen Werte bei jedem Request automatisch
geladen werden, die entweder 'auto_restore' gesetzt haben, oder die
immer benötigt werden (Login, Passwort, Root-Passwort). Alle anderen
Werte werden nur auf Existenz geprüft und erst bei
$::auth->get_session_value() wirklich geladen und per YAML geparst.