487 |
487 |
|
488 |
488 |
while (my $ref = $sth->fetchrow_hashref()) {
|
489 |
489 |
$self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
|
490 |
|
$form->{$ref->{sess_key}} = $self->_load_value($ref->{sess_value}) if (!defined $form->{$ref->{sess_key}});
|
|
490 |
next if defined $form->{$ref->{sess_key}};
|
|
491 |
|
|
492 |
my $params = $self->_load_value($ref->{sess_value});
|
|
493 |
$form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
|
491 |
494 |
}
|
492 |
495 |
|
493 |
496 |
$sth->finish();
|
... | ... | |
498 |
501 |
}
|
499 |
502 |
|
500 |
503 |
sub _load_value {
|
501 |
|
return $_[1] if $_[1] !~ m/^---/;
|
|
504 |
my ($self, $value) = @_;
|
|
505 |
|
|
506 |
return { simple => 1, data => $value } if $value !~ m/^---/;
|
502 |
507 |
|
503 |
|
my $value;
|
|
508 |
my %params = ( simple => 1 );
|
504 |
509 |
eval {
|
505 |
|
$value = YAML::Load($_[1]);
|
|
510 |
my $data = YAML::Load($value);
|
|
511 |
|
|
512 |
if (ref $data eq 'HASH') {
|
|
513 |
map { $params{$_} = $data->{$_} } keys %{ $data };
|
|
514 |
$params{simple} = 0;
|
|
515 |
|
|
516 |
} else {
|
|
517 |
$params{data} = $data;
|
|
518 |
}
|
|
519 |
|
506 |
520 |
1;
|
507 |
|
} or return $_[1];
|
|
521 |
} or $params{data} = $value;
|
508 |
522 |
|
509 |
|
return $value;
|
|
523 |
return \%params;
|
510 |
524 |
}
|
511 |
525 |
|
512 |
526 |
sub destroy_session {
|
... | ... | |
643 |
657 |
$self->{SESSION} ||= { };
|
644 |
658 |
|
645 |
659 |
while (my ($key, $value) = each %params) {
|
646 |
|
$self->{SESSION}->{ $key } = YAML::Dump($value);
|
|
660 |
$self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
|
647 |
661 |
}
|
648 |
662 |
|
649 |
663 |
$main::lxdebug->leave_sub();
|
... | ... | |
667 |
681 |
sub get_session_value {
|
668 |
682 |
$main::lxdebug->enter_sub();
|
669 |
683 |
|
670 |
|
my $self = shift;
|
671 |
|
my $value = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : undef;
|
|
684 |
my $self = shift;
|
|
685 |
my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
|
672 |
686 |
|
673 |
687 |
$main::lxdebug->leave_sub();
|
674 |
688 |
|
675 |
|
return $value;
|
|
689 |
return $params->{data};
|
|
690 |
}
|
|
691 |
|
|
692 |
sub create_unique_sesion_value {
|
|
693 |
my ($self, $value, %params) = @_;
|
|
694 |
|
|
695 |
$self->{SESSION} ||= { };
|
|
696 |
|
|
697 |
my @now = gettimeofday();
|
|
698 |
my $key = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
|
|
699 |
$self->{unique_counter} ||= 0;
|
|
700 |
|
|
701 |
$self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
|
|
702 |
$self->{unique_counter}++;
|
|
703 |
|
|
704 |
$value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
|
|
705 |
no_auto => !$params{auto_restore},
|
|
706 |
data => $value,
|
|
707 |
};
|
|
708 |
|
|
709 |
$self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
|
|
710 |
|
|
711 |
return $key . $self->{unique_counter};
|
|
712 |
}
|
|
713 |
|
|
714 |
sub save_form_in_session {
|
|
715 |
my ($self, %params) = @_;
|
|
716 |
|
|
717 |
my $form = delete($params{form}) || $::form;
|
|
718 |
my $non_scalars = delete $params{non_scalars};
|
|
719 |
my $data = {};
|
|
720 |
|
|
721 |
my %skip_keys = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
|
|
722 |
|
|
723 |
foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
|
|
724 |
$data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
|
|
725 |
}
|
|
726 |
|
|
727 |
return $self->create_unique_sesion_value($data, %params);
|
|
728 |
}
|
|
729 |
|
|
730 |
sub restore_form_from_session {
|
|
731 |
my ($self, $key, %params) = @_;
|
|
732 |
|
|
733 |
my $data = $self->get_session_value($key);
|
|
734 |
return $self unless $data;
|
|
735 |
|
|
736 |
my $form = delete($params{form}) || $::form;
|
|
737 |
my $clobber = exists $params{clobber} ? $params{clobber} : 1;
|
|
738 |
|
|
739 |
map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
|
|
740 |
|
|
741 |
return $self;
|
|
742 |
}
|
|
743 |
|
|
744 |
sub expire_session_keys {
|
|
745 |
my ($self) = @_;
|
|
746 |
|
|
747 |
$self->{SESSION} ||= { };
|
|
748 |
|
|
749 |
my @now = gettimeofday();
|
|
750 |
my $now = $now[0] * 1000000 + $now[1];
|
|
751 |
|
|
752 |
$self->delete_session_value(map { $_->[0] }
|
|
753 |
grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
|
|
754 |
map { [ $_, $self->_load_value($self->{SESSION}->{$_}) ] }
|
|
755 |
keys %{ $self->{SESSION} });
|
|
756 |
|
|
757 |
return $self;
|
|
758 |
}
|
|
759 |
|
|
760 |
sub _has_expiration {
|
|
761 |
my ($value) = @_;
|
|
762 |
return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
|
676 |
763 |
}
|
677 |
764 |
|
678 |
765 |
sub set_cookie_environment_variable {
|
... | ... | |
1067 |
1154 |
}
|
1068 |
1155 |
|
1069 |
1156 |
1;
|
|
1157 |
__END__
|
|
1158 |
|
|
1159 |
=pod
|
|
1160 |
|
|
1161 |
=encoding utf8
|
|
1162 |
|
|
1163 |
=head1 NAME
|
|
1164 |
|
|
1165 |
SL::Auth - Authentication and session handling
|
|
1166 |
|
|
1167 |
=head1 FUNCTIONS
|
|
1168 |
|
|
1169 |
=over 4
|
|
1170 |
|
|
1171 |
=item C<set_session_value %values>
|
|
1172 |
|
|
1173 |
Store all key/value pairs in C<%values> in the session. All of these
|
|
1174 |
values are copied back into C<$::form> in the next request
|
|
1175 |
automatically.
|
|
1176 |
|
|
1177 |
The values can be any Perl structure. They are stored as YAML dumps.
|
|
1178 |
|
|
1179 |
=item C<get_session_value $key>
|
|
1180 |
|
|
1181 |
Retrieve a value from the session. Returns C<undef> if the value
|
|
1182 |
doesn't exist.
|
|
1183 |
|
|
1184 |
=item C<create_unique_sesion_value $value, %params>
|
|
1185 |
|
|
1186 |
Create a unique key in the session and store C<$value>
|
|
1187 |
there.
|
|
1188 |
|
|
1189 |
If C<$params{expiration}> is set then it is interpreted as a number of
|
|
1190 |
seconds after which the value is removed from the session. It will
|
|
1191 |
never expire if that parameter is falsish.
|
|
1192 |
|
|
1193 |
If C<$params{auto_restore}> is trueish then the value will be copied
|
|
1194 |
into C<$::form> upon the next request automatically. It defaults to
|
|
1195 |
C<false> and has therefore different behaviour than
|
|
1196 |
L</set_session_value>.
|
|
1197 |
|
|
1198 |
Returns the key created in the session.
|
|
1199 |
|
|
1200 |
=item C<expire_session_keys>
|
|
1201 |
|
|
1202 |
Removes all keys from the session that have an expiration time set and
|
|
1203 |
whose expiration time is in the past.
|
|
1204 |
|
|
1205 |
=item C<save_session>
|
|
1206 |
|
|
1207 |
Stores the session values in the database. This is the only function
|
|
1208 |
that actually stores stuff in the database. Neither the various
|
|
1209 |
setters nor the deleter access the database.
|
|
1210 |
|
|
1211 |
=item <save_form_in_session %params>
|
|
1212 |
|
|
1213 |
Stores the content of C<$params{form}> (default: C<$::form>) in the
|
|
1214 |
session using L</create_unique_sesion_value>.
|
|
1215 |
|
|
1216 |
If C<$params{non_scalars}> is trueish then non-scalar values will be
|
|
1217 |
stored as well. Default is to only store scalar values.
|
|
1218 |
|
|
1219 |
The following keys will never be saved: C<login>, C<password>,
|
|
1220 |
C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
|
|
1221 |
can be given as an array ref in C<$params{skip_keys}>.
|
|
1222 |
|
|
1223 |
Returns the unique key under which the form is stored.
|
|
1224 |
|
|
1225 |
=item <restore_form_from_session $key, %params>
|
|
1226 |
|
|
1227 |
Restores the form from the session into C<$params{form}> (default:
|
|
1228 |
C<$::form>).
|
|
1229 |
|
|
1230 |
If C<$params{clobber}> is falsish then existing values with the same
|
|
1231 |
key in C<$params{form}> will not be overwritten. C<$params{clobber}>
|
|
1232 |
is on by default.
|
|
1233 |
|
|
1234 |
Returns C<$self>.
|
|
1235 |
|
|
1236 |
=back
|
|
1237 |
|
|
1238 |
=head1 BUGS
|
|
1239 |
|
|
1240 |
Nothing here yet.
|
|
1241 |
|
|
1242 |
=head1 AUTHOR
|
|
1243 |
|
|
1244 |
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
|
|
1245 |
|
|
1246 |
=cut
|
Methoden zum Speichern von eindeutigen Keys in der Session
Außerdem: Form dumpen und wiederherstellen; Werte nur für einen
bestimmten Zeitraum speichern.