Revision 4344f4e3
Von Moritz Bunkus vor fast 14 Jahren hinzugefügt
| SL/Auth.pm | ||
|---|---|---|
|
use SL::Auth::DB;
|
||
|
use SL::Auth::LDAP;
|
||
|
|
||
|
use SL::SessionFile;
|
||
|
use SL::User;
|
||
|
use SL::DBConnect;
|
||
|
use SL::DBUpgrade2;
|
||
| ... | ... | |
|
|
||
|
$dbh->commit();
|
||
|
|
||
|
SL::SessionFile->destroy_session($session_id);
|
||
|
|
||
|
$session_id = undef;
|
||
|
$self->{SESSION} = { };
|
||
|
}
|
||
| ... | ... | |
|
|
||
|
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();
|
||
|
}
|
||
| SL/SessionFile.pm | ||
|---|---|---|
|
package SL::SessionFile;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use parent qw(Rose::Object);
|
||
|
|
||
|
use Carp;
|
||
|
use File::Path qw(make_path remove_tree);
|
||
|
use English qw(-no_match_vars);
|
||
|
use IO::File;
|
||
|
use POSIX qw(strftime);
|
||
|
|
||
|
use Rose::Object::MakeMethods::Generic
|
||
|
(
|
||
|
scalar => [ qw(fh file_name) ],
|
||
|
);
|
||
|
|
||
|
sub new {
|
||
|
my ($class, $file_name, $mode) = @_;
|
||
|
|
||
|
my $self = $class->SUPER::new;
|
||
|
|
||
|
my $path = $self->prepare_path;
|
||
|
$file_name =~ s:.*/::g;
|
||
|
$file_name = "${path}/${file_name}";
|
||
|
|
||
|
$self->fh(IO::File->new($file_name, $mode)) if $mode;
|
||
|
$self->file_name($file_name);
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub exists {
|
||
|
my ($self) = @_;
|
||
|
return -f $self->file_name;
|
||
|
}
|
||
|
|
||
|
sub size {
|
||
|
my ($self) = @_;
|
||
|
return -s $self->file_name;
|
||
|
}
|
||
|
|
||
|
sub displayable_mtime {
|
||
|
my ($self) = @_;
|
||
|
return '' unless $self->exists;
|
||
|
|
||
|
my @mtime = localtime((stat $self->file_name)[9]);
|
||
|
return $::locale->format_date(\%::myconfig, $mtime[5] + 1900, $mtime[4] + 1, $mtime[3]) . ' ' . strftime('%H:%M:%S', @mtime);
|
||
|
}
|
||
|
|
||
|
sub get_path {
|
||
|
die "No session ID" unless $::auth->get_session_id;
|
||
|
return "users/session_files/" . $::auth->get_session_id;
|
||
|
}
|
||
|
|
||
|
sub prepare_path {
|
||
|
my $path = get_path();
|
||
|
return $path if -d $path;
|
||
|
make_path $path;
|
||
|
die "Creating ${path} failed" unless -d $path;
|
||
|
return $path;
|
||
|
}
|
||
|
|
||
|
sub destroy_session {
|
||
|
my ($class, $session_id) = @_;
|
||
|
|
||
|
$session_id =~ s/[^a-z0-9]//gi;
|
||
|
remove_tree "users/session_files/$session_id" if $session_id;
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
__END__
|
||
|
|
||
|
=pod
|
||
|
|
||
|
=encoding utf8
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
SL::SessionFile - Create files that are removed when the session is
|
||
|
destroyed or expires
|
||
|
|
||
|
=head1 SYNOPSIS
|
||
|
|
||
|
use SL::SessionFile;
|
||
|
|
||
|
# Create a session file named "customer.csv" (relative names only)
|
||
|
my $sfile = SL::SessionFile->new("customer.csv", "w");
|
||
|
$sfile->fh->print("col1;col2;col3\n" .
|
||
|
"value1;value2;value3\n");
|
||
|
$sfile->fh->close;
|
||
|
|
||
|
# Does temporary file exist?
|
||
|
my $sfile = SL::SessionFile->new("customer.csv");
|
||
|
if ($sfile->exists) {
|
||
|
print "file exists; size " . $sfile->size . " bytes; mtime " . $sfile->displayable_mtime . "\n";
|
||
|
}
|
||
|
|
||
|
A small class that wraps around files that only exist as long as the
|
||
|
user's session exists. The session expiration mechanism will delete
|
||
|
all session files when the session itself is removed due to expiry or
|
||
|
the user logging out.
|
||
|
|
||
|
Files are stored in session-specific folders in
|
||
|
C<users/session_files/SESSIONID>.
|
||
|
|
||
|
=head1 MEMBER FUNCTIONS
|
||
|
|
||
|
=over 4
|
||
|
|
||
|
=item C<new $file_name, [$mode]>
|
||
|
|
||
|
Create a new instance. C<$file_name> is a relative file name (path
|
||
|
components are stripped) to the session-specific temporary directory.
|
||
|
|
||
|
If C<$mode> is given then try to open the file as an instance of
|
||
|
C<IO::File>. C<$mode> is passed through to C<IO::File::new>.
|
||
|
|
||
|
=item C<fh>
|
||
|
|
||
|
Returns the instance of C<IO::File> associated with the file.
|
||
|
|
||
|
=item C<file_name>
|
||
|
|
||
|
Returns the full relative file name associated with this instance. If
|
||
|
it has been created for "customer.csv" then the value returned might
|
||
|
be C<users/session_files/e8789b98721347/customer.csv>.
|
||
|
|
||
|
=item C<exists>
|
||
|
|
||
|
Returns trueish if the file exists.
|
||
|
|
||
|
=item C<size>
|
||
|
|
||
|
Returns the file's size in bytes.
|
||
|
|
||
|
=item C<displayable_mtime>
|
||
|
|
||
|
Returns the modification time suitable for display (e.g. date
|
||
|
formatted according to the user's date format), e.g.
|
||
|
C<22.01.2011 14:12:22>.
|
||
|
|
||
|
=back
|
||
|
|
||
|
=head1 OBJECT FUNCTIONS
|
||
|
|
||
|
=over 4
|
||
|
|
||
|
=item C<get_path>
|
||
|
|
||
|
Returns the name of the session-specific directory used for file
|
||
|
storage relative to the Lx-Office installation folder.
|
||
|
|
||
|
=item C<prepare_path>
|
||
|
|
||
|
Creates all directories in C<get_path> if they do not exist. Returns
|
||
|
the same as C<get_path>.
|
||
|
|
||
|
=item C<destroy_session $id>
|
||
|
|
||
|
Removes all files and the directory belonging to the session C<$id>.
|
||
|
|
||
|
=back
|
||
|
|
||
|
=head1 BUGS
|
||
|
|
||
|
Nothing here yet.
|
||
|
|
||
|
=head1 AUTHOR
|
||
|
|
||
|
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
|
||
|
|
||
|
=cut
|
||
Auch abrufbar als: Unified diff
Session-basierte Dateien (die also bei Ablauf gelöscht werden)
Conflicts: