Revision e0ba33ff
Von Moritz Bunkus vor mehr als 13 Jahren hinzugefügt
SL/Auth.pm | ||
---|---|---|
8 | 8 |
use List::MoreUtils qw(uniq); |
9 | 9 |
use YAML; |
10 | 10 |
|
11 |
use SL::Auth::ColumnInformation; |
|
11 | 12 |
use SL::Auth::Constants qw(:all); |
12 | 13 |
use SL::Auth::DB; |
13 | 14 |
use SL::Auth::LDAP; |
14 | 15 |
use SL::Auth::Password; |
16 |
use SL::Auth::SessionValue; |
|
15 | 17 |
|
16 | 18 |
use SL::SessionFile; |
17 | 19 |
use SL::User; |
... | ... | |
29 | 31 |
|
30 | 32 |
bless $self, $type; |
31 | 33 |
|
32 |
$self->{SESSION} = { }; |
|
33 |
|
|
34 | 34 |
$self->_read_auth_config(); |
35 |
$self->reset; |
|
35 | 36 |
|
36 | 37 |
$main::lxdebug->leave_sub(); |
37 | 38 |
|
... | ... | |
41 | 42 |
sub reset { |
42 | 43 |
my ($self, %params) = @_; |
43 | 44 |
|
44 |
$self->{SESSION} = { }; |
|
45 |
$self->{FULL_RIGHTS} = { }; |
|
46 |
$self->{RIGHTS} = { }; |
|
47 |
$self->{unique_counter} = 0; |
|
45 |
$self->{SESSION} = { }; |
|
46 |
$self->{FULL_RIGHTS} = { }; |
|
47 |
$self->{RIGHTS} = { }; |
|
48 |
$self->{unique_counter} = 0; |
|
49 |
$self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self); |
|
48 | 50 |
} |
49 | 51 |
|
50 | 52 |
sub get_user_dbh { |
... | ... | |
537 | 539 |
return $cookie ? SESSION_EXPIRED : SESSION_NONE; |
538 | 540 |
} |
539 | 541 |
|
540 |
$query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|; |
|
541 |
$sth = prepare_execute_query($form, $dbh, $query, $session_id); |
|
542 |
|
|
543 |
while (my $ref = $sth->fetchrow_hashref()) { |
|
544 |
$self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value}; |
|
545 |
next if defined $form->{$ref->{sess_key}}; |
|
546 |
|
|
547 |
my $params = $self->_load_value($ref->{sess_value}); |
|
548 |
$form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple}; |
|
542 |
if ($self->{column_information}->has('auto_restore')) { |
|
543 |
$self->_load_with_auto_restore_column($dbh, $session_id); |
|
544 |
} else { |
|
545 |
$self->_load_without_auto_restore_column($dbh, $session_id); |
|
549 | 546 |
} |
550 | 547 |
|
551 |
$sth->finish(); |
|
552 |
|
|
553 | 548 |
$main::lxdebug->leave_sub(); |
554 | 549 |
|
555 | 550 |
return SESSION_OK; |
556 | 551 |
} |
557 | 552 |
|
558 |
sub _load_value {
|
|
559 |
my ($self, $value) = @_;
|
|
553 |
sub _load_without_auto_restore_column {
|
|
554 |
my ($self, $dbh, $session_id) = @_;
|
|
560 | 555 |
|
561 |
return { simple => 1, data => $value } if $value !~ m/^---/; |
|
556 |
my $query = <<SQL; |
|
557 |
SELECT sess_key, sess_value |
|
558 |
FROM auth.session_content |
|
559 |
WHERE (session_id = ?) |
|
560 |
SQL |
|
561 |
my $sth = prepare_execute_query($::form, $dbh, $query, $session_id); |
|
562 | 562 |
|
563 |
my %params = ( simple => 1 ); |
|
564 |
eval { |
|
565 |
my $data = YAML::Load($value); |
|
563 |
while (my $ref = $sth->fetchrow_hashref) { |
|
564 |
my $value = SL::Auth::SessionValue->new(auth => $self, |
|
565 |
key => $ref->{sess_key}, |
|
566 |
value => $ref->{sess_value}, |
|
567 |
raw => 1); |
|
568 |
$self->{SESSION}->{ $ref->{sess_key} } = $value; |
|
566 | 569 |
|
567 |
if (ref $data eq 'HASH') { |
|
568 |
map { $params{$_} = $data->{$_} } keys %{ $data }; |
|
569 |
$params{simple} = 0; |
|
570 |
next if defined $::form->{$ref->{sess_key}}; |
|
570 | 571 |
|
571 |
} else { |
|
572 |
$params{data} = $data; |
|
573 |
} |
|
572 |
my $data = $value->get; |
|
573 |
$::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data; |
|
574 |
} |
|
575 |
} |
|
576 |
|
|
577 |
sub _load_with_auto_restore_column { |
|
578 |
my ($self, $dbh, $session_id) = @_; |
|
579 |
|
|
580 |
my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw); |
|
581 |
|
|
582 |
my $query = <<SQL; |
|
583 |
SELECT sess_key, sess_value, auto_restore |
|
584 |
FROM auth.session_content |
|
585 |
WHERE (session_id = ?) |
|
586 |
AND ( auto_restore |
|
587 |
OR sess_key IN (${auto_restore_keys})) |
|
588 |
SQL |
|
589 |
my $sth = prepare_execute_query($::form, $dbh, $query, $session_id); |
|
590 |
|
|
591 |
while (my $ref = $sth->fetchrow_hashref) { |
|
592 |
my $value = SL::Auth::SessionValue->new(auth => $self, |
|
593 |
key => $ref->{sess_key}, |
|
594 |
value => $ref->{sess_value}, |
|
595 |
auto_restore => $ref->{auto_restore}, |
|
596 |
raw => 1); |
|
597 |
$self->{SESSION}->{ $ref->{sess_key} } = $value; |
|
574 | 598 |
|
575 |
1; |
|
576 |
} or $params{data} = $value; |
|
599 |
next if defined $::form->{$ref->{sess_key}}; |
|
577 | 600 |
|
578 |
return \%params; |
|
601 |
my $data = $value->get; |
|
602 |
$::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data; |
|
603 |
} |
|
604 |
|
|
605 |
$sth->finish; |
|
606 |
|
|
607 |
$query = <<SQL; |
|
608 |
SELECT sess_key |
|
609 |
FROM auth.session_content |
|
610 |
WHERE (session_id = ?) |
|
611 |
AND NOT COALESCE(auto_restore, FALSE) |
|
612 |
AND (sess_key NOT IN (${auto_restore_keys})) |
|
613 |
SQL |
|
614 |
$sth = prepare_execute_query($::form, $dbh, $query, $session_id); |
|
615 |
|
|
616 |
while (my $ref = $sth->fetchrow_hashref) { |
|
617 |
my $value = SL::Auth::SessionValue->new(auth => $self, |
|
618 |
key => $ref->{sess_key}); |
|
619 |
$self->{SESSION}->{ $ref->{sess_key} } = $value; |
|
620 |
} |
|
579 | 621 |
} |
580 | 622 |
|
581 | 623 |
sub destroy_session { |
... | ... | |
665 | 707 |
$dbh->begin_work unless $provided_dbh; |
666 | 708 |
|
667 | 709 |
do_query($::form, $dbh, qq|LOCK auth.session_content|); |
668 |
do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id); |
|
669 | 710 |
|
670 |
my $query = qq|SELECT id FROM auth.session WHERE id = ?|; |
|
711 |
my @unfetched_keys = map { $_->{key} } |
|
712 |
grep { ! $_->{fetched} } |
|
713 |
values %{ $self->{SESSION} }; |
|
714 |
# $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]); |
|
715 |
# $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]); |
|
716 |
my $query = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|; |
|
717 |
$query .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys; |
|
671 | 718 |
|
672 |
my ($id) = selectrow_query($::form, $dbh, $query, $session_id); |
|
719 |
do_query($::form, $dbh, $query, $session_id, @unfetched_keys); |
|
720 |
|
|
721 |
my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id); |
|
673 | 722 |
|
674 | 723 |
if ($id) { |
675 | 724 |
do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id); |
... | ... | |
677 | 726 |
do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR}); |
678 | 727 |
} |
679 | 728 |
|
680 |
if (%{ $self->{SESSION} }) { |
|
681 |
my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|; |
|
682 |
my $sth = prepare_query($::form, $dbh, $query); |
|
729 |
my @values_to_save = grep { $_->{fetched} } |
|
730 |
values %{ $self->{SESSION} }; |
|
731 |
if (@values_to_save) { |
|
732 |
my ($columns, $placeholders) = ('', ''); |
|
733 |
my $auto_restore = $self->{column_information}->has('auto_restore'); |
|
683 | 734 |
|
684 |
foreach my $key (sort keys %{ $self->{SESSION} }) { |
|
685 |
do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key}); |
|
735 |
if ($auto_restore) { |
|
736 |
$columns .= ', auto_restore'; |
|
737 |
$placeholders .= ', ?'; |
|
738 |
} |
|
739 |
|
|
740 |
$query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|; |
|
741 |
my $sth = prepare_query($::form, $dbh, $query); |
|
742 |
|
|
743 |
foreach my $value (@values_to_save) { |
|
744 |
my @values = ($value->{key}, $value->get_dumped); |
|
745 |
push @values, $value->{auto_restore} if $auto_restore; |
|
746 |
|
|
747 |
do_statement($::form, $sth, $query, $session_id, @values); |
|
686 | 748 |
} |
687 | 749 |
|
688 | 750 |
$sth->finish(); |
... | ... | |
704 | 766 |
my $key = shift @params; |
705 | 767 |
|
706 | 768 |
if (ref $key eq 'HASH') { |
707 |
my $value = { data => $key->{value}, |
|
708 |
auto_restore => $key->{auto_restore}, |
|
709 |
}; |
|
710 |
$self->{SESSION}->{ $key->{key} } = YAML::Dump($value); |
|
769 |
$self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key => $key->{key}, |
|
770 |
value => $key->{value}, |
|
771 |
auto_restore => $key->{auto_restore}); |
|
711 | 772 |
|
712 | 773 |
} else { |
713 | 774 |
my $value = shift @params; |
714 |
$self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value); |
|
775 |
$self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key => $key, |
|
776 |
value => $value); |
|
715 | 777 |
} |
716 | 778 |
} |
717 | 779 |
|
... | ... | |
736 | 798 |
sub get_session_value { |
737 | 799 |
$main::lxdebug->enter_sub(); |
738 | 800 |
|
739 |
my $self = shift;
|
|
740 |
my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
|
|
801 |
my $self = shift; |
|
802 |
my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
|
|
741 | 803 |
|
742 | 804 |
$main::lxdebug->leave_sub(); |
743 | 805 |
|
744 |
return $params->{data};
|
|
806 |
return $data;
|
|
745 | 807 |
} |
746 | 808 |
|
747 | 809 |
sub create_unique_sesion_value { |
... | ... | |
756 | 818 |
$self->{unique_counter}++ while exists $self->{SESSION}->{$key . ($self->{unique_counter} + 1)}; |
757 | 819 |
$self->{unique_counter}++; |
758 | 820 |
|
759 |
$value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef, |
|
760 |
data => $value, |
|
761 |
}; |
|
762 |
|
|
763 |
$self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value); |
|
821 |
$self->set_session_value($key . $self->{unique_counter} => $value); |
|
764 | 822 |
|
765 | 823 |
return $key . $self->{unique_counter}; |
766 | 824 |
} |
... | ... | |
795 | 853 |
return $self; |
796 | 854 |
} |
797 | 855 |
|
798 |
sub expire_session_keys { |
|
799 |
my ($self) = @_; |
|
800 |
|
|
801 |
$self->{SESSION} ||= { }; |
|
802 |
|
|
803 |
my @now = gettimeofday(); |
|
804 |
my $now = $now[0] * 1000000 + $now[1]; |
|
805 |
|
|
806 |
$self->delete_session_value(map { $_->[0] } |
|
807 |
grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) } |
|
808 |
map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] } |
|
809 |
keys %{ $self->{SESSION} }); |
|
810 |
|
|
811 |
return $self; |
|
812 |
} |
|
813 |
|
|
814 |
sub _has_expiration { |
|
815 |
my ($value) = @_; |
|
816 |
return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data}; |
|
817 |
} |
|
818 |
|
|
819 | 856 |
sub set_cookie_environment_variable { |
820 | 857 |
my $self = shift; |
821 | 858 |
$ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}"; |
... | ... | |
1257 | 1294 |
Create a unique key in the session and store C<$value> |
1258 | 1295 |
there. |
1259 | 1296 |
|
1260 |
If C<$params{expiration}> is set then it is interpreted as a number of |
|
1261 |
seconds after which the value is removed from the session. It will |
|
1262 |
never expire if that parameter is falsish. |
|
1263 |
|
|
1264 | 1297 |
Returns the key created in the session. |
1265 | 1298 |
|
1266 |
=item C<expire_session_keys> |
|
1267 |
|
|
1268 |
Removes all keys from the session that have an expiration time set and |
|
1269 |
whose expiration time is in the past. |
|
1270 |
|
|
1271 | 1299 |
=item C<save_session> |
1272 | 1300 |
|
1273 | 1301 |
Stores the session values in the database. This is the only function |
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.