diff options
Diffstat (limited to 'rt/lib/RT/Interface/Web')
| -rw-r--r-- | rt/lib/RT/Interface/Web/Handler.pm | 218 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Menu.pm | 259 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Menu/Item.pm | 88 | ||||
| -rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder.pm | 2 | ||||
| -rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm | 12 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Request.pm | 51 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Session.pm | 2 | ||||
| -rwxr-xr-x | rt/lib/RT/Interface/Web/Standalone.pm | 126 | ||||
| -rw-r--r-- | rt/lib/RT/Interface/Web/Standalone/PreFork.pm | 103 |
9 files changed, 385 insertions, 476 deletions
diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm index 4bb648451..69eee60f6 100644 --- a/rt/lib/RT/Interface/Web/Handler.pm +++ b/rt/lib/RT/Interface/Web/Handler.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -47,6 +47,8 @@ # END BPS TAGGED BLOCK }}} package RT::Interface::Web::Handler; +use warnings; +use strict; use CGI qw/-private_tempfiles/; use MIME::Entity; @@ -54,19 +56,16 @@ use Text::Wrapper; use CGI::Cookie; use Time::ParseDate; use Time::HiRes; -use HTML::Entities; use HTML::Scrubber; -use RT::Interface::Web::Handler; +use RT::Interface::Web; use RT::Interface::Web::Request; use File::Path qw( rmtree ); use File::Glob qw( bsd_glob ); use File::Spec::Unix; sub DefaultHandlerArgs { ( - comp_root => [ - [ local => $RT::MasonLocalComponentRoot ], - (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}), - [ standard => $RT::MasonComponentRoot ] + comp_root => [ + RT::Interface::Web->ComponentRoots( Names => 1 ), ], default_escape_flags => 'h', data_dir => "$RT::MasonDataDir", @@ -80,27 +79,6 @@ sub DefaultHandlerArgs { ( named_component_subs => $INC{'Devel/Cover.pm'} ? 1 : 0, ) }; -# {{{ sub new - -=head2 new - - Constructs a web handler of the appropriate class. - Takes options to pass to the constructor. - -=cut - -sub new { - my $class = shift; - $class->InitSessionDir; - - if ( ($mod_perl::VERSION && $mod_perl::VERSION >= 1.9908) || $CGI::MOD_PERL) { - goto &NewApacheHandler; - } - else { - goto &NewCGIHandler; - } -} - sub InitSessionDir { # Activate the following if running httpd as root (the normal case). # Resets ownership of all files created by Mason at startup. @@ -125,81 +103,14 @@ sub InitSessionDir { } -# }}} - -# {{{ sub NewApacheHandler - -=head2 NewApacheHandler - - Takes extra options to pass to HTML::Mason::ApacheHandler->new - Returns a new Mason::ApacheHandler object - -=cut - -sub NewApacheHandler { - require HTML::Mason::ApacheHandler; - return NewHandler('HTML::Mason::ApacheHandler', args_method => "CGI", @_); -} - -# }}} - -# {{{ sub NewCGIHandler - -=head2 NewCGIHandler - - Returns a new Mason::CGIHandler object - -=cut - -sub NewCGIHandler { - require HTML::Mason::CGIHandler; - return NewHandler( - 'HTML::Mason::CGIHandler', - out_method => sub { - my $m = HTML::Mason::Request->instance; - my $r = $m->cgi_request; - - # Send headers if they have not been sent by us or by user. - $r->send_http_header unless $r->http_header_sent; - - # Set up a default - $r->content_type('text/html; charset=utf-8') - unless $r->content_type; - - if ( $r->content_type =~ /charset=([\w-]+)$/ ) { - my $enc = $1; - if ( lc $enc !~ /utf-?8$/ ) { - for my $str (@_) { - next unless $str; - - # only encode perl internal strings - next unless utf8::is_utf8($str); - $str = Encode::encode( $enc, $str ); - } - } - } - - # default to utf8 encoding - for my $str (@_) { - next unless $str; - next unless utf8::is_utf8($str); - $str = Encode::encode( 'utf8', $str ); - } - - # We could perhaps install a new, faster out_method here that - # wouldn't have to keep checking whether headers have been - # sent and what the $r->method is. That would require - # additions to the Request interface, though. - print STDOUT grep {defined} @_; - }, - @_ - ); -} +use UNIVERSAL::require; sub NewHandler { my $class = shift; + $class->require or die $!; my $handler = $class->new( DefaultHandlerArgs(), + RT->Config->Get('MasonParameters'), @_ ); @@ -208,6 +119,23 @@ sub NewHandler { return($handler); } +=head2 _mason_dir_index + +=cut + +sub _mason_dir_index { + my ($self, $interp, $path) = @_; + $path =~ s!/$!!; + if ( !$interp->comp_exists( $path ) + && $interp->comp_exists( $path . "/index.html" ) ) + { + return $path . "/index.html"; + } + + return $path; +} + + =head2 CleanupRequest Clean ups globals, caches and other things that could be still @@ -266,9 +194,97 @@ sub CleanupRequest { delete $RT::System->{attributes}; # Explicitly remove any tmpfiles that GPG opened, and close their - # filehandles. - File::Temp::cleanup; + # filehandles. unless we are doing inline psgi testing, which kills all the tmp file created by tests. + File::Temp::cleanup() + unless $INC{'Test/WWW/Mechanize/PSGI.pm'}; + + +} + + +# PSGI App + +use RT::Interface::Web::Handler; +use CGI::Emulate::PSGI; +use Plack::Request; +use Plack::Response; +use Plack::Util; +use Encode qw(encode_utf8); + +sub PSGIApp { + my $self = shift; + + # XXX: this is fucked + require HTML::Mason::CGIHandler; + require HTML::Mason::PSGIHandler::Streamy; + my $h = RT::Interface::Web::Handler::NewHandler('HTML::Mason::PSGIHandler::Streamy'); + + $self->InitSessionDir; + + return sub { + my $env = shift; + RT::ConnectToDatabase() unless RT->InstallMode; + + my $req = Plack::Request->new($env); + + # CGI.pm normalizes .. out of paths so when you requested + # /NoAuth/../Ticket/Display.html we saw Ticket/Display.html + # PSGI doesn't normalize .. so we have to deal ourselves. + if ( $req->path_info =~ m{/\.} ) { + $RT::Logger->crit("Invalid request for ".$req->path_info." aborting"); + my $res = Plack::Response->new(400); + return $self->_psgi_response_cb($res->finalize,sub { $self->CleanupRequest }); + } + $env->{PATH_INFO} = $self->_mason_dir_index( $h->interp, $req->path_info); + + my $ret; + { + # XXX: until we get rid of all $ENV stuff. + local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); + + $ret = $h->handle_psgi($env); + } + + $RT::Logger->crit($@) if $@ && $RT::Logger; + warn $@ if $@ && !$RT::Logger; + if (ref($ret) eq 'CODE') { + my $orig_ret = $ret; + $ret = sub { + my $respond = shift; + local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); + $orig_ret->($respond); + }; + } + + return $self->_psgi_response_cb($ret, + sub { + $self->CleanupRequest() + }); +}; + +sub _psgi_response_cb { + my $self = shift; + my ($ret, $cleanup) = @_; + Plack::Util::response_cb + ($ret, + sub { + my $res = shift; + + if ( RT->Config->Get('Framebusting') ) { + # XXX TODO: Do we want to make the value of this header configurable? + Plack::Util::header_set($res->[1], 'X-Frame-Options' => 'DENY'); + } + + return sub { + if (!defined $_[0]) { + $cleanup->(); + return ''; + } + return utf8::is_utf8($_[0]) ? encode_utf8($_[0]) : $_[0]; + return $_[0]; + }; + }); + } } -# }}} 1; diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm index 3b6ce888e..6b351e94b 100644 --- a/rt/lib/RT/Interface/Web/Menu.pm +++ b/rt/lib/RT/Interface/Web/Menu.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -48,22 +48,267 @@ package RT::Interface::Web::Menu; +use strict; +use warnings; + + +use base qw/Class::Accessor::Fast/; +use URI; +use Scalar::Util qw(weaken); + +__PACKAGE__->mk_accessors(qw( + key title description raw_html escape_title sort_order target class +)); + +=head1 NAME + +RT::Interface::Web::Menu - Handle the API for menu navigation + +=head1 METHODS + +=head2 new PARAMHASH + +Creates a new L<RT::Interface::Web::Menu> object. Possible keys in the +I<PARAMHASH> are L</parent>, L</title>, L</description>, L</path>, +L</raw_html>, L<escape_title>, L</sort_order>, L</class>, L</target> and +L</active>. See the subroutines with the respective name below for +each option's use. + +=cut sub new { - my $class = shift; - my $self = bless {}, $class; - $self->{'root_node'} = RT::Interface::Web::Menu::Item->new(); + my $package = shift; + my $args = ref($_[0]) eq 'HASH' ? shift @_ : {@_}; + + my $parent = delete $args->{'parent'}; + $args->{sort_order} ||= 0; + + # Class::Accessor only wants a hashref; + my $self = $package->SUPER::new( $args ); + + # make sure our reference is weak + $self->parent($parent) if defined $parent; + return $self; } -sub as_hash_of_hashes { +=head2 title [STRING] + +Sets or returns the string that the menu item will be displayed as. + +=head2 escape_title [BOOLEAN] + +Sets or returns whether or not to HTML escape the title before output. + +=head2 parent [MENU] +Gets or sets the parent L<RT::Interface::Web::Menu> of this item; this defaults +to null. This ensures that the reference is weakened. + +=head2 raw_html [STRING] + +Sets the content of this menu item to a raw blob of HTML. When building the +menu, rather than constructing a link, we will return this raw content. No +escaping is done. + +=cut + +sub parent { + my $self = shift; + if (@_) { + $self->{parent} = shift; + weaken $self->{parent}; + } + + return $self->{parent}; +} + + +=head2 sort_order [NUMBER] + +Gets or sets the sort order of the item, as it will be displayed under +the parent. This defaults to adding onto the end. + +=head2 target [STRING] + +Get or set the frame or pseudo-target for this link. something like L<_blank> + +=head2 class [STRING] + +Gets or sets the CSS class the menu item should have in addition to the default +classes. This is only used if L</raw_html> isn't specified. + +=head2 path + +Gets or sets the URL that the menu's link goes to. If the link +provided is not absolute (does not start with a "/"), then is is +treated as relative to it's parent's path, and made absolute. + +=cut + +sub path { + my $self = shift; + if (@_) { + $self->{path} = shift; + $self->{path} = URI->new_abs($self->{path}, $self->parent->path . "/")->as_string + if defined $self->{path} and $self->parent and $self->parent->path; + $self->{path} =~ s!///!/! if $self->{path}; + } + return $self->{path}; +} + +=head2 active [BOOLEAN] + +Gets or sets if the menu item is marked as active. Setting this +cascades to all of the parents of the menu item. + +This is currently B<unused>. + +=cut + +sub active { + my $self = shift; + if (@_) { + $self->{active} = shift; + $self->parent->active($self->{active}) if defined $self->parent; + } + return $self->{active}; } -sub root { +=head2 child KEY [, PARAMHASH] + +If only a I<KEY> is provided, returns the child with that I<KEY>. + +Otherwise, creates or overwrites the child with that key, passing the +I<PARAMHASH> to L<RT::Interface::Web::Menu/new>. Additionally, the paramhash's +L</title> defaults to the I<KEY>, and the L</sort_order> defaults to the +pre-existing child's sort order (if a C<KEY> is being over-written) or +the end of the list, if it is a new C<KEY>. + +If the paramhash contains a key called C<menu>, that will be used instead +of creating a new RT::Interface::Web::Menu. + + +=cut + +sub child { + my $self = shift; + my $key = shift; + my $proto = ref $self || $self; + + if ( my %args = @_ ) { + + # Clear children ordering cache + delete $self->{children_list}; + + my $child; + if ( $child = $args{menu} ) { + $child->parent($self); + } else { + $child = $proto->new( + { parent => $self, + key => $key, + title => $key, + escape_title=> 1, + %args + } + ); + } + $self->{children}{$key} = $child; + + $child->sort_order( $args{sort_order} || (scalar values %{ $self->{children} }) ) + unless ($child->sort_order()); + + # URL is relative to parents, and cached, so set it up now + $child->path( $child->{path} ); + + # Figure out the URL + my $path = $child->path; + + # Activate it + if ( defined $path and length $path ) { + my $base_path = $HTML::Mason::Commands::r->path_info; + my $query = $HTML::Mason::Commands::m->cgi_object->query_string; + $base_path .= "?$query" if defined $query and length $query; + + $base_path =~ s/index\.html$//; + $base_path =~ s/\/+$//; + $path =~ s/index\.html$//; + $path =~ s/\/+$//; + + if ( $path eq $base_path ) { + $self->{children}{$key}->active(1); + } + } + } + + return $self->{children}{$key}; +} + +=head2 active_child + +Returns the first active child node, or C<undef> is there is none. + +=cut + +sub active_child { + my $self = shift; + foreach my $kid ($self->children) { + return $kid if $kid->active; + } + return undef; +} + + +=head2 delete KEY + +Removes the child with the provided I<KEY>. + +=cut + +sub delete { + my $self = shift; + my $key = shift; + delete $self->{children_list}; + delete $self->{children}{$key}; +} + + +=head2 has_children + +Returns true if there are any children on this menu + +=cut + +sub has_children { + my $self = shift; + if (@{ $self->children}) { + return 1 + } else { + return 0; + } +} + + +=head2 children + +Returns the children of this menu item in sorted order; as an array in +array context, or as an array reference in scalar context. + +=cut + +sub children { my $self = shift; - return $self->{'root_node'}; + my @kids; + if ($self->{children_list}) { + @kids = @{$self->{children_list}}; + } else { + @kids = values %{$self->{children} || {}}; + @kids = sort {$a->{sort_order} <=> $b->{sort_order}} @kids; + $self->{children_list} = \@kids; + } + return wantarray ? @kids : \@kids; } 1; diff --git a/rt/lib/RT/Interface/Web/Menu/Item.pm b/rt/lib/RT/Interface/Web/Menu/Item.pm deleted file mode 100644 index 29fb13bcc..000000000 --- a/rt/lib/RT/Interface/Web/Menu/Item.pm +++ /dev/null @@ -1,88 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 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::Menu::Item; -use strict; -use warnings; - -sub new { - my $class = shift; - my $self = bless {},$class; - $self->{'_attributes'} = {}; - return($self); -} - -sub label { my $self = shift; $self->_accessor( label => @_) } ; -sub absolute_url { my $self = shift; $self->_accessor( absolute_url => @_) } ; -sub rt_path { my $self = shift; $self->_accessor( rt_path => @_) } ; -sub hilight { my $self = shift; $self->_accessor( hilight => @_); - $self->parent->hilight(1); - } ; -sub sort_order { my $self = shift; $self->_accessor( sort_order => @_) } ; - -sub add_child { -} - -sub delete { -} - -sub children { - -} - -sub _accessor { - my $self = shift; - my $key = shift; - if (@_){ - $self->{'attributes'}->{$key} = shift; - - } - return $self->{'_attributes'}->{$key}; -} - -1; diff --git a/rt/lib/RT/Interface/Web/QueryBuilder.pm b/rt/lib/RT/Interface/Web/QueryBuilder.pm index 09b95398c..79a0b9718 100755 --- a/rt/lib/RT/Interface/Web/QueryBuilder.pm +++ b/rt/lib/RT/Interface/Web/QueryBuilder.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm index 493ab444d..e2ec1e58d 100755 --- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm +++ b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -260,20 +260,24 @@ sub ParseSQL { my $class; if ( exists $lcfield{ lc $main_key } ) { - $class = $field{ $main_key }->[0]; $key =~ s/^[^.]+/ $lcfield{ lc $main_key } /e; + ($main_key) = split /[.]/, $key; # make the case right + $class = $field{ $main_key }->[0]; } unless( $class ) { push @results, [ $args{'CurrentUser'}->loc("Unknown field: [_1]", $key), -1 ] } - $value =~ s/'/\\'/g; if ( lc $op eq 'is' || lc $op eq 'is not' ) { $value = 'NULL'; # just fix possible mistakes here } elsif ( $value !~ /^[+-]?[0-9]+$/ ) { + $value =~ s/(['\\])/\\$1/g; $value = "'$value'"; } - $key = "'$key'" if $key =~ /^CF./; + + if ($key =~ s/(['\\])/\\$1/g or $key =~ /\s/) { + $key = "'$key'"; + } my $clause = { Key => $key, Op => $op, Value => $value }; $node->addChild( __PACKAGE__->new( $clause ) ); diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm index 84dd28dd6..d0865117d 100644 --- a/rt/lib/RT/Interface/Web/Request.pm +++ b/rt/lib/RT/Interface/Web/Request.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -52,51 +52,16 @@ use strict; use warnings; our $VERSION = '0.30'; -use base qw(HTML::Mason::Request); +use HTML::Mason::PSGIHandler; +use base qw(HTML::Mason::Request::PSGI); +use Params::Validate qw(:all); 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 } ); + $class->valid_params( %{ $class->valid_params },cgi_request => { type => OBJECT, optional => 1 } ); 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 @@ -153,11 +118,7 @@ sub callback { 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 @roots = RT::Interface::Web->ComponentRoots; my %seen; @$callbacks = ( grep defined && length, diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm index 8ce8afd2b..c5b88f127 100644 --- a/rt/lib/RT/Interface/Web/Session.pm +++ b/rt/lib/RT/Interface/Web/Session.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) diff --git a/rt/lib/RT/Interface/Web/Standalone.pm b/rt/lib/RT/Interface/Web/Standalone.pm deleted file mode 100755 index 3157e315e..000000000 --- a/rt/lib/RT/Interface/Web/Standalone.pm +++ /dev/null @@ -1,126 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 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 }}} - -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" } - -sub setup_escapes { - my $self = shift; - my $handler = shift; - - # Override HTTP::Server::Simple::Mason's version of this method to do - # nothing. (RT::Interface::Web::Handler does this already for us in - # NewHandler.) -} - -sub default_mason_config { - return RT->Config->Get('MasonParameters'); -} - -sub handle_request { - - my $self = shift; - my $cgi = shift; - - Module::Refresh->refresh if RT->Config->Get('DevelMode'); - RT::ConnectToDatabase() unless RT->InstallMode; - - # Each environment has its own way of handling .. and so on in paths, - # so RT consistently forbids such paths. - if ( $cgi->path_info =~ m{/\.} ) { - $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting"); - print STDOUT "HTTP/1.0 400\r\n\r\n"; - return RT::Interface::Web::Handler->CleanupRequest(); - } - - $self->SUPER::handle_request($cgi); - $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 deleted file mode 100644 index f569e4f00..000000000 --- a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm +++ /dev/null @@ -1,103 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 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 }}} - -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; |