rt/lib/RT/Interface/Web/Session.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 package RT::Interface::Web::Session;
  50 use warnings;
  51 use strict;
  52
  53 use RT::CurrentUser;
  54
  55 =head1 NAME
  56
  57 RT::Interface::Web::Session - RT web session class
  58
  59 =head1 SYNOPSYS
  60
  61
  62 =head1 DESCRIPTION
  63
  64 RT session class and utilities.
  65
  66 CLASS METHODS can be used without creating object instances,
  67 it's mainly utilities to clean unused session records.
  68
  69 Object is tied hash and can be used to access session data.
  70
  71 =head1 METHODS
  72
  73 =head2 CLASS METHODS
  74
  75 =head3 Class
  76
  77 Returns name of the class that is used as sessions storage.
  78
  79 =cut
  80
  81 sub Class {
  82     my $self = shift;
  83
  84     my $class = RT->Config->Get('WebSessionClass')
  85              || $self->Backends->{RT->Config->Get('DatabaseType')}
  86              || 'Apache::Session::File';
  87     $class->require or die "Can't load $class: $@";
  88     return $class;
  89 }
  90
  91 =head3 Backends
  92
  93 Returns hash reference with names of the databases as keys and
  94 sessions class names as values.
  95
  96 =cut
  97
  98 sub Backends {
  99     return {
 100         mysql  => 'Apache::Session::MySQL',
 101         Pg     => 'Apache::Session::Postgres',
 102         Oracle => 'Apache::Session::Oracle',
 103     };
 104 }
 105
 106 =head3 Attributes
 107
 108 Returns hash reference with attributes that are used to create
 109 new session objects.
 110
 111 =cut
 112
 113 sub Attributes {
 114     my $class = $_[0]->Class;
 115     my $res;
 116     if ( my %props = RT->Config->Get('WebSessionProperties') ) {
 117         $res = \%props;
 118     }
 119     elsif ( $class->isa('Apache::Session::File') ) {
 120         $res = {
 121             Directory     => $RT::MasonSessionDir,
 122             LockDirectory => $RT::MasonSessionDir,
 123             Transaction   => 1,
 124         };
 125     }
 126     else {
 127         $res = {
 128             Handle      => $RT::Handle->dbh,
 129             LockHandle  => $RT::Handle->dbh,
 130             Transaction => 1,
 131         };
 132     }
 133     $res->{LongReadLen} = RT->Config->Get('MaxAttachmentSize')
 134         if $class->isa('Apache::Session::Oracle');
 135     return $res;
 136 }
 137
 138 =head3 Ids
 139
 140 Returns array ref with list of the session IDs.
 141
 142 =cut
 143
 144 sub Ids {
 145     my $self = shift || __PACKAGE__;
 146     my $attributes = $self->Attributes;
 147     if( $attributes->{Directory} ) {
 148         return $self->_IdsDir( $attributes->{Directory} );
 149     } else {
 150         return $self->_IdsDB( $RT::Handle->dbh );
 151     }
 152 }
 153
 154 sub _IdsDir {
 155     my ($self, $dir) = @_;
 156     require File::Find;
 157     my %file;
 158     File::Find::find(
 159         sub { return unless /^[a-zA-Z0-9]+$/;
 160               $file{$_} = (stat($_))[9];
 161             },
 162         $dir,
 163     );
 164
 165     return [ sort { $file{$a} <=> $file{$b} } keys %file ];
 166 }
 167
 168 sub _IdsDB {
 169     my ($self, $dbh) = @_;
 170     my $ids = $dbh->selectcol_arrayref("SELECT id FROM sessions ORDER BY LastUpdated DESC");
 171     die "couldn't get ids: ". $dbh->errstr if $dbh->errstr;
 172     return $ids;
 173 }
 174
 175 =head3 ClearOld
 176
 177 Takes seconds and deletes all sessions that are older.
 178
 179 =cut
 180
 181 sub ClearOld {
 182     my $class = shift || __PACKAGE__;
 183     my $attributes = $class->Attributes;
 184     if( $attributes->{Directory} ) {
 185         return $class->_ClearOldDir( $attributes->{Directory}, @_ );
 186     } else {
 187         return $class->_ClearOldDB( $RT::Handle->dbh, @_ );
 188     }
 189 }
 190
 191 sub _ClearOldDB {
 192     my ($self, $dbh, $older_than) = @_;
 193     my $rows;
 194     unless( int $older_than ) {
 195         $rows = $dbh->do("DELETE FROM sessions");
 196         die "couldn't delete sessions: ". $dbh->errstr unless defined $rows;
 197     } else {
 198         require POSIX;
 199         my $date = POSIX::strftime("%Y-%m-%d %H:%M", localtime( time - int $older_than ) );
 200
 201         my $sth = $dbh->prepare("DELETE FROM sessions WHERE LastUpdated < ?");
 202         die "couldn't prepare query: ". $dbh->errstr unless $sth;
 203         $rows = $sth->execute( $date );
 204         die "couldn't execute query: ". $dbh->errstr unless defined $rows;
 205     }
 206
 207     $RT::Logger->info("successfully deleted $rows sessions");
 208     return;
 209 }
 210
 211 sub _ClearOldDir {
 212     my ($self, $dir, $older_than) = @_;
 213
 214     require File::Spec if int $older_than;
 215
 216     my $now = time;
 217     my $class = $self->Class;
 218     my $attrs = $self->Attributes;
 219
 220     foreach my $id( @{ $self->Ids } ) {
 221         if( int $older_than ) {
 222             my $mtime = (stat(File::Spec->catfile($dir,$id)))[9];
 223             if( $mtime > $now - $older_than ) {
 224                 $RT::Logger->debug("skipped session '$id', isn't old");
 225                 next;
 226             }
 227         }
 228
 229         my %session;
 230         local $@;
 231         eval { tie %session, $class, $id, $attrs };
 232         if( $@ ) {
 233             $RT::Logger->debug("skipped session '$id', couldn't load: $@");
 234             next;
 235         }
 236         tied(%session)->delete;
 237         $RT::Logger->info("successfully deleted session '$id'");
 238     }
 239
 240     # Apache::Session::Lock::File will clean out locks older than X, but it
 241     # leaves around bogus locks if they're too new, even though they're
 242     # guaranteed dead.  On even just largeish installs, the accumulated number
 243     # of them may bump into ext3/4 filesystem limits since Apache::Session
 244     # doesn't use a fan-out tree.
 245     my $lock = Apache::Session::Lock::File->new;
 246     $lock->clean( $dir, $older_than );
 247
 248     # Take matters into our own hands and clear bogus locks hanging around
 249     # regardless of how recent they are.
 250     $self->ClearOrphanLockFiles($dir);
 251
 252     return;
 253 }
 254
 255 =head3 ClearOrphanLockFiles
 256
 257 Takes a directory in which to look for L<Apache::Session::Lock::File> locks
 258 which no longer have a corresponding session file.  If not provided, the
 259 directory is taken from the session configuration data.
 260
 261 =cut
 262
 263 sub ClearOrphanLockFiles {
 264     my $class = shift;
 265     my $dir   = shift || $class->Attributes->{Directory}
 266         or return;
 267
 268     if (opendir my $dh, $dir) {
 269         for (readdir $dh) {
 270             next unless /^Apache-Session-([0-9a-f]{32})\.lock$/;
 271             next if -e "$dir/$1";
 272
 273             RT->Logger->debug("deleting orphaned session lockfile '$_'");
 274
 275             unlink "$dir/$_"
 276                 or warn "Failed to unlink session lockfile $dir/$_: $!";
 277         }
 278         closedir $dh;
 279     } else {
 280         warn "Unable to open directory '$dir' for reading: $!";
 281     }
 282 }
 283
 284 =head3 ClearByUser
 285
 286 Checks all sessions and if user has more then one session
 287 then leave only the latest one.
 288
 289 =cut
 290
 291 sub ClearByUser {
 292     my $self = shift || __PACKAGE__;
 293     my $class = $self->Class;
 294     my $attrs = $self->Attributes;
 295
 296     my $deleted;
 297     my %seen = ();
 298     foreach my $id( @{ $self->Ids } ) {
 299         my %session;
 300         local $@;
 301         eval { tie %session, $class, $id, $attrs };
 302         if( $@ ) {
 303             $RT::Logger->debug("skipped session '$id', couldn't load: $@");
 304             next;
 305         }
 306         if( $session{'CurrentUser'} && $session{'CurrentUser'}->id ) {
 307             unless( $seen{ $session{'CurrentUser'}->id }++ ) {
 308                 $RT::Logger->debug("skipped session '$id', first user's session");
 309                 next;
 310             }
 311         }
 312         tied(%session)->delete;
 313         $RT::Logger->info("successfully deleted session '$id'");
 314         $deleted++;
 315     }
 316     $self->ClearOrphanLockFiles if $deleted;
 317 }
 318
 319 sub TIEHASH {
 320     my $self = shift;
 321     my $id = shift;
 322
 323     my $class = $self->Class;
 324     my $attrs = $self->Attributes;
 325
 326     my %session;
 327
 328     local $@;
 329     eval { tie %session, $class, $id, $attrs };
 330     eval { tie %session, $class, undef, $attrs } if $@;
 331     if ( $@ ) {
 332         die "RT couldn't store your session.  "
 333           . "This may mean that that the directory '$RT::MasonSessionDir' isn't writable or a database table is missing or corrupt.\n\n"
 334           . $@;
 335     }
 336
 337     return tied %session;
 338 }
 339
 340 1;