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