Upgrade to 4.2.8
[usit-rt.git] / lib / RT / Interface / Web / Session.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2014 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;