[usit-rt.git] / lib / RT / Interface / Web / Session.pm

# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
#                                          <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}

package RT::Interface::Web::Session;
use warnings;
use strict;

use RT::CurrentUser;

=head1 NAME

RT::Interface::Web::Session - RT web session class

=head1 SYNOPSYS


=head1 DESCRIPTION

RT session class and utilities.

CLASS METHODS can be used without creating object instances,
it's mainly utilities to clean unused session records.

Object is tied hash and can be used to access session data.

=head1 METHODS

=head2 CLASS METHODS

=head3 Class

Returns name of the class that is used as sessions storage.

=cut

sub Class {
    my $self = shift;

    my $class = RT->Config->Get('WebSessionClass')
             || $self->Backends->{RT->Config->Get('DatabaseType')}
             || 'Apache::Session::File';
    eval "require $class";
    die $@ if $@;
    return $class;
}

=head3 Backends

Returns hash reference with names of the databases as keys and
sessions class names as values.

=cut

sub Backends {
    return {
        mysql  => 'Apache::Session::MySQL',
        Pg     => 'Apache::Session::Postgres',
        Oracle => 'Apache::Session::Oracle',
    };
}

=head3 Attributes

Returns hash reference with attributes that are used to create
new session objects.

=cut

sub Attributes {
    my $class = $_[0]->Class;
    my $res;
    if ( my %props = RT->Config->Get('WebSessionProperties') ) {
        $res = \%props;
    }
    elsif ( $class->isa('Apache::Session::File') ) {
        $res = {
            Directory     => $RT::MasonSessionDir,
            LockDirectory => $RT::MasonSessionDir,
            Transaction   => 1,
        };
    }
    else {
        $res = {
            Handle      => $RT::Handle->dbh,
            LockHandle  => $RT::Handle->dbh,
            Transaction => 1,
        };
    }
    return $res;
}

=head3 Ids

Returns array ref with list of the session IDs.

=cut

sub Ids {
    my $self = shift || __PACKAGE__;
    my $attributes = $self->Attributes;
    if( $attributes->{Directory} ) {
        return $self->_IdsDir( $attributes->{Directory} );
    } else {
        return $self->_IdsDB( $RT::Handle->dbh );
    }
}

sub _IdsDir {
    my ($self, $dir) = @_;
    require File::Find;
    my %file;
    File::Find::find(
        sub { return unless /^[a-zA-Z0-9]+$/;
              $file{$_} = (stat($_))[9];
            },
        $dir,
    );

    return [ sort { $file{$a} <=> $file{$b} } keys %file ];
}

sub _IdsDB {
    my ($self, $dbh) = @_;
    my $ids = $dbh->selectcol_arrayref("SELECT id FROM sessions ORDER BY LastUpdated DESC");
    die "couldn't get ids: ". $dbh->errstr if $dbh->errstr;
    return $ids;
}

=head3 ClearOld

Takes seconds and deletes all sessions that are older.

=cut

sub ClearOld {
    my $class = shift || __PACKAGE__;
    my $attributes = $class->Attributes;
    if( $attributes->{Directory} ) {
        return $class->_ClearOldDir( $attributes->{Directory}, @_ );
    } else {
        return $class->_ClearOldDB( $RT::Handle->dbh, @_ );
    }
}

sub _ClearOldDB {
    my ($self, $dbh, $older_than) = @_;
    my $rows;
    unless( int $older_than ) {
        $rows = $dbh->do("DELETE FROM sessions");
        die "couldn't delete sessions: ". $dbh->errstr unless defined $rows;
    } else {
        require POSIX;
        my $date = POSIX::strftime("%Y-%m-%d %H:%M", localtime( time - int $older_than ) );

        my $sth = $dbh->prepare("DELETE FROM sessions WHERE LastUpdated < ?");
        die "couldn't prepare query: ". $dbh->errstr unless $sth;
        $rows = $sth->execute( $date );
        die "couldn't execute query: ". $dbh->errstr unless defined $rows;
    }

    $RT::Logger->info("successfully deleted $rows sessions");
    return;
}

sub _ClearOldDir {
    my ($self, $dir, $older_than) = @_;

    require File::Spec if int $older_than;
    
    my $now = time;
    my $class = $self->Class;
    my $attrs = $self->Attributes;

    foreach my $id( @{ $self->Ids } ) {
        if( int $older_than ) {
            my $mtime = (stat(File::Spec->catfile($dir,$id)))[9];
            if( $mtime > $now - $older_than ) {
                $RT::Logger->debug("skipped session '$id', isn't old");
                next;
            }
        }

        my %session;
        local $@;
        eval { tie %session, $class, $id, $attrs };
        if( $@ ) {
            $RT::Logger->debug("skipped session '$id', couldn't load: $@");
            next;
        }
        tied(%session)->delete;
        $RT::Logger->info("successfully deleted session '$id'");
    }

    # Apache::Session::Lock::File will clean out locks older than X, but it
    # leaves around bogus locks if they're too new, even though they're
    # guaranteed dead.  On even just largeish installs, the accumulated number
    # of them may bump into ext3/4 filesystem limits since Apache::Session
    # doesn't use a fan-out tree.
    my $lock = Apache::Session::Lock::File->new;
    $lock->clean( $dir, $older_than );

    # Take matters into our own hands and clear bogus locks hanging around
    # regardless of how recent they are.
    $self->ClearOrphanLockFiles($dir);

    return;
}

=head3 ClearOrphanLockFiles

Takes a directory in which to look for L<Apache::Session::Lock::File> locks
which no longer have a corresponding session file.  If not provided, the
directory is taken from the session configuration data.

=cut

sub ClearOrphanLockFiles {
    my $class = shift;
    my $dir   = shift || $class->Attributes->{Directory}
        or return;

    if (opendir my $dh, $dir) {
        for (readdir $dh) {
            next unless /^Apache-Session-([0-9a-f]{32})\.lock$/;
            next if -e "$dir/$1";

            RT->Logger->debug("deleting orphaned session lockfile '$_'");

            unlink "$dir/$_"
                or warn "Failed to unlink session lockfile $dir/$_: $!";
        }
        closedir $dh;
    } else {
        warn "Unable to open directory '$dir' for reading: $!";
    }
}

=head3 ClearByUser

Checks all sessions and if user has more then one session
then leave only the latest one.

=cut

sub ClearByUser {
    my $self = shift || __PACKAGE__;
    my $class = $self->Class;
    my $attrs = $self->Attributes;

    my $deleted;
    my %seen = ();
    foreach my $id( @{ $self->Ids } ) {
        my %session;
        local $@;
        eval { tie %session, $class, $id, $attrs };
        if( $@ ) {
            $RT::Logger->debug("skipped session '$id', couldn't load: $@");
            next;
        }
        if( $session{'CurrentUser'} && $session{'CurrentUser'}->id ) {
            unless( $seen{ $session{'CurrentUser'}->id }++ ) {
                $RT::Logger->debug("skipped session '$id', first user's session");
                next;
            }
        }
        tied(%session)->delete;
        $RT::Logger->info("successfully deleted session '$id'");
        $deleted++;
    }
    $self->ClearOrphanLockFiles if $deleted;
}

sub TIEHASH {
    my $self = shift;
    my $id = shift;

    my $class = $self->Class;
    my $attrs = $self->Attributes;

    my %session;

    local $@;
    eval { tie %session, $class, $id, $attrs };
    eval { tie %session, $class, undef, $attrs } if $@;
    if ( $@ ) {
        die "RT couldn't store your session.  "
          . "This may mean that that the directory '$RT::MasonSessionDir' isn't writable or a database table is missing or corrupt.\n\n"
          . $@;
    }

    return tied %session;
}

1;
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 {
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
	109	Returns hash reference with attributes that are used to create
	110	new session objects.
	111
	112	=cut
	113
	114	sub 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
	139	Returns array ref with list of the session IDs.
	140
	141	=cut
	142
	143	sub 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
	153	sub _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
	167	sub _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
	176	Takes seconds and deletes all sessions that are older.
	177
	178	=cut
	179
	180	sub 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
	190	sub _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
	210	sub _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];
5b0d0914 MKG	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
	256	Takes a directory in which to look for L<Apache::Session::Lock::File> locks
	257	which no longer have a corresponding session file. If not provided, the
	258	directory is taken from the session configuration data.
	259
	260	=cut
	261
	262	sub 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
	285	Checks all sessions and if user has more then one session
	286	then leave only the latest one.
	287
	288	=cut
	289
	290	sub 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'");
01e3b242 MKG	313	$deleted++;
84fb5b46	314	}
01e3b242	315	$self->ClearOrphanLockFiles if $deleted;
84fb5b46 MKG	316	}
	317
	318	sub 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. "
01e3b242 MKG	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
	339	1;