Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / Interface / Web / Session.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
403d7b0b 5# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
84fb5b46
MKG
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
49package RT::Interface::Web::Session;
50use warnings;
51use strict;
52
53use RT::CurrentUser;
54
55=head1 NAME
56
57RT::Interface::Web::Session - RT web session class
58
59=head1 SYNOPSYS
60
61
62=head1 DESCRIPTION
63
64RT session class and utilities.
65
66CLASS METHODS can be used without creating object instances,
67it's mainly utilities to clean unused session records.
68
69Object 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
77Returns name of the class that is used as sessions storage.
78
79=cut
80
81sub 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 eval "require $class";
88 die $@ if $@;
89 return $class;
90}
91
92=head3 Backends
93
94Returns hash reference with names of the databases as keys and
95sessions class names as values.
96
97=cut
98
99sub Backends {
100 return {
af59614d
MKG
101 mysql => 'Apache::Session::MySQL',
102 Pg => 'Apache::Session::Postgres',
103 Oracle => 'Apache::Session::Oracle',
84fb5b46
MKG
104 };
105}
106
107=head3 Attributes
108
109Returns hash reference with attributes that are used to create
110new session objects.
111
112=cut
113
114sub Attributes {
115 my $class = $_[0]->Class;
af59614d
MKG
116 my $res;
117 if ( my %props = RT->Config->Get('WebSessionProperties') ) {
118 $res = \%props;
119 }
120 elsif ( $class->isa('Apache::Session::File') ) {
121 $res = {
84fb5b46
MKG
122 Directory => $RT::MasonSessionDir,
123 LockDirectory => $RT::MasonSessionDir,
124 Transaction => 1,
125 };
af59614d
MKG
126 }
127 else {
128 $res = {
129 Handle => $RT::Handle->dbh,
130 LockHandle => $RT::Handle->dbh,
131 Transaction => 1,
132 };
133 }
134 return $res;
84fb5b46
MKG
135}
136
137=head3 Ids
138
139Returns array ref with list of the session IDs.
140
141=cut
142
143sub Ids {
144 my $self = shift || __PACKAGE__;
145 my $attributes = $self->Attributes;
146 if( $attributes->{Directory} ) {
147 return $self->_IdsDir( $attributes->{Directory} );
148 } else {
149 return $self->_IdsDB( $RT::Handle->dbh );
150 }
151}
152
153sub _IdsDir {
154 my ($self, $dir) = @_;
155 require File::Find;
156 my %file;
157 File::Find::find(
158 sub { return unless /^[a-zA-Z0-9]+$/;
159 $file{$_} = (stat($_))[9];
160 },
161 $dir,
162 );
163
164 return [ sort { $file{$a} <=> $file{$b} } keys %file ];
165}
166
167sub _IdsDB {
168 my ($self, $dbh) = @_;
169 my $ids = $dbh->selectcol_arrayref("SELECT id FROM sessions ORDER BY LastUpdated DESC");
170 die "couldn't get ids: ". $dbh->errstr if $dbh->errstr;
171 return $ids;
172}
173
174=head3 ClearOld
175
176Takes seconds and deletes all sessions that are older.
177
178=cut
179
180sub ClearOld {
181 my $class = shift || __PACKAGE__;
182 my $attributes = $class->Attributes;
183 if( $attributes->{Directory} ) {
184 return $class->_ClearOldDir( $attributes->{Directory}, @_ );
185 } else {
186 return $class->_ClearOldDB( $RT::Handle->dbh, @_ );
187 }
188}
189
190sub _ClearOldDB {
191 my ($self, $dbh, $older_than) = @_;
192 my $rows;
193 unless( int $older_than ) {
194 $rows = $dbh->do("DELETE FROM sessions");
195 die "couldn't delete sessions: ". $dbh->errstr unless defined $rows;
196 } else {
197 require POSIX;
198 my $date = POSIX::strftime("%Y-%m-%d %H:%M", localtime( time - int $older_than ) );
199
200 my $sth = $dbh->prepare("DELETE FROM sessions WHERE LastUpdated < ?");
201 die "couldn't prepare query: ". $dbh->errstr unless $sth;
202 $rows = $sth->execute( $date );
203 die "couldn't execute query: ". $dbh->errstr unless defined $rows;
204 }
205
01e3b242 206 $RT::Logger->info("successfully deleted $rows sessions");
84fb5b46
MKG
207 return;
208}
209
210sub _ClearOldDir {
211 my ($self, $dir, $older_than) = @_;
212
213 require File::Spec if int $older_than;
214
215 my $now = time;
216 my $class = $self->Class;
217 my $attrs = $self->Attributes;
218
219 foreach my $id( @{ $self->Ids } ) {
220 if( int $older_than ) {
5b0d0914
MKG
221 my $mtime = (stat(File::Spec->catfile($dir,$id)))[9];
222 if( $mtime > $now - $older_than ) {
84fb5b46
MKG
223 $RT::Logger->debug("skipped session '$id', isn't old");
224 next;
225 }
226 }
227
228 my %session;
229 local $@;
230 eval { tie %session, $class, $id, $attrs };
231 if( $@ ) {
232 $RT::Logger->debug("skipped session '$id', couldn't load: $@");
233 next;
234 }
235 tied(%session)->delete;
01e3b242 236 $RT::Logger->info("successfully deleted session '$id'");
84fb5b46 237 }
403d7b0b 238
01e3b242
MKG
239 # Apache::Session::Lock::File will clean out locks older than X, but it
240 # leaves around bogus locks if they're too new, even though they're
241 # guaranteed dead. On even just largeish installs, the accumulated number
242 # of them may bump into ext3/4 filesystem limits since Apache::Session
243 # doesn't use a fan-out tree.
403d7b0b
MKG
244 my $lock = Apache::Session::Lock::File->new;
245 $lock->clean( $dir, $older_than );
246
01e3b242
MKG
247 # Take matters into our own hands and clear bogus locks hanging around
248 # regardless of how recent they are.
249 $self->ClearOrphanLockFiles($dir);
250
84fb5b46
MKG
251 return;
252}
253
01e3b242
MKG
254=head3 ClearOrphanLockFiles
255
256Takes a directory in which to look for L<Apache::Session::Lock::File> locks
257which no longer have a corresponding session file. If not provided, the
258directory is taken from the session configuration data.
259
260=cut
261
262sub ClearOrphanLockFiles {
263 my $class = shift;
264 my $dir = shift || $class->Attributes->{Directory}
265 or return;
266
267 if (opendir my $dh, $dir) {
268 for (readdir $dh) {
269 next unless /^Apache-Session-([0-9a-f]{32})\.lock$/;
270 next if -e "$dir/$1";
271
272 RT->Logger->debug("deleting orphaned session lockfile '$_'");
273
274 unlink "$dir/$_"
275 or warn "Failed to unlink session lockfile $dir/$_: $!";
276 }
277 closedir $dh;
278 } else {
279 warn "Unable to open directory '$dir' for reading: $!";
280 }
281}
282
84fb5b46
MKG
283=head3 ClearByUser
284
285Checks all sessions and if user has more then one session
286then leave only the latest one.
287
288=cut
289
290sub ClearByUser {
291 my $self = shift || __PACKAGE__;
292 my $class = $self->Class;
293 my $attrs = $self->Attributes;
294
01e3b242 295 my $deleted;
84fb5b46
MKG
296 my %seen = ();
297 foreach my $id( @{ $self->Ids } ) {
298 my %session;
299 local $@;
300 eval { tie %session, $class, $id, $attrs };
301 if( $@ ) {
302 $RT::Logger->debug("skipped session '$id', couldn't load: $@");
303 next;
304 }
305 if( $session{'CurrentUser'} && $session{'CurrentUser'}->id ) {
306 unless( $seen{ $session{'CurrentUser'}->id }++ ) {
307 $RT::Logger->debug("skipped session '$id', first user's session");
308 next;
309 }
310 }
311 tied(%session)->delete;
01e3b242
MKG
312 $RT::Logger->info("successfully deleted session '$id'");
313 $deleted++;
84fb5b46 314 }
01e3b242 315 $self->ClearOrphanLockFiles if $deleted;
84fb5b46
MKG
316}
317
318sub TIEHASH {
319 my $self = shift;
320 my $id = shift;
321
322 my $class = $self->Class;
323 my $attrs = $self->Attributes;
324
325 my %session;
326
327 local $@;
328 eval { tie %session, $class, $id, $attrs };
329 eval { tie %session, $class, undef, $attrs } if $@;
330 if ( $@ ) {
01e3b242
MKG
331 die "RT couldn't store your session. "
332 . "This may mean that that the directory '$RT::MasonSessionDir' isn't writable or a database table is missing or corrupt.\n\n"
84fb5b46
MKG
333 . $@;
334 }
335
336 return tied %session;
337}
338
3391;