Session-basierte Dateien (die also bei Ablauf gelöscht werden)
authorMoritz Bunkus <moritz@bunkus.org>
Mon, 2 May 2011 15:24:04 +0000 (17:24 +0200)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Thu, 16 Jun 2011 06:44:11 +0000 (08:44 +0200)
Conflicts:

SL/Auth.pm

SL/Auth.pm
SL/SessionFile.pm [new file with mode: 0644]

index adf5810..784b185 100644 (file)
@@ -12,6 +12,7 @@ use SL::Auth::Constants qw(:all);
 use SL::Auth::DB;
 use SL::Auth::LDAP;
 
+use SL::SessionFile;
 use SL::User;
 use SL::DBConnect;
 use SL::DBUpgrade2;
@@ -555,6 +556,8 @@ sub destroy_session {
 
     $dbh->commit();
 
+    SL::SessionFile->destroy_session($session_id);
+
     $session_id      = undef;
     $self->{SESSION} = { };
   }
@@ -571,24 +574,27 @@ sub expire_sessions {
 
   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();
 }
diff --git a/SL/SessionFile.pm b/SL/SessionFile.pm
new file mode 100644 (file)
index 0000000..12f4984
--- /dev/null
@@ -0,0 +1,173 @@
+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