diff options
author | ivan <ivan> | 2009-12-31 13:16:41 +0000 |
---|---|---|
committer | ivan <ivan> | 2009-12-31 13:16:41 +0000 |
commit | b4b0c7e72d7eaee2fbfc7022022c9698323203dd (patch) | |
tree | ba4cd21399e412c32fe3737eaa8478e3271509f9 /rt/lib/RT/Interface/Web | |
parent | 2dfda73eeb3eae2d4f894099754794ef07d060dd (diff) |
import rt 3.8.7
Diffstat (limited to 'rt/lib/RT/Interface/Web')
-rw-r--r-- | rt/lib/RT/Interface/Web/Handler.pm | 78 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Menu.pm | 5 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Menu/Item.pm | 5 | ||||
-rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder.pm | 5 | ||||
-rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm | 180 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Request.pm | 207 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Session.pm | 285 | ||||
-rwxr-xr-x | rt/lib/RT/Interface/Web/Standalone.pm | 49 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Standalone/PreFork.pm | 103 |
9 files changed, 801 insertions, 116 deletions
diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm index 260a3b319..8d17921cb 100644 --- a/rt/lib/RT/Interface/Web/Handler.pm +++ b/rt/lib/RT/Interface/Web/Handler.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Interface::Web::Handler; use CGI qw/-private_tempfiles/; @@ -56,6 +57,7 @@ use Time::HiRes; use HTML::Entities; use HTML::Scrubber; use RT::Interface::Web::Handler; +use RT::Interface::Web::Request; use File::Path qw( rmtree ); use File::Glob qw( bsd_glob ); use File::Spec::Unix; @@ -63,15 +65,19 @@ use File::Spec::Unix; sub DefaultHandlerArgs { ( comp_root => [ [ local => $RT::MasonLocalComponentRoot ], + (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}), [ standard => $RT::MasonComponentRoot ] ], default_escape_flags => 'h', data_dir => "$RT::MasonDataDir", allow_globals => [qw(%session)], # Turn off static source if we're in developer mode. - static_source => ($RT::DevelMode ? '0' : '1'), - use_object_files => ($RT::DevelMode ? '0' : '1'), - autoflush => 0 + static_source => (RT->Config->Get('DevelMode') ? '0' : '1'), + use_object_files => (RT->Config->Get('DevelMode') ? '0' : '1'), + autoflush => 0, + error_format => (RT->Config->Get('DevelMode') ? 'html': 'brief'), + request_class => 'RT::Interface::Web::Request', + named_component_subs => $INC{'Devel/Cover.pm'} ? 1 : 0, ) }; # {{{ sub new @@ -87,10 +93,7 @@ sub new { my $class = shift; $class->InitSessionDir; - if ( $mod_perl::VERSION && $mod_perl::VERSION >= 1.9908 ) { - goto &NewApacheHandler; - } - elsif ($CGI::MOD_PERL) { + if ( ($mod_perl::VERSION && $mod_perl::VERSION >= 1.9908) || $CGI::MOD_PERL) { goto &NewApacheHandler; } else { @@ -102,16 +105,17 @@ sub InitSessionDir { # Activate the following if running httpd as root (the normal case). # Resets ownership of all files created by Mason at startup. # Note that mysql uses DB for sessions, so there's no need to do this. - unless ( $RT::DatabaseType =~ /(?:mysql|Pg)/ ) { + unless ( RT->Config->Get('DatabaseType') =~ /(?:mysql|Pg)/ ) { # Clean up our umask to protect session files umask(0077); - if ($CGI::MOD_PERL) { local $@; eval { + if ($CGI::MOD_PERL and $CGI::MOD_PERL < 1.9908 ) { chown( Apache->server->uid, Apache->server->gid, $RT::MasonSessionDir ) - }} + if Apache->server->can('uid'); + } # Die if WebSessionDir doesn't exist or we can't write to it stat($RT::MasonSessionDir); @@ -139,22 +143,6 @@ sub NewApacheHandler { # }}} -# {{{ sub NewApache2Handler - -=head2 NewApache2Handler - - Takes extra options to pass to MasonX::Apache2Handler->new - Returns a new MasonX::Apache2Handler object - -=cut - -sub NewApache2Handler { - require MasonX::Apache2Handler; - return NewHandler('MasonX::Apache2Handler', args_method => "CGI", @_); -} - -# }}} - # {{{ sub NewCGIHandler =head2 NewCGIHandler @@ -182,15 +170,30 @@ sub NewHandler { =head2 CleanupRequest -Rollback any uncommitted transaction. -Flush the ACL cache -Flush the searchbuilder query cache +Clean ups globals, caches and other things that could be still +there from previous requests: + +=over 4 + +=item Rollback any uncommitted transaction(s) + +=item Flush the ACL cache + +=item Flush records cache of the L<DBIx::SearchBuilder> if +WebFlushDbCacheEveryRequest option is enabled, what is true by default +and is not recommended to change. + +=item Clean up state of RT::Action::SendEmail using 'CleanSlate' method + +=item Flush tmp GnuPG key preferences + +=back =cut sub CleanupRequest { - if ( $RT::Handle->TransactionDepth ) { + if ( $RT::Handle && $RT::Handle->TransactionDepth ) { $RT::Handle->ForceRollback; $RT::Logger->crit( "Transaction not committed. Usually indicates a software fault." @@ -201,10 +204,19 @@ sub CleanupRequest { # Consistency is imprived, too. RT::Principal->InvalidateACLCache(); DBIx::SearchBuilder::Record::Cachable->FlushCache - if ( $RT::WebFlushDbCacheEveryRequest + if ( RT->Config->Get('WebFlushDbCacheEveryRequest') and UNIVERSAL::can( 'DBIx::SearchBuilder::Record::Cachable' => 'FlushCache' ) ); + # cleanup global squelching of the mails + require RT::Action::SendEmail; + RT::Action::SendEmail->CleanSlate; + + if (RT->Config->Get('GnuPG')->{'Enable'}) { + require RT::Crypt::GnuPG; + RT::Crypt::GnuPG::UseKeyForEncryption(); + RT::Crypt::GnuPG::UseKeyForSigning( undef ); + } } # }}} diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm index de479dad6..35699429e 100644 --- a/rt/lib/RT/Interface/Web/Menu.pm +++ b/rt/lib/RT/Interface/Web/Menu.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Interface::Web::Menu; diff --git a/rt/lib/RT/Interface/Web/Menu/Item.pm b/rt/lib/RT/Interface/Web/Menu/Item.pm index 4149a0b1c..8eb4120c6 100644 --- a/rt/lib/RT/Interface/Web/Menu/Item.pm +++ b/rt/lib/RT/Interface/Web/Menu/Item.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Interface::Web::Menu::Item; diff --git a/rt/lib/RT/Interface/Web/QueryBuilder.pm b/rt/lib/RT/Interface/Web/QueryBuilder.pm index f93c4159f..29d12b464 100755 --- a/rt/lib/RT/Interface/Web/QueryBuilder.pm +++ b/rt/lib/RT/Interface/Web/QueryBuilder.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Interface::Web::QueryBuilder; use strict; diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm index b60520603..574ead465 100755 --- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm +++ b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -45,11 +45,13 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Interface::Web::QueryBuilder::Tree; use strict; use warnings; +use Tree::Simple qw/use_weak_refs/; use base qw/Tree::Simple/; =head1 NAME @@ -77,13 +79,15 @@ on the root node passed to it.) sub TraversePrePost { my ($self, $prefunc, $postfunc) = @_; - $prefunc->($self); - + # XXX: if pre or post action changes siblings (delete or adds) + # we could have problems + $prefunc->($self) if $prefunc; + foreach my $child ($self->getAllChildren()) { $child->TraversePrePost($prefunc, $postfunc); } - $postfunc->($self); + $postfunc->($self) if $postfunc; } =head2 GetReferencedQueues @@ -103,10 +107,11 @@ sub GetReferencedQueues { my $node = shift; return if $node->isRoot; + return unless $node->isLeaf; my $clause = $node->getNodeValue(); - - if ( ref($clause) and $clause->{Key} eq 'Queue' ) { + + if ( $clause->{Key} eq 'Queue' ) { $queues->{ $clause->{Value} } = 1; }; } @@ -133,55 +138,13 @@ sub GetQueryAndOptionList { my $self = shift; my $selected_nodes = shift; - my $optionlist = []; - - my $i = 0; - - $self->TraversePrePost( - sub { # This is called before recursing to the node's children. - my $node = shift; - - return if $node->isRoot or $node->getParent->isRoot; - - my $clause = $node->getNodeValue(); - my $str = ' '; - my $aggregator_context = $node->getParent()->getNodeValue(); - $str = $aggregator_context . " " if $node->getIndex() > 0; - - if ( ref($clause) ) { # ie, it's a leaf - $str .= - $clause->{Key} . " " . $clause->{Op} . " " . $clause->{Value}; - } - - unless ($node->getParent->getParent->isRoot) { - # used to check !ref( $parent->getNodeValue() ) ) - if ( $node->getIndex() == 0 ) { - $str = '( ' . $str; - } - } - - push @$optionlist, { - TEXT => $str, - INDEX => $i, - SELECTED => (grep { $_ == $node } @$selected_nodes) ? 'SELECTED' : '', - DEPTH => $node->getDepth() - 1, - }; + my $list = $self->__LinearizeTree; + foreach my $e( @$list ) { + $e->{'DEPTH'} = $e->{'NODE'}->getDepth; + $e->{'SELECTED'} = (grep $_ == $e->{'NODE'}, @$selected_nodes)? qq[ selected="selected"] : ''; + } - $i++; - }, sub { - # This is called after recursing to the node's children. - my $node = shift; - - return if $node->isRoot or $node->getParent->isRoot or $node->getParent->getParent->isRoot; - - # Only do this for the rightmost child. - return unless $node->getIndex == $node->getParent->getChildCount - 1; - - $optionlist->[-1]{TEXT} .= ' )'; - } - ); - - return (join ' ', map { $_->{TEXT} } @$optionlist), $optionlist; + return (join ' ', map $_->{'TEXT'}, @$list), $list; } =head2 PruneChildLessAggregators @@ -195,23 +158,18 @@ sub PruneChildlessAggregators { my $self = shift; $self->TraversePrePost( - sub { - }, + undef, sub { my $node = shift; + return unless $node->isLeaf; - return if $node->isRoot or $node->getParent->isRoot; - # We're only looking for aggregators (AND/OR) return if ref $node->getNodeValue; - - return if $node->getChildCount != 0; - + + return if $node->isRoot; + # OK, this is a childless aggregator. Remove self. - $node->getParent->removeChild($node); - - # Deal with circular refs $node->DESTROY; } ); @@ -226,18 +184,102 @@ In fact, it's all of them but the root and its child. =cut sub GetDisplayedNodes { + return map $_->{NODE}, @{ (shift)->__LinearizeTree }; +} + + +sub __LinearizeTree { my $self = shift; - my @lines; - $self->traverse(sub { + my ($list, $i) = ([], 0); + + $self->TraversePrePost( sub { my $node = shift; + return if $node->isRoot; + + my $str = ''; + if( $node->getIndex > 0 ) { + $str .= " ". $node->getParent->getNodeValue ." "; + } + + unless( $node->isLeaf ) { + $str .= '( '; + } else { + + my $clause = $node->getNodeValue; + $str .= $clause->{Key}; + $str .= " ". $clause->{Op}; + $str .= " ". $clause->{Value}; - push @lines, $node unless $node->isRoot or $node->getParent->isRoot; + } + $str =~ s/^\s+|\s+$//; + + push @$list, { + NODE => $node, + TEXT => $str, + INDEX => $i, + }; + + $i++; + }, sub { + my $node = shift; + return if $node->isRoot; + return if $node->isLeaf; + $list->[-1]->{'TEXT'} .= ' )'; }); - return @lines; + return $list; } +sub ParseSQL { + my $self = shift; + my %args = ( + Query => '', + CurrentUser => '', #XXX: Hack + @_ + ); + my $string = $args{'Query'}; + + my @results; + + my %field = %{ RT::Tickets->new( $args{'CurrentUser'} )->FIELDS }; + my %lcfield = map { ( lc($_) => $_ ) } keys %field; + + my $node = $self; + + my %callback; + $callback{'OpenParen'} = sub { + $node = __PACKAGE__->new( 'AND', $node ); + }; + $callback{'CloseParen'} = sub { $node = $node->getParent }; + $callback{'EntryAggregator'} = sub { $node->setNodeValue( $_[0] ) }; + $callback{'Condition'} = sub { + my ($key, $op, $value) = @_; + + my ($main_key) = split /[.]/, $key; + + my $class; + if ( exists $lcfield{ lc $main_key } ) { + $class = $field{ $main_key }->[0]; + $key =~ s/^[^.]+/ $lcfield{ lc $main_key } /e; + } + unless( $class ) { + push @results, [ $args{'CurrentUser'}->loc("Unknown field: [_1]", $key), -1 ] + } + + $value =~ s/'/\\'/g; + $value = "'$value'" if $value =~ /[^0-9]/; + $key = "'$key'" if $key =~ /^CF./; + + my $clause = { Key => $key, Op => $op, Value => $value }; + $node->addChild( __PACKAGE__->new( $clause ) ); + }; + $callback{'Error'} = sub { push @results, @_ }; + + require RT::SQL; + RT::SQL::Parse($string, \%callback); + return @results; +} eval "require RT::Interface::Web::QueryBuilder::Tree_Vendor"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder/Tree_Vendor.pm}); diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm new file mode 100644 index 000000000..e1794640d --- /dev/null +++ b/rt/lib/RT/Interface/Web/Request.pm @@ -0,0 +1,207 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# <jesse@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::Request; + +use strict; +use warnings; + +our $VERSION = '0.30'; +use base qw(HTML::Mason::Request); + +sub new { + my $class = shift; + + my $new_class = $HTML::Mason::ApacheHandler::VERSION ? + 'HTML::Mason::Request::ApacheHandler' : + $HTML::Mason::CGIHandler::VERSION ? + 'HTML::Mason::Request::CGI' : + 'HTML::Mason::Request'; + + $class->alter_superclass( $new_class ); + $class->valid_params( %{ $new_class->valid_params } ); + return $class->SUPER::new(@_); +} + +# XXX TODO: This alter_superclass replaces teh funcitonality in Mason 1.39 +# with code which doesn't trigger a bug in Perl 5.10. +# (Perl 5.10.0 does NOT take kindly to having its @INC entries changed) +# http://rt.perl.org/rt3/Public/Bug/Display.html?id=54566 +# +# This routine can be removed when either: +# * RT depends on a version of mason which contains this fix +# * Perl 5.10.0 is not supported for running RT +sub alter_superclass { + my $class = shift; + my $new_super = shift; + my $isa_ref; + { no strict 'refs'; my @entries = @{$class."::ISA"}; $isa_ref = \@entries; } + + # handles multiple inheritance properly and preserve + # inheritance order + for ( my $x = 0; $x <= $#{$isa_ref} ; $x++ ) { + if ( $isa_ref->[$x]->isa('HTML::Mason::Request') ) { + my $old_super = $isa_ref->[$x]; + $isa_ref->[$x] = $new_super + if ( $old_super ne $new_super ); + last; + } + } + + { no strict 'refs'; @{$class."::ISA"} = @$isa_ref; } + $class->valid_params( %{ $class->valid_params } ); +} + + +=head2 callback + +Method replaces deprecated component C<Element/Callback>. + +Takes hash with optional C<CallbackPage>, C<CallbackName> +and C<CallbackOnce> arguments, other arguments are passed +throught to callback components. + +=over 4 + +=item CallbackPage + +Page path relative to the root, leading slash is mandatory. +By default is equal to path of the caller component. + +=item CallbackName + +Name of the callback. C<Default> is used unless specified. + +=item CallbackOnce + +By default is false, otherwise runs callbacks only once per +process of the server. Such callbacks can be used to fill +structures. + +=back + +Searches for callback components in +F<< /Callbacks/<any dir>/CallbackPage/CallbackName >>, for +example F</Callbacks/MyExtension/autohandler/Default> would +be called as default callback for F</autohandler>. + +=cut + +{ +my %cache = (); +my %called = (); +sub callback { + my ($self, %args) = @_; + + my $name = delete $args{'CallbackName'} || 'Default'; + my $page = delete $args{'CallbackPage'} || $self->callers(0)->path; + unless ( $page ) { + $RT::Logger->error("Couldn't get a page name for callbacks"); + return; + } + + my $CacheKey = "$page--$name"; + return 1 if delete $args{'CallbackOnce'} && $called{ $CacheKey }; + $called{ $CacheKey } = 1; + + my $callbacks = $cache{ $CacheKey }; + unless ( $callbacks ) { + $callbacks = []; + my $path = "/Callbacks/*$page/$name"; + my @roots = map $_->[1], + $HTML::Mason::VERSION <= 1.28 + ? $self->interp->resolver->comp_root_array + : $self->interp->comp_root_array; + + my %seen; + @$callbacks = ( + sort grep defined && length, + # Skip backup files, files without a leading package name, + # and files we've already seen + grep !$seen{$_}++ && !m{/\.} && !m{~$} && m{^/Callbacks/[^/]+\Q$page/$name\E$}, + map $self->interp->resolver->glob_path($path, $_), + @roots + ); + foreach my $comp (keys %seen) { + next unless $seen{$comp} > 1; + $RT::Logger->error("Found more than one occurrence of the $comp callback. This may cause only one of the callbacks to run. Look for the duplicate Callback in your @roots"); + } + + $cache{ $CacheKey } = $callbacks unless RT->Config->Get('DevelMode'); + } + + my @rv; + foreach my $cb ( @$callbacks ) { + push @rv, scalar $self->comp( $cb, %args ); + } + return @rv; +} +} + +=head2 request_path + +Returns path of the request. + +Very close to C<< $m->request_comp->path >>, but if called in a dhandler returns +path of the request without dhandler name, but with dhandler arguments instead. + +=cut + +sub request_path { + my $self = shift; + + my $path = $self->request_comp->path; + # disabled dhandlers, not RT case, but anyway + return $path unless my $dh_name = $self->dhandler_name; + # not a dhandler + return $path unless substr($path, -length("/$dh_name")) eq "/$dh_name"; + substr($path, -length $dh_name) = $self->dhandler_arg; + return $path; +} + +1; diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm new file mode 100644 index 000000000..4998c34f9 --- /dev/null +++ b/rt/lib/RT/Interface/Web/Session.pm @@ -0,0 +1,285 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# <jesse@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', + }; +} + +=head3 Attributes + +Returns hash reference with attributes that are used to create +new session objects. + +=cut + +sub Attributes { + + return $_[0]->Backends->{RT->Config->Get('DatabaseType')} ? { + Handle => $RT::Handle->dbh, + LockHandle => $RT::Handle->dbh, + Transaction => 1, + } : { + Directory => $RT::MasonSessionDir, + LockDirectory => $RT::MasonSessionDir, + Transaction => 1, + }; +} + +=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->_CleariOldDir( $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("successfuly 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 $ctime = (stat(File::Spec->catfile($dir,$id)))[9]; + if( $ctime > $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("successfuly deleted session '$id'"); + } + return; +} + +=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 %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("successfuly deleted session '$id'"); + } +} + +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 loc("RT couldn't store your session.") . "\n" + . loc("This may mean that that the directory '[_1]' isn't writable or a database table is missing or corrupt.", + $RT::MasonSessionDir) + . "\n\n" + . $@; + } + + return tied %session; +} + +1; diff --git a/rt/lib/RT/Interface/Web/Standalone.pm b/rt/lib/RT/Interface/Web/Standalone.pm index f625dd8e8..12bd276e1 100755 --- a/rt/lib/RT/Interface/Web/Standalone.pm +++ b/rt/lib/RT/Interface/Web/Standalone.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # <jesse@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -45,12 +45,15 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} -package RT::Interface::Web::Standalone; use strict; +use warnings; +package RT::Interface::Web::Standalone; + use base 'HTTP::Server::Simple::Mason'; use RT::Interface::Web::Handler; use RT::Interface::Web; +use URI; sub handler_class { "RT::Interface::Web::Handler" } @@ -64,7 +67,7 @@ sub setup_escapes { } sub default_mason_config { - return @RT::MasonParameters; + return RT->Config->Get('MasonParameters'); } sub handle_request { @@ -72,13 +75,43 @@ sub handle_request { my $self = shift; my $cgi = shift; - Module::Refresh->refresh if $RT::DevelMode; - + Module::Refresh->refresh if RT->Config->Get('DevelMode'); + RT::ConnectToDatabase() unless RT->InstallMode; $self->SUPER::handle_request($cgi); - $RT::Logger->crit($@) if ($@); - + $RT::Logger->crit($@) if $@ && $RT::Logger; + warn $@ if $@ && !$RT::Logger; RT::Interface::Web::Handler->CleanupRequest(); +} + +sub net_server { + my $self = shift; + $self->{rt_net_server} = shift if @_; + return $self->{rt_net_server}; +} + + +=head2 print_banner + +This routine prints a banner before the server request-handling loop +starts. + +Methods below this point are probably not terribly useful to define +yourself in subclasses. + +=cut + +sub print_banner { + my $self = shift; + + my $url = URI->new( RT->Config->Get('WebBaseURL')); + $url->host('127.0.0.1') if ($url->host() eq 'localhost'); + $url->port($self->port); + print( + "You can connect to your server at " + . $url->canonical + . "\n" ); } + 1; diff --git a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm b/rt/lib/RT/Interface/Web/Standalone/PreFork.pm new file mode 100644 index 000000000..c00f8cd64 --- /dev/null +++ b/rt/lib/RT/Interface/Web/Standalone/PreFork.pm @@ -0,0 +1,103 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# <jesse@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 }}} + +use warnings; +use strict; + +package RT::Interface::Web::Standalone::PreFork; +use base qw/Net::Server::PreFork/; + +my %option_map = ( + min_servers => 'StandaloneMinServers', + max_servers => 'StandaloneMaxServers', + min_spare_servers => 'StandaloneMinSpareServers', + max_spare_servers => 'StandaloneMaxSpareServers', + max_requests => 'StandaloneMaxRequests', +); + +=head2 default_values + +Produces the default values for L<Net::Server> configuration from RT's config +files. + +=cut + +sub default_values { + my %forking = ( + map { $_ => RT->Config->Get( $option_map{$_} ) } + grep { defined( RT->Config->Get( $option_map{$_} ) ) } + keys %option_map, + ); + + return { + %forking, + log_level => 1, + RT->Config->Get('NetServerOptions') + }; +} + +=head2 post_bind_hook + +After binding to the specified ports, let the user know that the server is +prepared to handle connections. + +=cut + +sub post_bind_hook { + my $self = shift; + my @ports = @{ $self->{server}->{port} }; + + print $0 + . ": You can connect to your server at " + . (join ' , ', map { "http://localhost:$_/" } @ports) + . "\n"; + + $self->SUPER::post_bind_hook(@_); +} + +1; |