From: Tomas Doran Date: Mon, 8 Aug 2011 22:54:18 +0000 (+0100) Subject: Merge branch 'psgi' X-Git-Tag: 5.9000~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=be5cf2d55e39edd87d8ef84d2fc534e38699642c;hp=353c023014b878dc341d4cba3f38f23b77ffffc7 Merge branch 'psgi' * psgi: (219 commits) Sort out what we're doing to ::PreFork users The nginx bullshit can just die TWMC is fixed Back compat fix for CX::CRUD and others Clarify CX::CRUD All the tutorial apps still work More TODO rewriting Everything except CX::CRUD works Update TODO and Changes Put old version of TWMC in conflicts, update TODO Note Manual needs additional fixing Pull back use_request_uri_for_path docs from deleted Engine::CGI nginx testing needed + docs, then we're done, really Final bits of testing Fix custom engine compat More todo notes Note conflicts updated todo Fix display on search.cpan Remove fixed things from TODO list ... --- diff --git a/Changes b/Changes index fe5426c..3c33387 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,86 @@ # This file documents the revision history for Perl extension Catalyst. + Fixed extensions: + + - A number of modules have been updated to pass their tests or not + produce deprecation warnings with the latest version of Catalyst. + + These are: + + Test::WWW::Mechanize::Catalyst - has been updated to not produce + deprecation warnings. + + Catalyst::ActionRole::ACL - has been updated to fix failing tests + (although older versions still function perfectly with this + version of Catalyst). + + Catalyst::Plugin::Session::Store::DBIC - has been updated to fix + failing tests (although older versions still function perfectly + with this version of Catalyst). + + Backward compatibility fixes: + + - Fix calling MyApp->engine_class to set the engine class manually. + + - Re-add a $res->headers->{status} field to Catalyst::Test responses. + This _should_ be accessed with $c->res->code instead, but is here + for backward compatibility. + + Documentation: + + - Documentation which was in the now removed Catalyst::Engine::* classes + has been moved to Catalyst::Manual::Deployment + + Changes: + + - nginx specific behaviour is removed as it is not needed with any + web server configuration I can come up with (recommended config is + documented in Catalst::Manual::Deployment::nginx::FastCGI) + +5.89003 2011-07-28 20:11:50 (TRIAL release) + + Backward compatibility fixes: + + - Application scripts which have not been upgraded to newer + Catalyst::Script::XXX style scripts have been fixed + + Bug fixes: + + - mod_perl handler fixed to work with application classes which have manually + been made immutable. + + - Scripts now force the Plack engine choice manually, rather than relying + on auto-detection, as the automatic mechanism gets it wrong if (for + example) Coro is loaded. + + - Server script option for --fork --keepalive are now handled by loading + the Starman server, rather than silently ignored. + + - Server script options for --background and --pid are now fixed by + using MooseX::Deamonize + + - Plack middlewares to deal with issues in Lighttpd and IIS6 are now + automatically applied to applications and deployments which need them + (when there is not a user written .psgi script available). + This fixes compatibility with previous stable releases for applications + deployed in these environments. + + Enhancements: + + - Catalyst::Test's remote_request method not uses Plack::Test to perform + the remote request. + + Documentation: + - Added a Catalyst::PSGI manual page with information about writing a .psgi + file for your application. + + - Catalyst::Uprading has been improved, and the status of old Catalyst + engines clarified. + + Deprecations: + - Catalyst::Test's local_request function is now deprecated. You should just + use the normal request function against a local server instead. + 5.80033 2011-07-24 16:09:00 Bug fixes: @@ -36,6 +117,38 @@ - Update tests to ignore CATALYST_HOME env var. +5.89002 2011-03-02 11:30:00 (TRIAL release) + + Bug fixes: + - Fix a couple of test failures caused by optional dependencies such as FCGI + not being installed. + + Refactoring: + - Simplified the API for getting a PSGI application code reference for a + Catalyst application for use in, for example, .psgi files. See + Catalyst::Upgrading for details. + +5.89001 2011-03-01 15:27:00 (TRIAL release) + + Bug fixes: + - Fixed command-line argument passing in Catalyst::Script::FastCGI. + + - Fixed Catalyst::Engine::Stomp compatibility. Applications using + Catalyst::Engine::Stomp are believed to continue working without + any changes with the new Catalyst major version. + + - Fixed issues auto-loading engine with older scripts. + + Known problems: + - Catalyst::Engine::Wx is officially unsupported and BROKEN. If you + are using this engine then please get in touch with us and we'll + be happy to help with the changes it needs to be compatible with + the new major version of Catalyst. + + Documentation: + - The section of Catalyst::Upgrading describing how to upgrade to version 5.90 + of Catalyst has been much improved. + 5.80032 2011-02-23 01:10:00 Bug fixes: @@ -80,6 +193,25 @@ - Fix undef warning in Catalyst::Engine::FastCGI when writing an empty body (e.g. doing a redirect) +5.89000 2011-01-24 09:28:45 (TRIAL release) + + This is a development release from psgi branch of Catalyst-Runtime. + + Removed features: + + - All of the Catalyst::Engine::* namespace is now gone. Instead we only have + one Catalyst::Engine class speaking the PSGI protocol natively. Everything + the various Catalyst::Engine:: classes did before is now supposed to happen + through PSGI handlers such as Plack::Handler::FCGI, + Plack::Handler::HTTP::Server::PSGI, Plack::Handler::Apache2, and so + on. However, deployment can still work the same as it did before. The + catalyst scripts still exist and continue to work. + + If you find anything that either doesn't work anymore as it did before or + anything that could be done before with the various Catalyst::Engine:: + classes, but can't be done anymore with the single PSGI Catalyst::Engine + class, please tell us *now*. + 5.80030 2011-01-04 13:13:02 New features: diff --git a/Makefile.PL b/Makefile.PL index 7d57917..a2d9499 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -19,9 +19,11 @@ requires 'namespace::clean' => '0.13'; requires 'B::Hooks::EndOfScope' => '0.08'; requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903'; requires 'Class::MOP' => '0.95'; +requires 'Data::OptList'; requires 'Moose' => '1.03'; requires 'MooseX::MethodAttributes::Inheritable' => '0.24'; requires 'MooseX::Role::WithOverloading' => '0.09'; +requires 'MooseX::Types::LoadableClass' => '0.003'; requires 'Carp'; requires 'Class::C3::Adopt::NEXT' => '0.07'; requires 'CGI::Simple::Cookie' => '1.109'; @@ -43,6 +45,7 @@ requires 'Text::SimpleTable' => '0.03'; requires 'Time::HiRes'; requires 'Tree::Simple' => '1.15'; requires 'Tree::Simple::Visitor::FindByPath'; +requires 'Try::Tiny'; requires 'URI' => '1.35'; requires 'Task::Weaken'; requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness @@ -51,10 +54,15 @@ requires 'MooseX::Getopt' => '0.30'; requires 'MooseX::Types'; requires 'MooseX::Types::Common::Numeric'; requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace +requires 'Plack' => '0.9974'; # IIS6 fix middleware +requires 'Plack::Middleware::ReverseProxy' => '0.04'; +requires 'Plack::Test::ExternalServer'; test_requires 'Class::Data::Inheritable'; test_requires 'Test::Exception'; test_requires 'Test::More' => '0.88'; +test_requires 'Data::Dump'; +test_requires 'HTTP::Request::Common'; # aggregate tests if AGGREGATE_TESTS is set and a recent Test::Aggregate and a Test::Simple it works with is available if ($ENV{AGGREGATE_TESTS} && can_use('Test::Simple', '0.88') && can_use('Test::Aggregate', '0.364')) { @@ -70,13 +78,17 @@ else { author_requires 'CatalystX::LeakChecker', '0.05'; author_requires 'File::Copy::Recursive'; # For http server test author_requires 'Catalyst::Devel', '1.0'; # For http server test +author_requires 'Catalyst::Engine::PSGI'; +author_requires 'Test::Without::Module'; +author_requires 'Starman'; +author_requires 'MooseX::Daemonize'; author_tests 't/author'; author_requires(map {; $_ => 0 } qw( Test::NoTabs Test::Pod Test::Pod::Coverage - Pod::Coverage + Pod::Coverage::TrustPod )); if ($Module::Install::AUTHOR) { @@ -125,27 +137,32 @@ my %conflicts = ( 'Catalyst::Plugin::Unicode::Encoding' => '0.2', 'Catalyst::Plugin::Authentication' => '0.10010', # _config accessor in ::Credential::Password 'Catalyst::Authentication::Credential::HTTP' => '1.009', - 'Catalyst::Plugin::Session::Store::File' => '0.16', - 'Catalyst::Plugin::Session' => '0.21', - 'Catalyst::Plugin::Session::State::Cookie' => '0.10', + 'Catalyst::Plugin::Session::Store::File' => '0.16', + 'Catalyst::Plugin::Session' => '0.21', + 'Catalyst::Plugin::Session::State::Cookie' => '0.10', 'Catalyst::Plugin::Session::Store::FastMmap' => '0.09', - 'Catalyst::Controller::AllowDisable' => '0.03', - 'Reaction' => '0.001999', - 'Catalyst::Plugin::Upload::Image::Magick' => '0.03', - 'Catalyst::Plugin::ConfigLoader' => '0.22', # Older versions work but + 'Catalyst::Controller::AllowDisable' => '0.03', + 'Reaction' => '0.001999', + 'Catalyst::Plugin::Upload::Image::Magick' => '0.03', + 'Catalyst::Plugin::ConfigLoader' => '0.22', # Older versions work but # throw Data::Visitor warns - 'Catalyst::Devel' => '1.19', - 'Catalyst::Plugin::SmartURI' => '0.032', - 'CatalystX::CRUD' => '0.37', - 'Catalyst::Action::RenderView' => '0.07', - 'Catalyst::Plugin::DebugCookie' => '0.999002', - 'Catalyst::Plugin::Authentication' => '0.100091', - 'CatalystX::Imports' => '0.03', - 'Catalyst::Plugin::HashedCookies' => '1.03', - 'Catalyst::Action::REST' => '0.67', - 'CatalystX::CRUD' => '0.42', - 'CatalystX::CRUD::Model::RDBO' => '0.20', - 'Catalyst::View::Mason' => '0.17', + 'Catalyst::Devel' => '1.19', + 'Catalyst::Plugin::SmartURI' => '0.032', + 'CatalystX::CRUD' => '0.37', + 'Catalyst::Action::RenderView' => '0.07', + 'Catalyst::Plugin::DebugCookie' => '0.999002', + 'Catalyst::Plugin::Authentication' => '0.100091', + 'CatalystX::Imports' => '0.03', + 'Catalyst::Plugin::HashedCookies' => '1.03', + 'Catalyst::Action::REST' => '0.67', + 'CatalystX::CRUD' => '0.42', + 'CatalystX::CRUD::Model::RDBO' => '0.20', + 'Catalyst::View::Mason' => '0.17', +# Note these are not actually needed - they fail tests against the +# new version, but still work fine.. +# 'Catalyst::ActionRole::ACL' => '0.05', +# 'Catalyst::Plugin::Session::Store::DBIC' => '0.11', + 'Test::WWW::Mechanize::Catalyst' => '0.53', # Dep warnings unless upgraded. ); check_conflicts(%conflicts); diff --git a/TODO b/TODO index 8fd77ad..81bda4b 100644 --- a/TODO +++ b/TODO @@ -24,14 +24,40 @@ subclass of Catalyst::Log, no ::Plugin:: needed. See also: Catalyst::Plugin::Log::Dispatch and http://github.com/willert/catalyst-plugin-log4perl-simple/tree -# REFACTORING +## Capture arguments that the plack engine component was run with somewhere, + to more easily support custom args from scripts (e.g. Gitalist's + --git_dir) -## The horrible hack for plugin setup - replacing it: +## throw away the restarter and allow using the restarters Plack provides + +## remove per-request state from the engine instance + +## be smarter about how we use PSGI - not every response needs to be delayed + and streaming + +# The horrible hack for plugin setup - replacing it: * Have a look at the Devel::REPL BEFORE_PLUGIN stuff I wonder if what we need is that combined with plugins-as-roles -## App / ctx split: +# PSGI + +## To do at release time + + - Release psgi branch of Catalyst-Devel + - Release new Task::Catalyst + - Release 5.9 branch of Catalyst-Manual + - Release Catalyst::Engine::HTTP::Prefork with deprecation notice + + exit in Makefile.PL if Catalyst > 5.89 is installed. + +## Blockers + + * I've noticed a small difference with Catalyst::Test. The latest stable + version include two headers, 'host' and 'https'. They are missing from + this version - Pedro Melo on list + ^^ Cannot replicate this? Mailed back to ask for tests.. + +# App / ctx split: NOTE - these are notes that t0m thought up after doing back compat for catalyst_component_class, may be inaccurate, wrong or missing things diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index fd57ca6..6155e9c 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -16,7 +16,6 @@ use Catalyst::Utils; use Catalyst::Controller; use Data::OptList; use Devel::InnerPackage (); -use File::stat; use Module::Pluggable::Object (); use Text::SimpleTable (); use Path::Class::Dir (); @@ -29,8 +28,15 @@ use Tree::Simple::Visitor::FindByUID; use Class::C3::Adopt::NEXT; use List::MoreUtils qw/uniq/; use attributes; +use String::RewritePrefix; +use Catalyst::EngineLoader; use utf8; use Carp qw/croak carp shortmess/; +use Try::Tiny; +use Plack::Middleware::Conditional; +use Plack::Middleware::ReverseProxy; +use Plack::Middleware::IIS6ScriptNameFix; +use Plack::Middleware::LighttpdScriptNameFix; BEGIN { require 5.008004; } @@ -68,18 +74,17 @@ our $GO = Catalyst::Exception::Go->new; #maybe we should just make them attributes with a default? __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log dispatcher_class - engine_class context_class request_class response_class stats_class - setup_finished/; + engine_loader context_class request_class response_class stats_class + setup_finished _psgi_app loading_psgi_file/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); -__PACKAGE__->engine_class('Catalyst::Engine::CGI'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80033'; +our $VERSION = '5.89003'; sub import { my ( $class, @arguments ) = @_; @@ -1117,7 +1122,10 @@ sub setup { $class->setup_log( delete $flags->{log} ); $class->setup_plugins( delete $flags->{plugins} ); $class->setup_dispatcher( delete $flags->{dispatcher} ); - $class->setup_engine( delete $flags->{engine} ); + if (my $engine = delete $flags->{engine}) { + $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading"); + } + $class->setup_engine(); $class->setup_stats( delete $flags->{stats} ); for my $flag ( sort keys %{$flags} ) { @@ -1867,9 +1875,9 @@ sub finalize_headers { # get the length from a filehandle if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' ) { - my $stat = stat $response->body; - if ( $stat && $stat->size > 0 ) { - $response->content_length( $stat->size ); + my $size = -s $response->body; + if ( $size ) { + $response->content_length( $size ); } else { $c->log->warn('Serving filehandle without a content-length'); @@ -1943,7 +1951,7 @@ sub handle_request { # Always expect worst case! my $status = -1; - eval { + try { if ($class->debug) { my $secs = time - $START || 1; my $av = sprintf '%.3f', $COUNT / $secs; @@ -1954,12 +1962,11 @@ sub handle_request { my $c = $class->prepare(@arguments); $c->dispatch; $status = $c->finalize; - }; - - if ( my $error = $@ ) { - chomp $error; - $class->log->error(qq/Caught exception in engine "$error"/); } + catch { + chomp(my $error = $_); + $class->log->error(qq/Caught exception in engine "$error"/); + }; $COUNT++; @@ -1996,28 +2003,38 @@ sub prepare { $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } - #XXX reuse coderef from can - # Allow engine to direct the prepare flow (for POE) - if ( $c->engine->can('prepare') ) { - $c->engine->prepare( $c, @arguments ); - } - else { - $c->prepare_request(@arguments); - $c->prepare_connection; - $c->prepare_query_parameters; - $c->prepare_headers; - $c->prepare_cookies; - $c->prepare_path; - - # Prepare the body for reading, either by prepare_body - # or the user, if they are using $c->read - $c->prepare_read; - - # Parse the body unless the user wants it on-demand - unless ( ref($c)->config->{parse_on_demand} ) { - $c->prepare_body; + try { + # Allow engine to direct the prepare flow (for POE) + if ( my $prepare = $c->engine->can('prepare') ) { + $c->engine->$prepare( $c, @arguments ); + } + else { + $c->prepare_request(@arguments); + $c->prepare_connection; + $c->prepare_query_parameters; + $c->prepare_headers; + $c->prepare_cookies; + $c->prepare_path; + + # Prepare the body for reading, either by prepare_body + # or the user, if they are using $c->read + $c->prepare_read; + + # Parse the body unless the user wants it on-demand + unless ( ref($c)->config->{parse_on_demand} ) { + $c->prepare_body; + } } } + # VERY ugly and probably shouldn't rely on ->finalize actually working + catch { + # failed prepare is always due to an invalid request, right? + $c->response->status(400); + $c->response->content_type('text/plain'); + $c->response->body('Bad Request'); + $c->finalize; + die $_; + }; my $method = $c->req->method || ''; my $path = $c->req->path; @@ -2396,7 +2413,12 @@ Starts the engine. =cut -sub run { my $c = shift; return $c->engine->run( $c, @_ ) } +sub run { + my $app = shift; + $app->engine_loader->needs_psgi_engine_compat_hack ? + $app->engine->run($app, @_) : + $app->engine->run( $app, $app->_finalized_psgi_app, @_ ); +} =head2 $c->set_action( $action, $code, $namespace, $attrs ) @@ -2580,114 +2602,166 @@ Sets up engine. =cut +sub engine_class { + my ($class, $requested_engine) = @_; + + if (!$class->engine_loader || $requested_engine) { + $class->engine_loader( + Catalyst::EngineLoader->new({ + application_name => $class, + (defined $requested_engine + ? (requested_engine => $requested_engine) : ()), + }), + ); + } + $class->engine_loader->catalyst_engine_class; +} + sub setup_engine { - my ( $class, $engine ) = @_; + my ($class, $requested_engine) = @_; + + my $engine = $class->engine_class($requested_engine); - if ($engine) { - $engine = 'Catalyst::Engine::' . $engine; + # Don't really setup_engine -- see _setup_psgi_app for explanation. + return if $class->loading_psgi_file; + + Class::MOP::load_class($engine); + + if ($ENV{MOD_PERL}) { + my $apache = $class->engine_loader->auto; + + my $meta = find_meta($class); + my $was_immutable = $meta->is_immutable; + my %immutable_options = $meta->immutable_options; + $meta->make_mutable if $was_immutable; + + $meta->add_method(handler => sub { + my $r = shift; + my $psgi_app = $class->psgi_app; + $apache->call_app($r, $psgi_app); + }); + + $meta->make_immutable(%immutable_options) if $was_immutable; } - if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) { - $engine = 'Catalyst::Engine::' . $env; + $class->engine( $engine->new ); + + return; +} + +sub _finalized_psgi_app { + my ($app) = @_; + + unless ($app->_psgi_app) { + my $psgi_app = $app->_setup_psgi_app; + $app->_psgi_app($psgi_app); } - if ( $ENV{MOD_PERL} ) { - my $meta = Class::MOP::get_metaclass_by_name($class); + return $app->_psgi_app; +} - # create the apache method - $meta->add_method('apache' => sub { shift->engine->apache }); +sub _setup_psgi_app { + my ($app) = @_; - my ( $software, $version ) = - $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; + for my $home (Path::Class::Dir->new($app->config->{home})) { + my $psgi_file = $home->file( + Catalyst::Utils::appprefix($app) . '.psgi', + ); - $version =~ s/_//g; - $version =~ s/(\.[^.]+)\./$1/g; + next unless -e $psgi_file; - if ( $software eq 'mod_perl' ) { + # If $psgi_file calls ->setup_engine, it's doing so to load + # Catalyst::Engine::PSGI. But if it does that, we're only going to + # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine + # anyway. So set a flag (ick) that tells setup_engine not to populate + # $c->engine or do any other things we might regret. - if ( !$engine ) { + $app->loading_psgi_file(1); + my $psgi_app = Plack::Util::load_psgi($psgi_file); + $app->loading_psgi_file(0); - if ( $version >= 1.99922 ) { - $engine = 'Catalyst::Engine::Apache2::MP20'; - } + return $psgi_app + unless $app->engine_loader->needs_psgi_engine_compat_hack; - elsif ( $version >= 1.9901 ) { - $engine = 'Catalyst::Engine::Apache2::MP19'; - } + warn <<"EOW"; +Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}. - elsif ( $version >= 1.24 ) { - $engine = 'Catalyst::Engine::Apache::MP13'; - } +Its content has been ignored. Please consult the Catalyst::Upgrading +documentation on how to upgrade from Catalyst::Engine::PSGI. +EOW + } - else { - Catalyst::Exception->throw( message => - qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); - } + return $app->apply_default_middlewares($app->psgi_app); +} - } +=head2 $c->apply_default_middlewares - # install the correct mod_perl handler - if ( $version >= 1.9901 ) { - *handler = sub : method { - shift->handle_request(@_); - }; - } - else { - *handler = sub ($$) { shift->handle_request(@_) }; - } +Adds the following L middlewares to your application, since they are +useful and commonly needed: - } +L, (conditionally added based on the status +of your $ENV{REMOTE_ADDR}, and can be forced on with C +or forced off with C), L +(if you are using Lighttpd), L (always +applied since this middleware is smart enough to conditionally apply itself). - elsif ( $software eq 'Zeus-Perl' ) { - $engine = 'Catalyst::Engine::Zeus'; - } +Additionally if we detect we are using Nginx, we add a bit of custom middleware +to solve some problems with the way that server handles $ENV{PATH_INFO} and +$ENV{SCRIPT_NAME} - else { - Catalyst::Exception->throw( - message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ ); - } - } +=cut - unless ($engine) { - $engine = $class->engine_class; - } - Class::MOP::load_class($engine); +sub apply_default_middlewares { + my ($app, $psgi_app) = @_; - # check for old engines that are no longer compatible - my $old_engine; - if ( $engine->isa('Catalyst::Engine::Apache') - && !Catalyst::Engine::Apache->VERSION ) - { - $old_engine = 1; - } + $psgi_app = Plack::Middleware::Conditional->wrap( + $psgi_app, + builder => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) }, + condition => sub { + my ($env) = @_; + return if $app->config->{ignore_frontend_proxy}; + return $env->{REMOTE_ADDR} eq '127.0.0.1' + || $app->config->{using_frontend_proxy}; + }, + ); - elsif ( $engine->isa('Catalyst::Engine::Server::Base') - && Catalyst::Engine::Server->VERSION le '0.02' ) - { - $old_engine = 1; - } + my $server_matches = sub { + my ($re) = @_; + return sub { + my ($env) = @_; + my $server = $env->{SERVER_SOFTWARE}; + return unless $server; + return $server =~ $re ? 1 : 0; + }; + }; - elsif ($engine->isa('Catalyst::Engine::HTTP::POE') - && $engine->VERSION eq '0.01' ) - { - $old_engine = 1; - } + # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME + # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html + $psgi_app = Plack::Middleware::LighttpdScriptNameFix->wrap($psgi_app); - elsif ($engine->isa('Catalyst::Engine::Zeus') - && $engine->VERSION eq '0.01' ) - { - $old_engine = 1; - } + # we're applying this unconditionally as the middleware itself already makes + # sure it doesn't fuck things up if it's not running under one of the right + # IIS versions + $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app); - if ($old_engine) { - Catalyst::Exception->throw( message => - qq/Engine "$engine" is not supported by this version of Catalyst/ - ); - } + return $psgi_app; +} - # engine instance - $class->engine( $engine->new ); +=head2 $c->psgi_app + +Returns a PSGI application code reference for the catalyst application +C<$c>. This is the bare application without any middlewares +applied. C<${myapp}.psgi> is not taken into account. + +This is what you want to be using to retrieve the PSGI application code +reference of your Catalyst application for use in F<.psgi> files. + +=cut + +sub psgi_app { + my ($app) = @_; + return $app->engine->build_psgi_app($app); } =head2 $c->setup_home @@ -2973,8 +3047,46 @@ to be shown in hit debug tables in the test server. =item * C - Controlls if the C or C environment -variable should be used for determining the request path. See L -for more information. +variable should be used for determining the request path. + +Most web server environments pass the requested path to the application using environment variables, +from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application, +exposed as C<< $c->request->base >>) and the request path below that base. + +There are two methods of doing this, both of which have advantages and disadvantages. Which method is used +is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false). + +=over + +=item use_request_uri_for_path => 0 + +This is the default (and the) traditional method that Catalyst has used for determining the path information. +The path is synthesised from a combination of the C and C environment variables. +The allows the application to behave correctly when C is being used to redirect requests +into the application, as these variables are adjusted by mod_rewrite to take account for the redirect. + +However this method has the major disadvantage that it is impossible to correctly decode some elements +of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot +contain path-segment parameters. >>" This means PATH_INFO is B decoded, and therefore Catalyst +can't distinguish / vs %2F in paths (in addition to other encoded values). + +=item use_request_uri_for_path => 1 + +This method uses the C and C environment variables. As C is never +decoded, this means that applications using this mode can correctly handle URIs including the %2F character +(i.e. with C set to C in Apache). + +Given that this method of path resolution is provably more correct, it is recommended that you use +this unless you have a specific need to deploy your application in a non-standard environment, and you are +aware of the implications of not being able to handle encoded URI paths correctly. + +However it also means that in a number of cases when the app isn't installed directly at a path, but instead +is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a +.htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed +at other URIs than that which the app is 'normally' based at with C), the resolution of +C<< $c->request->base >> will be incorrect. + +=back =item * diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index f63c1a7..8451b8d 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -738,7 +738,7 @@ foreach my $public_method_name (qw/ $package_hash{$class}++ || do { warn("Class $class is calling the deprecated method\n" . " Catalyst::Dispatcher::$public_method_name,\n" - . " this will be removed in Catalyst 5.9X\n"); + . " this will be removed in Catalyst 5.9\n"); }; }); } diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index b7f57fd..b34ceec 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -10,12 +10,26 @@ use HTML::Entities; use HTTP::Body; use HTTP::Headers; use URI::QueryParam; +use Moose::Util::TypeConstraints; +use Plack::Loader; +use Catalyst::EngineLoader; use Encode (); use utf8; use namespace::clean -except => 'meta'; -has env => (is => 'rw', writer => '_set_env'); +has env => (is => 'ro', writer => '_set_env', clearer => '_clear_env'); + +my $WARN_ABOUT_ENV = 0; +around env => sub { + my ($orig, $self, @args) = @_; + if(@args) { + warn "env as a writer is deprecated, you probably need to upgrade Catalyst::Engine::PSGI" + unless $WARN_ABOUT_ENV++; + return $self->_set_env(@args); + } + return $self->$orig; +}; # input position and length has read_length => (is => 'rw'); @@ -23,6 +37,21 @@ has read_position => (is => 'rw'); has _prepared_write => (is => 'rw'); +has _response_cb => ( + is => 'ro', + isa => 'CodeRef', + writer => '_set_response_cb', + clearer => '_clear_response_cb', + predicate => '_has_response_cb', +); + +has _writer => ( + is => 'ro', + isa => duck_type([qw(write close)]), + writer => '_set_writer', + clearer => '_clear_writer', +); + # Amount of data to read from input on each pass our $CHUNKSIZE = 64 * 1024; @@ -61,6 +90,12 @@ sub finalize_body { else { $self->write( $c, $body ); } + + $self->_writer->close; + $self->_clear_writer; + $self->_clear_env; + + return; } =head2 $self->finalize_cookies($c) @@ -310,7 +345,26 @@ Abstract method, allows engines to write headers to response =cut -sub finalize_headers { } +sub finalize_headers { + my ($self, $ctx) = @_; + + # This is a less-than-pretty hack to avoid breaking the old + # Catalyst::Engine::PSGI. 5.9 Catalyst::Engine sets a response_cb and + # expects us to pass headers to it here, whereas Catalyst::Enngine::PSGI + # just pulls the headers out of $ctx->response in its run method and never + # sets response_cb. So take the lack of a response_cb as a sign that we + # don't need to set the headers. + + return unless $self->_has_response_cb; + + my @headers; + $ctx->response->headers->scan(sub { push @headers, @_ }); + + $self->_set_writer($self->_response_cb->([ $ctx->response->status, \@headers ])); + $self->_clear_response_cb; + + return; +} =head2 $self->finalize_read($c) @@ -409,7 +463,22 @@ Abstract method implemented in engines. =cut -sub prepare_connection { } +sub prepare_connection { + my ($self, $ctx) = @_; + + my $env = $self->env; + my $request = $ctx->request; + + $request->address( $env->{REMOTE_ADDR} ); + $request->hostname( $env->{REMOTE_HOST} ) + if exists $env->{REMOTE_HOST}; + $request->protocol( $env->{SERVER_PROTOCOL} ); + $request->remote_user( $env->{REMOTE_USER} ); + $request->method( $env->{REQUEST_METHOD} ); + $request->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 ); + + return; +} =head2 $self->prepare_cookies($c) @@ -429,7 +498,19 @@ sub prepare_cookies { =cut -sub prepare_headers { } +sub prepare_headers { + my ($self, $ctx) = @_; + + my $env = $self->env; + my $headers = $ctx->request->headers; + + for my $header (keys %{ $env }) { + next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i; + (my $field = $header) =~ s/^HTTPS?_//; + $field =~ tr/_/-/; + $headers->header($field => $env->{$header}); + } +} =head2 $self->prepare_parameters($c) @@ -467,7 +548,61 @@ abstract method, implemented by engines. =cut -sub prepare_path { } +sub prepare_path { + my ($self, $ctx) = @_; + + my $env = $self->env; + + my $scheme = $ctx->request->secure ? 'https' : 'http'; + my $host = $env->{HTTP_HOST} || $env->{SERVER_NAME}; + my $port = $env->{SERVER_PORT} || 80; + my $base_path = $env->{SCRIPT_NAME} || "/"; + + # set the request URI + my $path; + if (!$ctx->config->{use_request_uri_for_path}) { + my $path_info = $env->{PATH_INFO}; + if ( exists $env->{REDIRECT_URL} ) { + $base_path = $env->{REDIRECT_URL}; + $base_path =~ s/\Q$path_info\E$//; + } + $path = $base_path . $path_info; + $path =~ s{^/+}{}; + $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE + } + else { + my $req_uri = $env->{REQUEST_URI}; + $req_uri =~ s/\?.*$//; + $path = $req_uri; + $path =~ s{^/+}{}; + } + + # Using URI directly is way too slow, so we construct the URLs manually + my $uri_class = "URI::$scheme"; + + # HTTP_HOST will include the port even if it's 80/443 + $host =~ s/:(?:80|443)$//; + + if ($port !~ /^(?:80|443)$/ && $host !~ /:/) { + $host .= ":$port"; + } + + my $query = $env->{QUERY_STRING} ? '?' . $env->{QUERY_STRING} : ''; + my $uri = $scheme . '://' . $host . '/' . $path . $query; + + $ctx->request->uri( (bless \$uri, $uri_class)->canonical ); + + # set the base URI + # base must end in a slash + $base_path .= '/' unless $base_path =~ m{/$}; + + my $base_uri = $scheme . '://' . $host . $base_path; + + $ctx->request->base( bless \$base_uri, $uri_class ); + + return; +} =head2 $self->prepare_request($c) @@ -478,7 +613,11 @@ process the query string and extract query parameters. =cut sub prepare_query_parameters { - my ( $self, $c, $query_string ) = @_; + my ($self, $c) = @_; + + my $query_string = exists $self->env->{QUERY_STRING} + ? $self->env->{QUERY_STRING} + : ''; # Check for keywords (no = signs) # (yes, index() is faster than a regex :)) @@ -540,7 +679,10 @@ Populate the context object from the request object. =cut -sub prepare_request { } +sub prepare_request { + my ($self, $ctx, %args) = @_; + $self->_set_env($args{env}); +} =head2 $self->prepare_uploads($c) @@ -620,7 +762,7 @@ sub read { my $rc = $self->read_chunk( $c, my $buffer, $readlen ); if ( defined $rc ) { if (0 == $rc) { # Nothing more to read even though Content-Length - # said there should be. FIXME - Warn in the log here? + # said there should be. $self->finalize_read; return; } @@ -641,7 +783,10 @@ there is no more data to be read. =cut -sub read_chunk { } +sub read_chunk { + my ($self, $ctx) = (shift, shift); + return $self->env->{'psgi.input'}->read(@_); +} =head2 $self->read_length @@ -652,13 +797,62 @@ header. The amount of input data that has already been read. -=head2 $self->run($c) +=head2 $self->run($app, $server) + +Start the engine. Builds a PSGI application and calls the +run method on the server passed in, which then causes the +engine to loop, handling requests.. + +=cut + +sub run { + my ($self, $app, $psgi, @args) = @_; + # @args left here rather than just a $options, $server for back compat with the + # old style scripts which send a few args, then a hashref + + # They should never actually be used in the normal case as the Plack engine is + # passed in got all the 'standard' args via the loader in the script already. + + # FIXME - we should stash the options in an attribute so that custom args + # like Gitalist's --git_dir are possible to get from the app without stupid tricks. + my $server = pop @args if (scalar @args && blessed $args[-1]); + my $options = pop @args if (scalar @args && ref($args[-1]) eq 'HASH'); + # Back compat hack for applications with old (non Catalyst::Script) scripts to work in FCGI. + if (scalar @args && !ref($args[0])) { + if (my $listen = shift @args) { + $options->{listen} ||= [$listen]; + } + } + if (! $server ) { + $server = Catalyst::EngineLoader->new(application_name => ref($self))->auto(%$options); + # We're not being called from a script, so auto detect what backend to + # run on. This should never happen, as mod_perl never calls ->run, + # instead the $app->handle method is called per request. + $app->log->warn("Not supplied a Plack engine, falling back to engine auto-loader (are your scripts ancient?)") + } + $server->run($psgi, $options); +} + +=head2 build_psgi_app ($app, @args) -Start the engine. Implemented by the various engine classes. +Builds and returns a PSGI application closure, wrapping it in the reverse proxy +middleware if the using_frontend_proxy config setting is set. =cut -sub run { } +sub build_psgi_app { + my ($self, $app, @args) = @_; + + return sub { + my ($env) = @_; + + return sub { + my ($respond) = @_; + $self->_set_response_cb($respond); + $app->handle_request(env => $env); + }; + }; +} =head2 $self->write($c, $buffer) @@ -674,33 +868,12 @@ sub write { $self->_prepared_write(1); } - return 0 if !defined $buffer; + $buffer = q[] unless defined $buffer; - my $len = length($buffer); - my $wrote = syswrite STDOUT, $buffer; - - if ( !defined $wrote && $! == EWOULDBLOCK ) { - # Unable to write on the first try, will retry in the loop below - $wrote = 0; - } - - if ( defined $wrote && $wrote < $len ) { - # We didn't write the whole buffer - while (1) { - my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote; - if ( defined $ret ) { - $wrote += $ret; - } - else { - next if $! == EWOULDBLOCK; - return; - } - - last if $wrote >= $len; - } - } + my $len = length($buffer); + $self->_writer->write($buffer); - return $wrote; + return $len; } =head2 $self->unescape_uri($uri) diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm deleted file mode 100644 index bd670da..0000000 --- a/lib/Catalyst/Engine/CGI.pm +++ /dev/null @@ -1,328 +0,0 @@ -package Catalyst::Engine::CGI; - -use Moose; -extends 'Catalyst::Engine'; - -has _header_buf => (is => 'rw', clearer => '_clear_header_buf', predicate => '_has_header_buf'); - -=head1 NAME - -Catalyst::Engine::CGI - The CGI Engine - -=head1 SYNOPSIS - -A script using the Catalyst::Engine::CGI module might look like: - - #!/usr/bin/perl -w - - use strict; - use lib '/path/to/MyApp/lib'; - use MyApp; - - MyApp->run; - -The application module (C) would use C, which loads the -appropriate engine module. - -=head1 DESCRIPTION - -This is the Catalyst engine specialized for the CGI environment. - -=head1 PATH DECODING - -Most web server environments pass the requested path to the application using environment variables, -from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application, -exposed as C<< $c->request->base >>) and the request path below that base. - -There are two methods of doing this, both of which have advantages and disadvantages. Which method is used -is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false). - -=head2 use_request_uri_for_path => 0 - -This is the default (and the) traditional method that Catalyst has used for determining the path information. -The path is synthesised from a combination of the C and C environment variables. -The allows the application to behave correctly when C is being used to redirect requests -into the application, as these variables are adjusted by mod_rewrite to take account for the redirect. - -However this method has the major disadvantage that it is impossible to correctly decode some elements -of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot -contain path-segment parameters. >>" This means PATH_INFO is B decoded, and therefore Catalyst -can't distinguish / vs %2F in paths (in addition to other encoded values). - -=head2 use_request_uri_for_path => 1 - -This method uses the C and C environment variables. As C is never -decoded, this means that applications using this mode can correctly handle URIs including the %2F character -(i.e. with C set to C in Apache). - -Given that this method of path resolution is provably more correct, it is recommended that you use -this unless you have a specific need to deploy your application in a non-standard environment, and you are -aware of the implications of not being able to handle encoded URI paths correctly. - -However it also means that in a number of cases when the app isn't installed directly at a path, but instead -is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a -.htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed -at other URIs than that which the app is 'normally' based at with C), the resolution of -C<< $c->request->base >> will be incorrect. - -=head1 OVERLOADED METHODS - -This class overloads some methods from C. - -=head2 $self->finalize_headers($c) - -=cut - -sub finalize_headers { - my ( $self, $c ) = @_; - - $c->response->header( Status => $c->response->status ); - - $self->_header_buf($c->response->headers->as_string("\015\012") . "\015\012"); -} - -=head2 $self->prepare_connection($c) - -=cut - -sub prepare_connection { - my ( $self, $c ) = @_; - local (*ENV) = $self->env || \%ENV; - - my $request = $c->request; - $request->address( $ENV{REMOTE_ADDR} ); - - PROXY_CHECK: - { - unless ( ref($c)->config->{using_frontend_proxy} ) { - last PROXY_CHECK if $ENV{REMOTE_ADDR} ne '127.0.0.1'; - last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy}; - } - last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_FOR}; - - # If we are running as a backend server, the user will always appear - # as 127.0.0.1. Select the most recent upstream IP (last in the list) - my ($ip) = $ENV{HTTP_X_FORWARDED_FOR} =~ /([^,\s]+)$/; - $request->address($ip); - if ( defined $ENV{HTTP_X_FORWARDED_PORT} ) { - $ENV{SERVER_PORT} = $ENV{HTTP_X_FORWARDED_PORT}; - } - } - - $request->hostname( $ENV{REMOTE_HOST} ) if exists $ENV{REMOTE_HOST}; - $request->protocol( $ENV{SERVER_PROTOCOL} ); - $request->user( $ENV{REMOTE_USER} ); # XXX: Deprecated. See Catalyst::Request for removal information - $request->remote_user( $ENV{REMOTE_USER} ); - $request->method( $ENV{REQUEST_METHOD} ); - - if ( $ENV{HTTPS} && uc( $ENV{HTTPS} ) eq 'ON' ) { - $request->secure(1); - } - - if ( $ENV{SERVER_PORT} == 443 ) { - $request->secure(1); - } - binmode(STDOUT); # Ensure we are sending bytes. -} - -=head2 $self->prepare_headers($c) - -=cut - -sub prepare_headers { - my ( $self, $c ) = @_; - local (*ENV) = $self->env || \%ENV; - my $headers = $c->request->headers; - # Read headers from %ENV - foreach my $header ( keys %ENV ) { - next unless $header =~ /^(?:HTTP|CONTENT|COOKIE)/i; - ( my $field = $header ) =~ s/^HTTPS?_//; - $headers->header( $field => $ENV{$header} ); - } -} - -=head2 $self->prepare_path($c) - -=cut - -# Please don't touch this method without adding tests in -# t/aggregate/unit_core_engine_cgi-prepare_path.t -sub prepare_path { - my ( $self, $c ) = @_; - local (*ENV) = $self->env || \%ENV; - - my $scheme = $c->request->secure ? 'https' : 'http'; - my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME}; - my $port = $ENV{SERVER_PORT} || 80; - - # fix up for IIS - if ($ENV{SERVER_SOFTWARE} && $ENV{SERVER_SOFTWARE} =~ m{IIS/[6-9]\.\d}) { - $ENV{PATH_INFO} =~ s/^\Q$ENV{SCRIPT_NAME}\E//; - } - - my $script_name = $ENV{SCRIPT_NAME}; - $script_name =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go if $script_name; - - my $base_path; - if ( exists $ENV{REDIRECT_URL} ) { - $base_path = $ENV{REDIRECT_URL}; - $base_path =~ s/\Q$ENV{PATH_INFO}\E$//; - } - else { - $base_path = $script_name || '/'; - } - - # If we are running as a backend proxy, get the true hostname - PROXY_CHECK: - { - unless ( ref($c)->config->{using_frontend_proxy} ) { - last PROXY_CHECK if $host !~ /localhost|127.0.0.1/; - last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy}; - } - last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_HOST}; - - $host = $ENV{HTTP_X_FORWARDED_HOST}; - - # backend could be on any port, so - # assume frontend is on the default port - $port = $c->request->secure ? 443 : 80; - if ( $ENV{HTTP_X_FORWARDED_PORT} ) { - $port = $ENV{HTTP_X_FORWARDED_PORT}; - } - } - - my $path_info = $ENV{PATH_INFO}; - if ($c->config->{use_request_uri_for_path}) { - # RFC 3875: "Unlike a URI path, the PATH_INFO is not URL-encoded, - # and cannot contain path-segment parameters." This means PATH_INFO - # is always decoded, and the script can't distinguish / vs %2F. - # See https://issues.apache.org/bugzilla/show_bug.cgi?id=35256 - # Here we try to resurrect the original encoded URI from REQUEST_URI. - if (my $req_uri = $ENV{REQUEST_URI}) { - if (defined $script_name) { - $req_uri =~ s/^\Q$script_name\E//; - } - $req_uri =~ s/\?.*$//; - $path_info = $req_uri if $req_uri; - } - } - - # set the request URI - my $path = $base_path . ( $path_info || '' ); - $path =~ s{^/+}{}; - - # Using URI directly is way too slow, so we construct the URLs manually - my $uri_class = "URI::$scheme"; - - # HTTP_HOST will include the port even if it's 80/443 - $host =~ s/:(?:80|443)$//; - - if ( $port !~ /^(?:80|443)$/ && $host !~ /:/ ) { - $host .= ":$port"; - } - - # Escape the path - $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; - $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE - - my $query = $ENV{QUERY_STRING} ? '?' . $ENV{QUERY_STRING} : ''; - my $uri = $scheme . '://' . $host . '/' . $path . $query; - - $c->request->uri( bless(\$uri, $uri_class)->canonical ); - - # set the base URI - # base must end in a slash - $base_path .= '/' unless $base_path =~ m{/$}; - - my $base_uri = $scheme . '://' . $host . $base_path; - - $c->request->base( bless \$base_uri, $uri_class ); -} - -=head2 $self->prepare_query_parameters($c) - -=cut - -around prepare_query_parameters => sub { - my $orig = shift; - my ( $self, $c ) = @_; - local (*ENV) = $self->env || \%ENV; - - if ( $ENV{QUERY_STRING} ) { - $self->$orig( $c, $ENV{QUERY_STRING} ); - } -}; - -=head2 $self->prepare_request($c, (env => \%env)) - -=cut - -sub prepare_request { - my ( $self, $c, %args ) = @_; - - if ( $args{env} ) { - $self->_set_env( $args{env} ); - } -} - -=head2 $self->prepare_write($c) - -Enable autoflush on the output handle for CGI-based engines. - -=cut - -around prepare_write => sub { - *STDOUT->autoflush(1); - return shift->(@_); -}; - -=head2 $self->write($c, $buffer) - -Writes the buffer to the client. - -=cut - -around write => sub { - my $orig = shift; - my ( $self, $c, $buffer ) = @_; - - # Prepend the headers if they have not yet been sent - if ( $self->_has_header_buf ) { - my $headers = $self->_clear_header_buf; - - $buffer = defined $buffer - ? $headers . $buffer : $headers; - } - - return $self->$orig( $c, $buffer ); -}; - -=head2 $self->read_chunk($c, $buffer, $length) - -=cut - -sub read_chunk { shift; shift; *STDIN->sysread(@_); } - -=head2 $self->run - -=cut - -sub run { shift; shift->handle_request( env => \%ENV ) } - -=head1 SEE ALSO - -L, L - -=head1 AUTHORS - -Catalyst Contributors, see Catalyst.pm - -=head1 COPYRIGHT - -This library is free software. You can redistribute it and/or modify it under -the same terms as Perl itself. - -=cut -no Moose; - -1; diff --git a/lib/Catalyst/Engine/FastCGI.pm b/lib/Catalyst/Engine/FastCGI.pm deleted file mode 100644 index 30bb3a5..0000000 --- a/lib/Catalyst/Engine/FastCGI.pm +++ /dev/null @@ -1,663 +0,0 @@ -package Catalyst::Engine::FastCGI; - -use Moose; -extends 'Catalyst::Engine::CGI'; - -# eval { Class::MOP::load_class("FCGI") }; -eval "use FCGI"; -die "Unable to load the FCGI module, you may need to install it:\n$@\n" if $@; - -=head1 NAME - -Catalyst::Engine::FastCGI - FastCGI Engine - -=head1 DESCRIPTION - -This is the FastCGI engine. - -=head1 OVERLOADED METHODS - -This class overloads some methods from C. - -=head2 $self->run($c, $listen, { option => value, ... }) - -Starts the FastCGI server. If C<$listen> is set, then it specifies a -location to listen for FastCGI requests; - -=over 4 - -=item /path - -listen via Unix sockets on /path - -=item :port - -listen via TCP on port on all interfaces - -=item hostname:port - -listen via TCP on port bound to hostname - -=back - -Options may also be specified; - -=over 4 - -=item leave_umask - -Set to 1 to disable setting umask to 0 for socket open - -=item nointr - -Do not allow the listener to be interrupted by Ctrl+C - -=item nproc - -Specify a number of processes for FCGI::ProcManager - -=item pidfile - -Specify a filename for the pid file - -=item manager - -Specify a FCGI::ProcManager sub-class - -=item detach - -Detach from console - -=item keep_stderr - -Send STDERR to STDOUT instead of the webserver - -=back - -=cut - -sub run { - my ( $self, $class, $listen, $options ) = @_; - - my $sock = 0; - if ($listen) { - my $old_umask = umask; - unless ( $options->{leave_umask} ) { - umask(0); - } - $sock = FCGI::OpenSocket( $listen, 100 ) - or die "failed to open FastCGI socket; $!"; - unless ( $options->{leave_umask} ) { - umask($old_umask); - } - } - elsif ( $^O ne 'MSWin32' ) { - -S STDIN - or die "STDIN is not a socket; specify a listen location"; - } - - $options ||= {}; - - my %env; - my $error = \*STDERR; # send STDERR to the web server - $error = \*STDOUT # send STDERR to stdout (a logfile) - if $options->{keep_stderr}; # (if asked to) - - my $request = - FCGI::Request( \*STDIN, \*STDOUT, $error, \%env, $sock, - ( $options->{nointr} ? 0 : &FCGI::FAIL_ACCEPT_ON_INTR ), - ); - - my $proc_manager; - - if ($listen) { - $options->{manager} ||= "FCGI::ProcManager"; - $options->{nproc} ||= 1; - $options->{proc_title} ||= "perl-fcgi-pm [$class]"; - - $self->daemon_fork() if $options->{detach}; - - if ( $options->{manager} ) { - eval "use $options->{manager}; 1" or die $@; - - $proc_manager = $options->{manager}->new( - { - n_processes => $options->{nproc}, - pid_fname => $options->{pidfile}, - pm_title => $options->{proc_title}, - } - ); - - # detach *before* the ProcManager inits - $self->daemon_detach() if $options->{detach}; - - $proc_manager->pm_manage(); - - # Give each child its own RNG state. - srand; - } - elsif ( $options->{detach} ) { - $self->daemon_detach(); - } - } - - while ( $request->Accept >= 0 ) { - $proc_manager && $proc_manager->pm_pre_dispatch(); - - $self->_fix_env( \%env ); - - $class->handle_request( env => \%env ); - - $proc_manager && $proc_manager->pm_post_dispatch(); - } -} - -=head2 $self->write($c, $buffer) - -=cut - -sub write { - my ( $self, $c, $buffer ) = @_; - - # ->write will be called once with the body, even in a redirect (and - # in that case, the body is undef) - $buffer = '' if !defined $buffer; - - unless ( $self->_prepared_write ) { - $self->prepare_write($c); - $self->_prepared_write(1); - } - - # XXX: We can't use Engine's write() method because syswrite - # appears to return bogus values instead of the number of bytes - # written: http://www.fastcgi.com/om_archive/mail-archive/0128.html - - # Prepend the headers if they have not yet been sent - if ( $self->_has_header_buf ) { - $buffer = $self->_clear_header_buf . $buffer; - } - - # FastCGI does not stream data properly if using 'print $handle', - # but a syswrite appears to work properly. - *STDOUT->syswrite($buffer); -} - -=head2 $self->daemon_fork() - -Performs the first part of daemon initialisation. Specifically, -forking. STDERR, etc are still connected to a terminal. - -=cut - -sub daemon_fork { - require POSIX; - fork && exit; -} - -=head2 $self->daemon_detach( ) - -Performs the second part of daemon initialisation. Specifically, -disassociates from the terminal. - -However, this does B change the current working directory to "/", -as normal daemons do. It also does not close all open file -descriptors (except STDIN, STDOUT and STDERR, which are re-opened from -F). - -=cut - -sub daemon_detach { - my $self = shift; - print "FastCGI daemon started (pid $$)\n"; - open STDIN, "+&STDIN" or die $!; - open STDERR, ">&STDIN" or die $!; - POSIX::setsid(); -} - -=head2 $self->_fix_env( $env ) - -Adjusts the environment variables when necessary. - -=cut - -sub _fix_env -{ - my $self = shift; - my $env = shift; - - # we are gonna add variables from current system environment %ENV to %env - # that contains at this moment just variables taken from FastCGI request - foreach my $k (keys(%ENV)) { - $env->{$k} = $ENV{$k} unless defined($env->{$k}); - } - - return unless ( $env->{SERVER_SOFTWARE} ); - - # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME - # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html - # Thanks to Mark Blythe for this fix - if ( $env->{SERVER_SOFTWARE} =~ /lighttpd/ ) { - $env->{PATH_INFO} ||= delete $env->{SCRIPT_NAME}; - } - elsif ( $env->{SERVER_SOFTWARE} =~ /^nginx/ ) { - my $script_name = $env->{SCRIPT_NAME}; - $env->{PATH_INFO} =~ s/^$script_name//g; - } - # Fix the environment variables PATH_INFO and SCRIPT_NAME when running - # under IIS - elsif ( $env->{SERVER_SOFTWARE} =~ /IIS\/[6-9]\.[0-9]/ ) { - my @script_name = split(m!/!, $env->{PATH_INFO}); - my @path_translated = split(m!/|\\\\?!, $env->{PATH_TRANSLATED}); - my @path_info; - - while ($script_name[$#script_name] eq $path_translated[$#path_translated]) { - pop(@path_translated); - unshift(@path_info, pop(@script_name)); - } - - unshift(@path_info, '', ''); - - $env->{PATH_INFO} = join('/', @path_info); - $env->{SCRIPT_NAME} = join('/', @script_name); - } -} - -1; -__END__ - -=head1 WEB SERVER CONFIGURATIONS - -=head2 Standalone FastCGI Server - -In server mode the application runs as a standalone server and accepts -connections from a web server. The application can be on the same machine as -the web server, on a remote machine, or even on multiple remote machines. -Advantages of this method include running the Catalyst application as a -different user than the web server, and the ability to set up a scalable -server farm. - -To start your application in server mode, install the FCGI::ProcManager -module and then use the included fastcgi.pl script. - - $ script/myapp_fastcgi.pl -l /tmp/myapp.socket -n 5 - -Command line options for fastcgi.pl include: - - -d -daemon Daemonize the server. - -p -pidfile Write a pidfile with the pid of the process manager. - -l -listen Listen on a socket path, hostname:port, or :port. - -n -nproc The number of processes started to handle requests. - -See below for the specific web server configurations for using the external -server. - -=head2 Apache 1.x, 2.x - -Apache requires the mod_fastcgi module. The same module supports both -Apache 1 and 2. - -There are three ways to run your application under FastCGI on Apache: server, -static, and dynamic. - -=head3 Standalone server mode - - FastCgiExternalServer /tmp/myapp.fcgi -socket /tmp/myapp.socket - Alias /myapp/ /tmp/myapp.fcgi/ - - # Or, run at the root - Alias / /tmp/myapp.fcgi/ - - # Optionally, rewrite the path when accessed without a trailing slash - RewriteRule ^/myapp$ myapp/ [R] - - -The FastCgiExternalServer directive tells Apache that when serving -/tmp/myapp to use the FastCGI application listenting on the socket -/tmp/mapp.socket. Note that /tmp/myapp.fcgi B exist -- -it's a virtual file name. With some versions of C or -C, you can use any name you like, but some require that the -virtual filename end in C<.fcgi>. - -It's likely that Apache is not configured to serve files in /tmp, so the -Alias directive maps the url path /myapp/ to the (virtual) file that runs the -FastCGI application. The trailing slashes are important as their use will -correctly set the PATH_INFO environment variable used by Catalyst to -determine the request path. If you would like to be able to access your app -without a trailing slash (http://server/myapp), you can use the above -RewriteRule directive. - -=head3 Static mode - -The term 'static' is misleading, but in static mode Apache uses its own -FastCGI Process Manager to start the application processes. This happens at -Apache startup time. In this case you do not run your application's -fastcgi.pl script -- that is done by Apache. Apache then maps URIs to the -FastCGI script to run your application. - - FastCgiServer /path/to/myapp/script/myapp_fastcgi.pl -processes 3 - Alias /myapp/ /path/to/myapp/script/myapp_fastcgi.pl/ - -FastCgiServer tells Apache to start three processes of your application at -startup. The Alias command maps a path to the FastCGI application. Again, -the trailing slashes are important. - -=head3 Dynamic mode - -In FastCGI dynamic mode, Apache will run your application on demand, -typically by requesting a file with a specific extension (e.g. .fcgi). ISPs -often use this type of setup to provide FastCGI support to many customers. - -In this mode it is often enough to place or link your *_fastcgi.pl script in -your cgi-bin directory with the extension of .fcgi. In dynamic mode Apache -must be able to run your application as a CGI script so ExecCGI must be -enabled for the directory. - - AddHandler fastcgi-script .fcgi - -The above tells Apache to run any .fcgi file as a FastCGI application. - -Here is a complete example: - - - ServerName www.myapp.com - DocumentRoot /path/to/MyApp - - # Allow CGI script to run - - Options +ExecCGI - - - # Tell Apache this is a FastCGI application - - SetHandler fastcgi-script - - - -Then a request for /script/myapp_fastcgi.pl will run the -application. - -For more information on using FastCGI under Apache, visit -L - -=head3 Authorization header with mod_fastcgi or mod_cgi - -By default, mod_fastcgi/mod_cgi do not pass along the Authorization header, -so modules like C will -not work. To enable pass-through of this header, add the following -mod_rewrite directives: - - RewriteCond %{HTTP:Authorization} ^(.+) - RewriteRule ^(.*)$ $1 [E=HTTP_AUTHORIZATION:%1,PT] - -=head2 Lighttpd - -These configurations were tested with Lighttpd 1.4.7. - -=head3 Standalone server mode - - server.document-root = "/var/www/MyApp/root" - - fastcgi.server = ( - "" => ( - "MyApp" => ( - "socket" => "/tmp/myapp.socket", - "check-local" => "disable" - ) - ) - ) - -=head3 Static mode - - server.document-root = "/var/www/MyApp/root" - - fastcgi.server = ( - "" => ( - "MyApp" => ( - "socket" => "/tmp/myapp.socket", - "check-local" => "disable", - "bin-path" => "/var/www/MyApp/script/myapp_fastcgi.pl", - "min-procs" => 2, - "max-procs" => 5, - "idle-timeout" => 20 - ) - ) - ) - -Note that in newer versions of lighttpd, the min-procs and idle-timeout -values are disabled. The above example would start 5 processes. - -=head3 Non-root configuration - -You can also run your application at any non-root location with either of the -above modes. Note the required mod_rewrite rule. - - url.rewrite = ( "myapp\$" => "myapp/" ) - fastcgi.server = ( - "/myapp" => ( - "MyApp" => ( - # same as above - ) - ) - ) - -For more information on using FastCGI under Lighttpd, visit -L - -=head2 nginx - -Catalyst runs under nginx via FastCGI in a similar fashion as the lighttpd -standalone server as described above. - -nginx does not have its own internal FastCGI process manager, so you must run -the FastCGI service separately. - -=head3 Configuration - -To configure nginx, you must configure the FastCGI parameters and also the -socket your FastCGI daemon is listening on. It can be either a TCP socket -or a Unix file socket. - -The server configuration block should look roughly like: - - server { - listen $port; - - location / { - fastcgi_param QUERY_STRING $query_string; - fastcgi_param REQUEST_METHOD $request_method; - fastcgi_param CONTENT_TYPE $content_type; - fastcgi_param CONTENT_LENGTH $content_length; - - fastcgi_param SCRIPT_NAME /; - fastcgi_param PATH_INFO $fastcgi_script_name; - fastcgi_param REQUEST_URI $request_uri; - fastcgi_param DOCUMENT_URI $document_uri; - fastcgi_param DOCUMENT_ROOT $document_root; - fastcgi_param SERVER_PROTOCOL $server_protocol; - - fastcgi_param GATEWAY_INTERFACE CGI/1.1; - fastcgi_param SERVER_SOFTWARE nginx/$nginx_version; - - fastcgi_param REMOTE_ADDR $remote_addr; - fastcgi_param REMOTE_PORT $remote_port; - fastcgi_param SERVER_ADDR $server_addr; - fastcgi_param SERVER_PORT $server_port; - fastcgi_param SERVER_NAME $server_name; - - # Adjust the socket for your applications! - fastcgi_pass unix:$docroot/myapp.socket; - } - } - -It is the standard convention of nginx to include the fastcgi_params in a -separate file (usually something like C) and -simply include that file. - -=head3 Non-root configuration - -If you properly specify the PATH_INFO and SCRIPT_NAME parameters your -application will be accessible at any path. The SCRIPT_NAME variable is the -prefix of your application, and PATH_INFO would be everything in addition. - -As an example, if your application is rooted at /myapp, you would configure: - - fastcgi_param SCRIPT_NAME /myapp/; - fastcgi_param PATH_INFO $fastcgi_script_name; - -C<$fastcgi_script_name> would be "/myapp/path/of/the/action". Catalyst will -process this accordingly and setup the application base as expected. - -This behavior is somewhat different than Apache and Lighttpd, but is still -functional. - -For more information on nginx, visit: -L - -=head2 Microsoft IIS - -It is possible to run Catalyst under IIS with FastCGI, but only on IIS 6.0 -(Microsoft Windows 2003), IIS 7.0 (Microsoft Windows 2008 and Vista) and -hopefully its successors. - -Even if it is declared that FastCGI is supported on IIS 5.1 (Windows XP) it -does not support some features (specifically: wildcard mappings) that prevents -running Catalyst application. - -Let us assume that our server has the following layout: - - d:\WWW\WebApp\ path to our Catalyst application - d:\strawberry\perl\bin\perl.exe path to perl interpreter (with Catalyst installed) - c:\windows Windows directory - -=head3 Setup IIS 6.0 (Windows 2003) - -=over 4 - -=item Install FastCGI extension for IIS 6.0 - -FastCGI is not a standard part of IIS 6 - you have to install it separately. For -more info and download go to L. Choose -approptiate version (32-bit/64-bit), installation is quite simple -(in fact no questions, no options). - -=item Create a new website - -Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager". -Click "Action" > "New" > "Web Site". After you finish the installation wizard -you need to go to the new website's properties. - -=item Set website properties - -On tab "Web site" set proper values for: -Site Description, IP Address, TCP Port, SSL Port etc. - -On tab "Home Directory" set the following: - - Local path: "d:\WWW\WebApp\root" - Local path permission flags: check only "Read" + "Log visits" - Execute permitions: "Scripts only" - -Click "Configuration" button (still on Home Directory tab) then click "Insert" -the wildcard application mapping and in the next dialog set: - - Executable: "c:\windows\system32\inetsrv\fcgiext.dll" - Uncheck: "Verify that file exists" - -Close all dialogs with "OK". - -=item Edit fcgiext.ini - -Put the following lines into c:\windows\system32\inetsrv\fcgiext.ini (on 64-bit -system c:\windows\syswow64\inetsrv\fcgiext.ini): - - [Types] - *:8=CatalystApp - ;replace 8 with the identification number of the newly created website - ;it is not so easy to get this number: - ; - you can use utility "c:\inetpub\adminscripts\adsutil.vbs" - ; to list websites: "cscript adsutil.vbs ENUM /P /W3SVC" - ; to get site name: "cscript adsutil.vbs GET /W3SVC//ServerComment" - ; to get all details: "cscript adsutil.vbs GET /W3SVC/" - ; - or look where are the logs located: - ; c:\WINDOWS\SYSTEM32\Logfiles\W3SVC7\whatever.log - ; means that the corresponding number is "7" - ;if you are running just one website using FastCGI you can use '*=CatalystApp' - - [CatalystApp] - ExePath=d:\strawberry\perl\bin\perl.exe - Arguments="d:\WWW\WebApp\script\webapp_fastcgi.pl -e" - - ;by setting this you can instruct IIS to serve Catalyst static files - ;directly not via FastCGI (in case of any problems try 1) - IgnoreExistingFiles=0 - - ;do not be fooled by Microsoft doc talking about "IgnoreExistingDirectories" - ;that does not work and use "IgnoreDirectories" instead - IgnoreDirectories=1 - -=back - -=head3 Setup IIS 7.0 (Windows 2008 and Vista) - -Microsoft IIS 7.0 has built-in support for FastCGI so you do not have to install -any addons. - -=over 4 - -=item Necessary steps during IIS7 installation - -During IIS7 installation after you have added role "Web Server (IIS)" -you need to check to install role feature "CGI" (do not be nervous that it is -not FastCGI). If you already have IIS7 installed you can add "CGI" role feature -through "Control panel" > "Programs and Features". - -=item Create a new website - -Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager" -> "Add Web Site". - - site name: "CatalystSite" - content directory: "d:\WWW\WebApp\root" - binding: set proper IP address, port etc. - -=item Configure FastCGI - -You can configure FastCGI extension using commandline utility -"c:\windows\system32\inetsrv\appcmd.exe" - -=over 4 - -=item Configuring section "fastCgi" (it is a global setting) - - appcmd.exe set config -section:system.webServer/fastCgi /+"[fullPath='d:\strawberry\perl\bin\perl.exe',arguments='d:\www\WebApp\script\webapp_fastcgi.pl -e',maxInstances='4',idleTimeout='300',activityTimeout='30',requestTimeout='90',instanceMaxRequests='1000',protocol='NamedPipe',flushNamedPipe='False']" /commit:apphost - -=item Configuring proper handler (it is a site related setting) - - appcmd.exe set config "CatalystSite" -section:system.webServer/handlers /+"[name='CatalystFastCGI',path='*',verb='GET,HEAD,POST',modules='FastCgiModule',scriptProcessor='d:\strawberry\perl\bin\perl.exe|d:\www\WebApp\script\webapp_fastcgi.pl -e',resourceType='Unspecified',requireAccess='Script']" /commit:apphost - -Note: before launching the commands above do not forget to change site -name and paths to values relevant for your server setup. - -=back - -=back - -=head1 SEE ALSO - -L, L. - -=head1 AUTHORS - -Catalyst Contributors, see Catalyst.pm - -=head1 THANKS - -Bill Moseley, for documentation updates and testing. - -=head1 COPYRIGHT - -This library is free software. You can redistribute it and/or modify it under -the same terms as Perl itself. - -=cut diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm deleted file mode 100644 index 1ba4cf2..0000000 --- a/lib/Catalyst/Engine/HTTP.pm +++ /dev/null @@ -1,579 +0,0 @@ -package Catalyst::Engine::HTTP; - -use Moose; -extends 'Catalyst::Engine::CGI'; - -use Data::Dump qw(dump); -use Errno 'EWOULDBLOCK'; -use HTTP::Date (); -use HTTP::Headers; -use HTTP::Status; -use Socket; -use IO::Socket::INET (); -use IO::Select (); - -use constant CHUNKSIZE => 64 * 1024; -use constant DEBUG => $ENV{CATALYST_HTTP_DEBUG} || 0; - -use namespace::clean -except => 'meta'; - -has options => ( is => 'rw' ); -has _keepalive => ( is => 'rw', predicate => '_is_keepalive', clearer => '_clear_keepalive' ); -has _write_error => ( is => 'rw', predicate => '_has_write_error' ); - -# Refactoring note - could/should Eliminate all instances of $self->{inputbuf}, -# which I haven't touched as it is used as an lvalue in a lot of places, and I guess -# doing it differently could be expensive.. Feel free to refactor and NYTProf :) - -=head1 NAME - -Catalyst::Engine::HTTP - Catalyst HTTP Engine - -=head1 SYNOPSIS - -A script using the Catalyst::Engine::HTTP module might look like: - - #!/usr/bin/perl -w - - BEGIN { $ENV{CATALYST_ENGINE} = 'HTTP' } - - use strict; - use lib '/path/to/MyApp/lib'; - use MyApp; - - MyApp->run; - -=head1 DESCRIPTION - -This is the Catalyst engine specialized for development and testing. - -=head1 METHODS - -=head2 $self->finalize_headers($c) - -=cut - -sub finalize_headers { - my ( $self, $c ) = @_; - my $protocol = $c->request->protocol; - my $status = $c->response->status; - my $message = status_message($status); - my $res_headers = $c->response->headers; - - my @headers; - push @headers, "$protocol $status $message"; - - $res_headers->header( Date => HTTP::Date::time2str(time) ); - $res_headers->header( Status => $status ); - - # Should we keep the connection open? - my $connection = $c->request->header('Connection'); - if ( $self->options - && $self->options->{keepalive} - && $connection - && $connection =~ /^keep-alive$/i - ) { - $res_headers->header( Connection => 'keep-alive' ); - $self->_keepalive(1); - } - else { - $res_headers->header( Connection => 'close' ); - } - - push @headers, $res_headers->as_string("\x0D\x0A"); - - # Buffer the headers so they are sent with the first write() call - # This reduces the number of TCP packets we are sending - $self->_header_buf( join("\x0D\x0A", @headers, '') ); -} - -=head2 $self->finalize_read($c) - -=cut - -before finalize_read => sub { - # Never ever remove this, it would result in random length output - # streams if STDIN eq STDOUT (like in the HTTP engine) - *STDIN->blocking(1); -}; - -=head2 $self->prepare_read($c) - -=cut - -before prepare_read => sub { - # Set the input handle to non-blocking - *STDIN->blocking(0); -}; - -=head2 $self->read_chunk($c, $buffer, $length) - -=cut - -sub read_chunk { - my $self = shift; - my $c = shift; - - # If we have any remaining data in the input buffer, send it back first - if ( $_[0] = delete $self->{inputbuf} ) { - my $read = length( $_[0] ); - DEBUG && warn "read_chunk: Read $read bytes from previous input buffer\n"; - return $read; - } - - # support for non-blocking IO - my $rin = ''; - vec( $rin, *STDIN->fileno, 1 ) = 1; - - READ: - { - select( $rin, undef, undef, undef ); - my $rc = *STDIN->sysread(@_); - if ( defined $rc ) { - DEBUG && warn "read_chunk: Read $rc bytes from socket\n"; - return $rc; - } - else { - next READ if $! == EWOULDBLOCK; - return; - } - } -} - -=head2 $self->write($c, $buffer) - -Writes the buffer to the client. - -=cut - -around write => sub { - my $orig = shift; - my ( $self, $c, $buffer ) = @_; - - # Avoid 'print() on closed filehandle Remote' warnings when using IE - return unless *STDOUT->opened(); - - # Prepend the headers if they have not yet been sent - if ( $self->_has_header_buf ) { - $self->_warn_on_write_error( - $self->$orig($c, $self->_clear_header_buf) - ); - } - - $self->_warn_on_write_error($self->$orig($c, $buffer)); -}; - -sub _warn_on_write_error { - my ($self, $ret) = @_; - if ( !defined $ret ) { - $self->_write_error($!); - DEBUG && warn "write: Failed to write response ($!)\n"; - } - else { - DEBUG && warn "write: Wrote response ($ret bytes)\n"; - } - return $ret; -} - -=head2 run - -=cut - -# A very very simple HTTP server that initializes a CGI environment -sub run { - my ( $self, $class, $port, $host, $options ) = @_; - - $options ||= {}; - - $self->options($options); - - if ($options->{background}) { - my $child = fork; - die "Can't fork: $!" unless defined($child); - return $child if $child; - } - - my $restart = 0; - local $SIG{CHLD} = 'IGNORE'; - - my $allowed = $options->{allowed} || { '127.0.0.1' => '255.255.255.255' }; - my $addr = $host ? inet_aton($host) : INADDR_ANY; - if ( $addr eq INADDR_ANY ) { - require Sys::Hostname; - $host = lc Sys::Hostname::hostname(); - } - else { - $host = gethostbyaddr( $addr, AF_INET ) || inet_ntoa($addr); - } - - # Handle requests - - # Setup socket - my $daemon = IO::Socket::INET->new( - Listen => SOMAXCONN, - LocalAddr => inet_ntoa($addr), - LocalPort => $port, - Proto => 'tcp', - ReuseAddr => 1, - Type => SOCK_STREAM, - ) - or die "Couldn't create daemon: $@"; - - $port = $daemon->sockport(); - - my $url = "http://$host"; - $url .= ":$port" unless $port == 80; - - print "You can connect to your server at $url\n"; - - if ($options->{background}) { - open STDIN, "+&STDIN" or die $!; - open STDERR, ">&STDIN" or die $!; - if ( $^O !~ /MSWin32/ ) { - require POSIX; - POSIX::setsid() - or die "Can't start a new session: $!"; - } - } - - if (my $pidfile = $options->{pidfile}) { - if (! open PIDFILE, "> $pidfile") { - warn("Cannot open: $pidfile: $!"); - } - print PIDFILE "$$\n"; - close PIDFILE; - } - - my $pid = undef; - - # Ignore broken pipes as an HTTP server should - local $SIG{PIPE} = 'IGNORE'; - - # Restart on HUP - local $SIG{HUP} = sub { - $restart = 1; - warn "Restarting server on SIGHUP...\n"; - }; - - LISTEN: - while ( !$restart ) { - while ( accept( Remote, $daemon ) ) { - DEBUG && warn "New connection\n"; - - select Remote; - - Remote->blocking(1); - - # Read until we see all headers - $self->{inputbuf} = ''; - - if ( !$self->_read_headers ) { - # Error reading, give up - close Remote; - next LISTEN; - } - - my ( $method, $uri, $protocol ) = $self->_parse_request_line; - - DEBUG && warn "Parsed request: $method $uri $protocol\n"; - next unless $method; - - unless ( uc($method) eq 'RESTART' ) { - - # Fork - if ( $options->{fork} ) { - if ( $pid = fork ) { - DEBUG && warn "Forked child $pid\n"; - next; - } - } - - $self->_handler( $class, $port, $method, $uri, $protocol ); - - if ( $self->_has_write_error ) { - close Remote; - - if ( !defined $pid ) { - next LISTEN; - } - } - - if ( defined $pid ) { - # Child process, close connection and exit - DEBUG && warn "Child process exiting\n"; - $daemon->close; - exit; - } - } - else { - my $sockdata = $self->_socket_data( \*Remote ); - my $ipaddr = _inet_addr( $sockdata->{peeraddr} ); - my $ready = 0; - foreach my $ip ( keys %$allowed ) { - my $mask = $allowed->{$ip}; - $ready = ( $ipaddr & _inet_addr($mask) ) == _inet_addr($ip); - last if $ready; - } - if ($ready) { - $restart = 1; - last; - } - } - } - continue { - close Remote; - } - } - - $daemon->close; - - DEBUG && warn "Shutting down\n"; - - if ($restart) { - $SIG{CHLD} = 'DEFAULT'; - wait; - - ### if the standalone server was invoked with perl -I .. we will loose - ### those include dirs upon re-exec. So add them to PERL5LIB, so they - ### are available again for the exec'ed process --kane - use Config; - $ENV{PERL5LIB} .= join $Config{path_sep}, @INC; - - exec $^X, $0, @{ $options->{argv} || [] }; - } - - exit; -} - -sub _handler { - my ( $self, $class, $port, $method, $uri, $protocol ) = @_; - - local *STDIN = \*Remote; - local *STDOUT = \*Remote; - - # We better be careful and just use 1.0 - $protocol = '1.0'; - - my $sockdata = $self->_socket_data( \*Remote ); - my %copy_of_env = %ENV; - - my $sel = IO::Select->new; - $sel->add( \*STDIN ); - - REQUEST: - while (1) { - my ( $path, $query_string ) = split /\?/, $uri, 2; - - # URI is not the same as path. Remove scheme, domain name and port from it - $path =~ s{^https?://[^/?#]+}{}; - - # Initialize CGI environment - local %ENV = ( - PATH_INFO => $path || '', - QUERY_STRING => $query_string || '', - REMOTE_ADDR => $sockdata->{peeraddr}, - REQUEST_METHOD => $method || '', - SERVER_NAME => $sockdata->{localname}, - SERVER_PORT => $port, - SERVER_PROTOCOL => "HTTP/$protocol", - %copy_of_env, - ); - - # Parse headers - if ( $protocol >= 1 ) { - $self->_parse_headers; - } - - # Pass flow control to Catalyst - { - # FIXME: don't ignore SIGCHLD while handling requests so system() - # et al. work within actions. it might be a little risky to do that - # this far out, but then again it's only the dev server anyway. - local $SIG{CHLD} = 'DEFAULT'; - - $class->handle_request( env => \%ENV ); - } - - DEBUG && warn "Request done\n"; - - # Allow keepalive requests, this is a hack but we'll support it until - # the next major release. - if ( $self->_is_keepalive ) { - $self->_clear_keepalive; - - DEBUG && warn "Reusing previous connection for keep-alive request\n"; - - if ( $sel->can_read(1) ) { - if ( !$self->_read_headers ) { - # Error reading, give up - last REQUEST; - } - - ( $method, $uri, $protocol ) = $self->_parse_request_line; - - DEBUG && warn "Parsed request: $method $uri $protocol\n"; - - # Force HTTP/1.0 - $protocol = '1.0'; - - next REQUEST; - } - - DEBUG && warn "No keep-alive request within 1 second\n"; - } - - last REQUEST; - } - - DEBUG && warn "Closing connection\n"; - - close Remote; -} - -sub _read_headers { - my $self = shift; - - while (1) { - my $read = sysread Remote, my $buf, CHUNKSIZE; - - if ( !defined $read ) { - next if $! == EWOULDBLOCK; - DEBUG && warn "Error reading headers: $!\n"; - return; - } elsif ( $read == 0 ) { - DEBUG && warn "EOF\n"; - return; - } - - DEBUG && warn "Read $read bytes\n"; - $self->{inputbuf} .= $buf; - last if $self->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s; - } - - return 1; -} - -sub _parse_request_line { - my $self = shift; - - # Parse request line - # Leading CRLF sometimes sent by buggy IE versions - if ( $self->{inputbuf} !~ s/^(?:\x0D\x0A)?(\w+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012// ) { - return (); - } - - my $method = $1; - my $uri = $2; - my $proto = $3 || 'HTTP/0.9'; - - return ( $method, $uri, $proto ); -} - -sub _parse_headers { - my $self = shift; - - # Copy the buffer for header parsing, and remove the header block - # from the content buffer. - my $buf = $self->{inputbuf}; - $self->{inputbuf} =~ s/.*?(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)//s; - - # Parse headers - my $headers = HTTP::Headers->new; - my ($key, $val); - HEADER: - while ( $buf =~ s/^([^\012]*)\012// ) { - $_ = $1; - s/\015$//; - if ( /^([\w\-~]+)\s*:\s*(.*)/ ) { - $headers->push_header( $key, $val ) if $key; - ($key, $val) = ($1, $2); - } - elsif ( /^\s+(.*)/ ) { - $val .= " $1"; - } - else { - last HEADER; - } - } - $headers->push_header( $key, $val ) if $key; - - DEBUG && warn "Parsed headers: " . dump($headers) . "\n"; - - # Convert headers into ENV vars - $headers->scan( sub { - my ( $key, $val ) = @_; - - $key = uc $key; - $key = 'COOKIE' if $key eq 'COOKIES'; - $key =~ tr/-/_/; - $key = 'HTTP_' . $key - unless $key =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/; - - if ( exists $ENV{$key} ) { - $ENV{$key} .= ", $val"; - } - else { - $ENV{$key} = $val; - } - } ); -} - -sub _socket_data { - my ( $self, $handle ) = @_; - - my $remote_sockaddr = getpeername($handle); - my ( undef, $iaddr ) = $remote_sockaddr - ? sockaddr_in($remote_sockaddr) - : (undef, undef); - - my $local_sockaddr = getsockname($handle); - my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr); - - # This mess is necessary to keep IE from crashing the server - my $data = { - peeraddr => $iaddr - ? ( inet_ntoa($iaddr) || '127.0.0.1' ) - : '127.0.0.1', - localname => _gethostbyaddr( $localiaddr ), - localaddr => inet_ntoa($localiaddr) || '127.0.0.1', - }; - - return $data; -} - -{ # If you have a crappy DNS server then these can be slow, so cache 'em - my %hostname_cache; - sub _gethostbyaddr { - my $ip = shift; - $hostname_cache{$ip} ||= gethostbyaddr( $ip, AF_INET ) || $ip; - } -} - -sub _inet_addr { unpack "N*", inet_aton( $_[0] ) } - -=head2 options - -Options hash passed to the http engine to control things like if keepalive -is supported. - -=head1 SEE ALSO - -L, L - -=head1 AUTHORS - -Catalyst Contributors, see Catalyst.pm - -=head1 THANKS - -Many parts are ripped out of C by Jesse Vincent. - -=head1 COPYRIGHT - -This library is free software. You can redistribute it and/or modify it under -the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Catalyst/EngineLoader.pm b/lib/Catalyst/EngineLoader.pm new file mode 100644 index 0000000..36cf016 --- /dev/null +++ b/lib/Catalyst/EngineLoader.pm @@ -0,0 +1,159 @@ +package Catalyst::EngineLoader; +use Moose; +use Catalyst::Exception; +use Catalyst::Utils; +use namespace::autoclean; + +extends 'Plack::Loader'; + +has application_name => ( + isa => 'Str', + is => 'ro', + required => 1, +); + +has requested_engine => ( + is => 'ro', + isa => 'Str', + predicate => 'has_requested_engine', +); + +sub needs_psgi_engine_compat_hack { + my ($self) = @_; + return $self->has_requested_engine + && $self->requested_engine eq 'PSGI'; +} + +has catalyst_engine_class => ( + isa => 'Str', + is => 'rw', + lazy => 1, + builder => '_guess_catalyst_engine_class', +); + +sub _guess_catalyst_engine_class { + my $self = shift; + my $old_engine = $self->has_requested_engine + ? $self->requested_engine + : Catalyst::Utils::env_value($self->application_name, 'ENGINE'); + if (!defined $old_engine) { + return 'Catalyst::Engine'; + } + elsif ($old_engine eq 'PSGI') { + ## If we are running under plackup let the Catalyst::Engine::PSGI + ## continue to run, but warn. + warn <<"EOW"; +You are running Catalyst::Engine::PSGI, which is considered a legacy engine for +this version of Catalyst. We will continue running and use your existing psgi +file, but it is recommended to perform the trivial upgrade process, which will +leave you with less code and a forward path. + +Please review Catalyst::Upgrading +EOW + return 'Catalyst::Engine::' . $old_engine; + } + elsif ($old_engine =~ /^(CGI|FastCGI|HTTP|Apache.*)$/) { + return 'Catalyst::Engine'; + } + else { + return 'Catalyst::Engine::' . $old_engine; + } +} + +around guess => sub { + my ($orig, $self) = (shift, shift); + my $engine = $self->$orig(@_); + if ($engine eq 'Standalone') { + if ( $ENV{MOD_PERL} ) { + my ( $software, $version ) = + $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; + $version =~ s/_//g; + $version =~ s/(\.[^.]+)\./$1/g; + + if ( $software eq 'mod_perl' ) { + if ( $version >= 1.99922 ) { + $engine = 'Apache2'; + } + + elsif ( $version >= 1.9901 ) { + Catalyst::Exception->throw( message => 'Plack does not have a mod_perl 1.99 handler' ); + $engine = 'Apache2::MP19'; + } + + elsif ( $version >= 1.24 ) { + $engine = 'Apache1'; + } + + else { + Catalyst::Exception->throw( message => + qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); + } + } + } + } + + my $old_engine = Catalyst::Utils::env_value($self->application_name, 'ENGINE'); + if (!defined $old_engine) { # Not overridden + } + elsif ($old_engine =~ /^(PSGI|CGI|Apache.*)$/) { + # Trust autodetect + } + elsif ($old_engine eq 'HTTP') { + $engine = 'Standalone'; + } + elsif ($old_engine eq 'FastCGI') { + $engine = 'FCGI'; + } + elsif ($old_engine eq "HTTP::Prefork") { # Too bad if you're customising, we don't handle options + # write yourself a script to collect and pass in the options + $engine = "Starman"; + } + elsif ($old_engine eq "HTTP::POE") { + Catalyst::Exception->throw("HTTP::POE engine no longer works, recommend you use Twiggy instead"); + } + elsif ($old_engine eq "Zeus") { + Catalyst::Exception->throw("Zeus engine no longer works"); + } + else { + warn("You asked for an unrecognised engine '$old_engine' which is no longer supported, this has been ignored.\n"); + } + + return $engine; +}; + +# Force constructor inlining +__PACKAGE__->meta->make_immutable( replace_constructor => 1 ); + +1; + +__END__ + +=head1 NAME + +Catalyst::EngineLoader - The Catalyst Engine Loader + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +Wrapper on L which resets the ::Engine if you are using some +version of mod_perl. + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=begin Pod::Coverage + +needs_psgi_engine_compat_hack + +=end Pod::Coverage + +=cut diff --git a/lib/Catalyst/PSGI.pod b/lib/Catalyst/PSGI.pod new file mode 100644 index 0000000..1aec1f8 --- /dev/null +++ b/lib/Catalyst/PSGI.pod @@ -0,0 +1,94 @@ +=pod + +=head1 NAME + +Catalyst::PSGI - How Catalyst and PSGI work together + +=head1 SYNOPSIS + +Catalyst used to contain a whole set of C<< Catalyst::Engine::XXXX >> classes to +adapt to various different web servers, and environments (e.g. CGI, FastCGI, mod_perl) +etc. + +This has been changed so that all of that work is done by Catalyst just implementing +the L specification, and using L's adaptors to implement that functionality. + +This means that we can share common code, and fixes for specific web servers. + +=head1 I already have an application + +If you already have a Catalyst application, then this means very little, and you should be +able to upgrade to the latest release with little or no trouble (See notes in L +for specifics about your web server deployment). + +=head1 Writing your own PSGI file. + +=head2 What is a .psgi file + +A C<< .psgi >> file lets you manually controll how your application code reference is built. + +Catalyst normally takes care of this for you, but it's possible to do it manually by +creating a C file in the root of your application. + +The simplest C<.psgi> file for an application called C would be: + + use strict; + use warnings; + use TestApp; + + my $app = sub { TestApp->psgi_app(@_) }; + +It should be noted that Catalyst may apply a number of middleware components for +you automatically, and these B be applied if you manually create +a psgi file yourself. Details of these middlewares can be found below. + +Additional information about psgi files can be found at: +L + +=head2 Why would I want to make a .psgi file? + +Writing your own .psgi file allows you to use the alternate L command +to start your application, and allows you to add classes and extensions +that implement L, such as L, +or L. + +=head2 What is in the .psgi Catalyst generates by default? + +Catalyst generates an application which, if the C<< using_frontend_proxy >> +setting is on, is wrapped in L, and contains some +engine specific fixes for uniform behaviour, as contained in: + +=over + +=item L + +=item L + +=item nginx - local to Catalyst + +=back + +If you override the default by providing your own C<< .psgi >> file, then +none of these things will be done automatically for you by the PSGI +application returned when you call C<< MyApp->psgi_app >>, and if you need +any of this functionality, you'll need to implement this in your C<< .psgi >> +file yourself. + +An apply_default_middlewares method is supplied to wrap your application +in the default middlewares if you want this behaviour and you are providing +your own .psgi file. + +=head1 SEE ALSO + +L, L, L, L. + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/ROADMAP.pod b/lib/Catalyst/ROADMAP.pod index 9c29d1d..acb5775 100644 --- a/lib/Catalyst/ROADMAP.pod +++ b/lib/Catalyst/ROADMAP.pod @@ -8,7 +8,7 @@ in the the catalyst trunk, currently at Make sure you get it from there to ensure you have the latest version. -=head2 5.81000 +=head2 5.91000 =over @@ -22,24 +22,9 @@ Dispatcher refactoring to provide alternatives to deprecated methods, and support for pluggable dispatcher builders (so that attributes can be replaced). -=item MyApp should not ISA Catalyst::Controller - -=over - -=item * - -Update Test suite to not assume MyApp ISA Controller - -=item * - -After that set up attr handlers that will output helpful error messages when -you do it as well as how to fix it. - =back -=back - -=head2 5.82000 +=head2 5.92000 =over @@ -51,7 +36,7 @@ total engine independence =back -=head2 5.90000 +=head2 6.00000 =over @@ -70,7 +55,4 @@ separate thing from the Application class. =item update pod coverage tests to detect stubbed pod, ensure real coverage -=item Add support for configuration profiles to be selected at startup time -through switches / ENV - =back diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index 1427bcb..019290c 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -5,7 +5,7 @@ with 'MooseX::Emulate::Class::Accessor::Fast'; use Catalyst::Exception; use File::Copy (); -use IO::File qw( SEEK_SET ); +use IO::File (); use File::Spec::Unix; use namespace::clean -except => 'meta'; @@ -147,12 +147,12 @@ sub slurp { binmode( $handle, $layer ); - $handle->seek(0, SEEK_SET); + $handle->seek(0, IO::File::SEEK_SET); while ( $handle->sysread( my $buffer, 8192 ) ) { $content .= $buffer; } - $handle->seek(0, SEEK_SET); + $handle->seek(0, IO::File::SEEK_SET); return $content; } diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm index fc8c555..7b87131 100644 --- a/lib/Catalyst/Runtime.pm +++ b/lib/Catalyst/Runtime.pm @@ -7,7 +7,7 @@ BEGIN { require 5.008004; } # Remember to update this in Catalyst as well! -our $VERSION = '5.80033'; +our $VERSION = '5.89003'; =head1 NAME diff --git a/lib/Catalyst/Script/CGI.pm b/lib/Catalyst/Script/CGI.pm index 60392f5..dc7f20f 100644 --- a/lib/Catalyst/Script/CGI.pm +++ b/lib/Catalyst/Script/CGI.pm @@ -1,8 +1,9 @@ package Catalyst::Script::CGI; use Moose; -BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' } use namespace::autoclean; +sub _plack_engine_name { 'CGI' } + with 'Catalyst::ScriptRole'; __PACKAGE__->meta->make_immutable; diff --git a/lib/Catalyst/Script/FastCGI.pm b/lib/Catalyst/Script/FastCGI.pm index bad4af6..781c327 100644 --- a/lib/Catalyst/Script/FastCGI.pm +++ b/lib/Catalyst/Script/FastCGI.pm @@ -1,10 +1,11 @@ package Catalyst::Script::FastCGI; - -BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' } use Moose; use MooseX::Types::Moose qw/Str Bool Int/; +use Data::OptList; use namespace::autoclean; +sub _plack_engine_name { 'FCGI' } + with 'Catalyst::ScriptRole'; has listen => ( @@ -59,20 +60,62 @@ has proc_title => ( traits => [qw(Getopt)], isa => Str, is => 'ro', + lazy => 1, + builder => '_build_proc_title', documentation => 'Set the process title', ); +sub _build_proc_title { + my ($self) = @_; + return sprintf 'perl-fcgi-pm [%s]', $self->application_name; +} + +sub BUILD { + my ($self) = @_; + $self->proc_title; +} + +# Munge the 'listen' arg so that Plack::Handler::FCGI will accept it. +sub _listen { + my ($self) = @_; + + if (defined (my $listen = $self->listen)) { + return [ $listen ]; + } else { + return undef; + } +} + +sub _plack_loader_args { + my ($self) = shift; + + my $opts = Data::OptList::mkopt([ + qw/manager nproc proc_title/, + pid => [ 'pidfile' ], + daemonize => [ 'daemon' ], + keep_stderr => [ 'keeperr' ], + listen => [ '_listen' ], + ]); + + my %args = map { $_->[0] => $self->${ \($_->[1] ? $_->[1]->[0] : $_->[0]) } } @$opts; + + # Plack::Handler::FCGI thinks manager => undef means "use no manager". + delete $args{'manager'} unless defined $args{'manager'}; + + return %args; +} + sub _application_args { my ($self) = shift; return ( $self->listen, { - nproc => $self->nproc, - pidfile => $self->pidfile, - manager => $self->manager, - detach => $self->daemon, + nproc => $self->nproc, + pidfile => $self->pidfile, + manager => $self->manager, + detach => $self->daemon, keep_stderr => $self->keeperr, - proc_title => $self->proc_title, + proc_title => $self->proc_title, } ); } diff --git a/lib/Catalyst/Script/Server.pm b/lib/Catalyst/Script/Server.pm index e692859..328773c 100644 --- a/lib/Catalyst/Script/Server.pm +++ b/lib/Catalyst/Script/Server.pm @@ -1,14 +1,9 @@ package Catalyst::Script::Server; - -BEGIN { - $ENV{CATALYST_ENGINE} ||= 'HTTP'; - require Catalyst::Engine::HTTP; -} - use Moose; use MooseX::Types::Common::Numeric qw/PositiveInt/; use MooseX::Types::Moose qw/ArrayRef Str Bool Int RegexpRef/; use Catalyst::Utils; +use Try::Tiny; use namespace::autoclean; with 'Catalyst::ScriptRole'; @@ -50,14 +45,46 @@ has port => ( documentation => 'Specify a different listening port (to the default port 3000)', ); +use Moose::Util::TypeConstraints; +class_type 'MooseX::Daemonize::Pid::File'; +subtype 'Catalyst::Script::Server::Types::Pidfile', + as 'MooseX::Daemonize::Pid::File', + where { 1 }; +coerce 'Catalyst::Script::Server::Types::Pidfile', from Str, via { + try { Class::MOP::load_class("MooseX::Daemonize::Pid::File") } + catch { + warn("Could not load MooseX::Daemonize::Pid::File, needed for --pid option\n"); + exit 1; + }; + MooseX::Daemonize::Pid::File->new( file => $_ ); +}; +MooseX::Getopt::OptionTypeMap->add_option_type_to_map( + 'Catalyst::Script::Server::Types::Pidfile' => '=s', +); has pidfile => ( traits => [qw(Getopt)], cmd_aliases => 'pid', - isa => Str, + isa => 'Catalyst::Script::Server::Types::Pidfile', is => 'ro', documentation => 'Specify a pidfile', + coerce => 1, + predicate => '_has_pidfile', ); +sub BUILD { + my $self = shift; + + if ($self->background) { + # FIXME - This is evil. Should we just add MX::Daemonize to the deps? + try { Class::MOP::load_class('MooseX::Daemonize::Core') } + catch { + warn("MooseX::Daemonize is needed for the --background option\n"); + exit 1; + }; + MooseX::Daemonize::Core->meta->apply($self); + } +} + has keepalive => ( traits => [qw(Getopt)], cmd_aliases => 'k', @@ -108,7 +135,7 @@ has restart_delay => ( { use Moose::Util::TypeConstraints; - my $tc = subtype as RegexpRef; + my $tc = subtype 'Catalyst::Script::Server::Types::RegexpRef', as RegexpRef; coerce $tc, from Str, via { qr/$_/ }; MooseX::Getopt::OptionTypeMap->add_option_type_to_map($tc => '=s'); @@ -134,6 +161,11 @@ has follow_symlinks => ( predicate => '_has_follow_symlinks', ); +sub _plack_engine_name { + my $self = shift; + return $self->fork ? 'Starman' : $self->keepalive ? 'Starman' : 'Standalone'; +} + sub _restarter_args { my $self = shift; @@ -169,6 +201,8 @@ sub run { if ( $self->restart ) { die "Cannot run in the background and also watch for changed files.\n" if $self->background; + die "Cannot write out a pid file and fork for the restarter.\n" + if $self->_has_pidfile; # If we load this here, then in the case of a restarter, it does not # need to be reloaded for each restart. @@ -189,12 +223,43 @@ sub run { $restarter->run_and_watch; } else { + if ($self->background) { + $self->daemon_fork; + + return 1 unless $self->is_daemon; + + Class::MOP::load_class($self->application_name); + + $self->daemon_detach; + } + + $self->pidfile->write + if $self->_has_pidfile; + $self->_run_application; } } +sub _plack_loader_args { + my ($self) = shift; + return ( + port => $self->port, + host => $self->host, + keepalive => $self->keepalive ? 100 : 1, + server_ready => sub { + my ($args) = @_; + + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }, + ); +} + sub _application_args { my ($self) = shift; return ( diff --git a/lib/Catalyst/ScriptRole.pm b/lib/Catalyst/ScriptRole.pm index 7ae3d7d..e5231e7 100644 --- a/lib/Catalyst/ScriptRole.pm +++ b/lib/Catalyst/ScriptRole.pm @@ -3,6 +3,8 @@ use Moose::Role; use MooseX::Types::Moose qw/Str Bool/; use Pod::Usage; use MooseX::Getopt; +use Catalyst::EngineLoader; +use MooseX::Types::LoadableClass qw/LoadableClass/; use namespace::autoclean; with 'MooseX::Getopt' => { @@ -20,6 +22,27 @@ has application_name => ( required => 1, ); +has loader_class => ( + isa => LoadableClass, + is => 'ro', + coerce => 1, + default => 'Catalyst::EngineLoader', + documentation => 'The class to use to detect and load the PSGI engine', +); + +has _loader => ( + isa => 'Plack::Loader', + default => sub { + my $self = shift; + $self->loader_class->new(application_name => $self->application_name); + }, + handles => { + load_engine => 'load', + autoload_engine => 'auto', + }, + lazy => 1, +); + sub _getopt_spec_exception {} sub _getopt_spec_warnings { @@ -42,11 +65,24 @@ sub _application_args { () } +sub _plack_loader_args { + my $self = shift; + my @app_args = $self->_application_args; + return (port => $app_args[0]); +} + sub _run_application { my $self = shift; my $app = $self->application_name; Class::MOP::load_class($app); - $app->run($self->_application_args); + my $server; + if (my $e = $self->can('_plack_engine_name') ) { + $server = $self->load_engine($self->$e, $self->_plack_loader_args); + } + else { + $server = $self->autoload_engine($self->_plack_loader_args); + } + $app->run($self->_application_args, $server); } 1; diff --git a/lib/Catalyst/ScriptRunner.pm b/lib/Catalyst/ScriptRunner.pm index 247ce30..06b36b5 100644 --- a/lib/Catalyst/ScriptRunner.pm +++ b/lib/Catalyst/ScriptRunner.pm @@ -6,7 +6,7 @@ use File::Spec; use namespace::autoclean; sub run { - my ($self, $class, $scriptclass) = @_; + my ($self, $class, $scriptclass, %args) = @_; my $classtoload = "${class}::Script::$scriptclass"; lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib')); @@ -17,7 +17,7 @@ sub run { $classtoload = "Catalyst::Script::$scriptclass"; Class::MOP::load_class($classtoload); } - $classtoload->new_with_options( application_name => $class )->run; + $classtoload->new_with_options( application_name => $class, %args )->run; } __PACKAGE__->meta->make_immutable; diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 7befe99..5c0cbe7 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -4,51 +4,60 @@ use strict; use warnings; use Test::More (); +use Plack::Test; use Catalyst::Exception; use Catalyst::Utils; use Class::MOP; use Sub::Exporter; +use Carp 'croak', 'carp'; -my $build_exports = sub { - my ($self, $meth, $args, $defaults) = @_; +sub _build_request_export { + my ($self, $args) = @_; + + return sub { _remote_request(@_) } + if $args->{remote}; - my $request; my $class = $args->{class}; - if ( $ENV{CATALYST_SERVER} ) { - $request = sub { remote_request(@_) }; - } elsif (! $class) { - $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") }; - } else { - unless (Class::MOP::is_class_loaded($class)) { - Class::MOP::load_class($class); - } - $class->import; - - $request = sub { local_request( $class, @_ ) }; - } + # Here we should be failing right away, but for some stupid backcompat thing + # I don't quite remember we fail lazily here. Needs a proper deprecation and + # then removal. + return sub { croak "Must specify a test app: use Catalyst::Test 'TestApp'" } + unless $class; + + Class::MOP::load_class($class) unless Class::MOP::is_class_loaded($class); + $class->import; + + return sub { _local_request( $class, @_ ) }; +} + +sub _build_get_export { + my ($self, $args) = @_; + my $request = $args->{request}; - my $get = sub { $request->(@_)->content }; + return sub { $request->(@_)->content }; +} +sub _build_ctx_request_export { + my ($self, $args) = @_; + my ($class, $request) = @{ $args }{qw(class request)}; - my $ctx_request = sub { + return sub { my $me = ref $self || $self; - ### throw an exception if ctx_request is being used against a remote - ### server + # fail if ctx_request is being used against a remote server Catalyst::Exception->throw("$me only works with local requests, not remote") if $ENV{CATALYST_SERVER}; - ### check explicitly for the class here, or the Cat->meta call will blow - ### up in our face + # check explicitly for the class here, or the Cat->meta call will blow + # up in our face Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") unless $class; - ### place holder for $c after the request finishes; reset every time - ### requests are done. + # place holder for $c after the request finishes; reset every time + # requests are done. my $ctx_closed_over; - ### hook into 'dispatch' -- the function gets called after all plugins - ### have done their work, and it's an easy place to capture $c. - + # hook into 'dispatch' -- the function gets called after all plugins + # have done their work, and it's an easy place to capture $c. my $meta = Class::MOP::get_metaclass_by_name($class); $meta->make_mutable; $meta->add_after_method_modifier( "dispatch", sub { @@ -56,9 +65,10 @@ my $build_exports = sub { }); $meta->make_immutable( replace_constructor => 1 ); Class::C3::reinitialize(); # Fixes RT#46459, I've failed to write a test for how/why, but it does. - ### do the request; C::T::request will know about the class name, and - ### we've already stopped it from doing remote requests above. - my $res = $request->( @_ ); + + # do the request; C::T::request will know about the class name, and + # we've already stopped it from doing remote requests above. + my $res = $args->{request}->( @_ ); # Make sure not to leave a reference $ctx hanging around. # This means that the context will go out of scope as soon as the @@ -70,9 +80,25 @@ my $build_exports = sub { my $ctx = $ctx_closed_over; undef $ctx_closed_over; - ### return both values return ( $res, $ctx ); }; +} + +my $build_exports = sub { + my ($self, $meth, $args, $defaults) = @_; + my $class = $args->{class}; + + my $request = $self->_build_request_export({ + class => $class, + remote => $ENV{CATALYST_SERVER}, + }); + + my $get = $self->_build_get_export({ request => $request }); + + my $ctx_request = $self->_build_ctx_request_export({ + class => $class, + request => $request, + }); return { request => $request, @@ -229,102 +255,77 @@ header configuration; currently only supports setting 'host' value. my $res = request('foo/bar?test=1'); my $virtual_res = request('foo/bar?test=1', {host => 'virtualhost.com'}); -=head1 FUNCTIONS - =head2 ($res, $c) = ctx_request( ... ); Works exactly like L, except it also returns the Catalyst context object, C<$c>. Note that this only works for local requests. -=head2 $res = Catalyst::Test::local_request( $AppClass, $url ); - -Simulate a request using L. - =cut -sub local_request { - my $class = shift; - - require HTTP::Request::AsCGI; +sub _request { + my $args = shift; - my $request = Catalyst::Utils::request( shift(@_) ); - _customize_request($request, @_); - my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup; + my $request = Catalyst::Utils::request(shift); - $class->handle_request( env => \%ENV ); + my %extra_env; + _customize_request($request, \%extra_env, @_); + $args->{mangle_request}->($request) if $args->{mangle_request}; - my $response = $cgi->restore->response; - $response->request( $request ); + my $ret; + test_psgi + %{ $args }, + app => sub { $args->{app}->({ %{ $_[0] }, %extra_env }) }, + client => sub { + my ($psgi_app) = @_; + my $resp = $psgi_app->($request); + $args->{mangle_response}->($resp) if $args->{mangle_response}; + $ret = $resp; + }; - # HTML head parsing based on LWP::UserAgent - - require HTML::HeadParser; - - my $parser = HTML::HeadParser->new(); - $parser->xml_mode(1) if $response->content_is_xhtml; - $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; - - $parser->parse( $response->content ); - my $h = $parser->header; - for my $f ( $h->header_field_names ) { - $response->init_header( $f, [ $h->header($f) ] ); - } - - return $response; + return $ret; } -my $agent; - -=head2 $res = Catalyst::Test::remote_request( $url ); - -Do an actual remote request using LWP. - -=cut - -sub remote_request { +sub _local_request { + my $class = shift; - require LWP::UserAgent; + return _request({ + app => ref($class) eq "CODE" ? $class : $class->_finalized_psgi_app, + mangle_response => sub { + my ($resp) = @_; - my $request = Catalyst::Utils::request( shift(@_) ); - my $server = URI->new( $ENV{CATALYST_SERVER} ); + # HTML head parsing based on LWP::UserAgent + # + # This is not just horrible and possibly broken, but also really + # doesn't belong here. Whoever wants this should be working on + # getting it into Plack::Test, or make a middleware out of it, or + # whatever. Seriously - horrible. - _customize_request($request, @_); + require HTML::HeadParser; - if ( $server->path =~ m|^(.+)?/$| ) { - my $path = $1; - $server->path("$path") if $path; # need to be quoted - } + my $parser = HTML::HeadParser->new(); + $parser->xml_mode(1) if $resp->content_is_xhtml; + $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; - # the request path needs to be sanitised if $server is using a - # non-root path due to potential overlap between request path and - # response path. - if ($server->path) { - # If request path is '/', we have to add a trailing slash to the - # final request URI - my $add_trailing = $request->uri->path eq '/'; - - my @sp = split '/', $server->path; - my @rp = split '/', $request->uri->path; - shift @sp;shift @rp; # leading / - if (@rp) { - foreach my $sp (@sp) { - $sp eq $rp[0] ? shift @rp : last + $parser->parse( $resp->content ); + my $h = $parser->header; + for my $f ( $h->header_field_names ) { + $resp->init_header( $f, [ $h->header($f) ] ); } - } - $request->uri->path(join '/', @rp); + # Another horrible hack to make the response headers have a + # 'status' field. This is for back-compat, but you should + # call $resp->code instead! + $resp->init_header('status', [ $resp->code ]); + }, + }, @_); +} - if ( $add_trailing ) { - $request->uri->path( $request->uri->path . '/' ); - } - } +my $agent; - $request->uri->scheme( $server->scheme ); - $request->uri->host( $server->host ); - $request->uri->port( $server->port ); - $request->uri->path( $server->path . $request->uri->path ); +sub _remote_request { + require LWP::UserAgent; + local $Plack::Test::Impl = 'ExternalServer'; unless ($agent) { - $agent = LWP::UserAgent->new( keep_alive => 1, max_redirect => 0, @@ -338,16 +339,72 @@ sub remote_request { $agent->env_proxy; } - return $agent->request($request); + + my $server = URI->new($ENV{CATALYST_SERVER}); + if ( $server->path =~ m|^(.+)?/$| ) { + my $path = $1; + $server->path("$path") if $path; # need to be quoted + } + + return _request({ + ua => $agent, + uri => $server, + mangle_request => sub { + my ($request) = @_; + + # the request path needs to be sanitised if $server is using a + # non-root path due to potential overlap between request path and + # response path. + if ($server->path) { + # If request path is '/', we have to add a trailing slash to the + # final request URI + my $add_trailing = ($request->uri->path eq '/' || $request->uri->path eq '') ? 1 : 0; + + my @sp = split '/', $server->path; + my @rp = split '/', $request->uri->path; + shift @sp; shift @rp; # leading / + if (@rp) { + foreach my $sp (@sp) { + $sp eq $rp[0] ? shift @rp : last + } + } + $request->uri->path(join '/', @rp); + + if ( $add_trailing ) { + $request->uri->path( $request->uri->path . '/' ); + } + } + }, + }, @_); +} + +for my $name (qw(local_request remote_request)) { + my $fun = sub { + carp <<"EOW"; +Calling Catalyst::Test::${name}() directly is deprecated. + +Please import Catalyst::Test into your namespace and use the provided request() +function instead. +EOW + return __PACKAGE__->can("_${name}")->(@_); + }; + + no strict 'refs'; + *$name = $fun; } sub _customize_request { my $request = shift; + my $extra_env = shift; my $opts = pop(@_) || {}; $opts = {} unless ref($opts) eq 'HASH'; if ( my $host = exists $opts->{host} ? $opts->{host} : $default_host ) { $request->header( 'Host' => $host ); } + + if (my $extra = $opts->{extra_env}) { + @{ $extra_env }{keys %{ $extra }} = values %{ $extra }; + } } =head2 action_ok($url [, $test_name ]) @@ -388,6 +445,14 @@ Catalyst Contributors, see Catalyst.pm This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. +=begin Pod::Coverage + +local_request + +remote_request + +=end Pod::Coverage + =cut 1; diff --git a/lib/Catalyst/Upgrading.pod b/lib/Catalyst/Upgrading.pod index 58f827f..f15995e 100644 --- a/lib/Catalyst/Upgrading.pod +++ b/lib/Catalyst/Upgrading.pod @@ -2,6 +2,208 @@ Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst +=head1 Upgrading to Catalyst 5.9 + +The major change is that L now replaces most of the subclasses of +L. If you are using one of the standard subclasses of +L this should be a straightforward upgrade for you. It was +a design goal for this release to be as backwardly compatible as possible. +However since L is different from L it is possible +that edge case differences exist. Therefore we recommend care be taken with +this upgrade and that testing should be greater than would be the case with a +minor point update. + +It is highly recommended that you become familiar with the L ecosystem +and documentation. Being able to take advantage of L development and +middleware is a major bonus to this upgrade. Documentation about how to +take advantage of L by writing your own C<< .psgi >> file +is contained in L. + +If you have created a custom subclass of L you will need to +convert it to be a subclass of L. + +If you are using the L engine, L, this new +release supersedes that code. + +If you are using a subclass of L that is aimed at nonstandard +or internal / testing uses, such as L you should +still be able to continue using that engine. + +Advice for specific subclasses of L follows: + +=head2 Upgrading the FastCGI Engine + +No upgrade needed if your myapp_fastcgi.pl script is already upgraded +enough to use L. + +=head2 Upgrading the mod_perl / Apache Engines + +The engines that are build upon the various iterations of mod_perl, +L and +L should be seamless upgrades and will +work using using L or L +as required. + +L, is however no longer supported, as Plack +does not support mod_perl version 1.99 + +=head2 Upgrading the HTTP Engine + +The default development server that comes with the L distribution +should continue to work as expected with no changes as long as your C +script is upgraded to use L. + +=head2 Upgrading the CGI Engine + +If you were using L there is no upgrade needed if your +myapp_cgi.pl script is already upgraded enough to use L. + +=head2 Upgrading the Preforking Engine + +If you were using L then L +is automatically loaded. You should (at least) change your C +to depend on Starman. + +You can regenerate your C script with C +and implement a C class that looks like this: + + package MyApp::Script::Server; + use Moose; + use namespace::autoclean; + + extends 'CatalystX::Script::Server::Starman'; + + 1; + +This takes advantage of the new script system, and adds a number of options to +the standard server script as extra options are added by Starman. + +More information about these options can be seen at +L. + +An alternate route to implement this functionality is to write a simple .psgi +file for your application, then use the L utility to start the +server. + +=head2 Upgrading the PSGI Engine + +If you were using L this new release supersedes this +engine in supporting L. By default the Engine is now always L. +As a result, you can stop depending on L in your +C. + +Applications that were using L +previously should entirely continue to work in this release with no changes. + +However, if you have an C script, then you no longer +need to specify the PSGI engine. Instead, the L application class +now has a new method C which returns a L compatible coderef +which you can wrap in middleware of your choice. + +Catalyst will use the .psgi for your application if it is located in the C +directory of the application + +For example, if you were using L in the past, you will +have written (or generated) a C