1package Plack::Handler::Apache2; 2use strict; 3use warnings; 4use Apache2::RequestRec; 5use Apache2::RequestIO; 6use Apache2::RequestUtil; 7use Apache2::Response; 8use Apache2::Const -compile => qw(OK); 9use Apache2::Log; 10use APR::Table; 11use IO::Handle; 12use Plack::Util; 13use Scalar::Util; 14use URI; 15use URI::Escape; 16 17my %apps; # psgi file to $app mapping 18 19sub new { bless {}, shift } 20 21sub preload { 22 my $class = shift; 23 for my $app (@_) { 24 $class->load_app($app); 25 } 26} 27 28sub load_app { 29 my($class, $app) = @_; 30 return $apps{$app} ||= do { 31 # Trick Catalyst, CGI.pm, CGI::Cookie and others that check 32 # for $ENV{MOD_PERL}. 33 # 34 # Note that we delete it instead of just localizing 35 # $ENV{MOD_PERL} because some users may check if the key 36 # exists, and we do it this way because "delete local" is new 37 # in 5.12: 38 # http://perldoc.perl.org/5.12.0/perldelta.html#delete-local 39 local $ENV{MOD_PERL}; 40 delete $ENV{MOD_PERL}; 41 42 Plack::Util::load_psgi $app; 43 }; 44} 45 46sub call_app { 47 my ($class, $r, $app) = @_; 48 49 $r->subprocess_env; # let Apache create %ENV for us :) 50 51 my $env = { 52 %ENV, 53 'psgi.version' => [ 1, 1 ], 54 'psgi.url_scheme' => ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http', 55 'psgi.input' => $r, 56 'psgi.errors' => *STDERR, 57 'psgi.multithread' => Plack::Util::FALSE, 58 'psgi.multiprocess' => Plack::Util::TRUE, 59 'psgi.run_once' => Plack::Util::FALSE, 60 'psgi.streaming' => Plack::Util::TRUE, 61 'psgi.nonblocking' => Plack::Util::FALSE, 62 'psgix.harakiri' => Plack::Util::TRUE, 63 'psgix.cleanup' => Plack::Util::TRUE, 64 'psgix.cleanup.handlers' => [], 65 }; 66 67 if (defined(my $HTTP_AUTHORIZATION = $r->headers_in->{Authorization})) { 68 $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION; 69 } 70 71 # If you supply more than one Content-Length header Apache will 72 # happily concat the values with ", ", e.g. "72, 72". This 73 # violates the PSGI spec so fix this up and just take the first 74 # one. 75 if (exists $env->{CONTENT_LENGTH} && $env->{CONTENT_LENGTH} =~ /,/) { 76 no warnings qw(numeric); 77 $env->{CONTENT_LENGTH} = int $env->{CONTENT_LENGTH}; 78 } 79 80 # Actually, we can not trust PATH_INFO from mod_perl because mod_perl squeezes multiple slashes into one slash. 81 my $uri = URI->new("http://".$r->hostname.$r->unparsed_uri); 82 83 $env->{PATH_INFO} = uri_unescape($uri->path); 84 85 $class->fixup_path($r, $env); 86 87 my $res = $app->($env); 88 89 if (ref $res eq 'ARRAY') { 90 _handle_response($r, $res); 91 } 92 elsif (ref $res eq 'CODE') { 93 $res->(sub { 94 _handle_response($r, $_[0]); 95 }); 96 } 97 else { 98 die "Bad response $res"; 99 } 100 101 if (@{ $env->{'psgix.cleanup.handlers'} }) { 102 $r->push_handlers( 103 PerlCleanupHandler => sub { 104 for my $cleanup_handler (@{ $env->{'psgix.cleanup.handlers'} }) { 105 $cleanup_handler->($env); 106 } 107 108 if ($env->{'psgix.harakiri.commit'}) { 109 $r->child_terminate; 110 } 111 }, 112 ); 113 } else { 114 if ($env->{'psgix.harakiri.commit'}) { 115 $r->child_terminate; 116 } 117 } 118 119 return Apache2::Const::OK; 120} 121 122sub handler { 123 my $class = __PACKAGE__; 124 my $r = shift; 125 my $psgi = $r->dir_config('psgi_app'); 126 $class->call_app($r, $class->load_app($psgi)); 127} 128 129# The method for PH::Apache2::Registry to override. 130sub fixup_path { 131 my ($class, $r, $env) = @_; 132 133 # $env->{PATH_INFO} is created from unparsed_uri so it is raw. 134 my $path_info = $env->{PATH_INFO} || ''; 135 136 # Get argument of <Location> or <LocationMatch> directive 137 # This may be string or regexp and we can't know either. 138 my $location = $r->location; 139 140 # Let's *guess* if we're in a LocationMatch directive 141 if ($location eq '/') { 142 # <Location /> could be handled as a 'root' case where we make 143 # everything PATH_INFO and empty SCRIPT_NAME as in the PSGI spec 144 $env->{SCRIPT_NAME} = ''; 145 } elsif ($path_info =~ s{^($location)/?}{/}) { 146 $env->{SCRIPT_NAME} = $1 || ''; 147 } else { 148 # Apache's <Location> is matched but here is not. 149 # This is something wrong. We can only respect original. 150 $r->server->log_error( 151 "Your request path is '$path_info' and it doesn't match your Location(Match) '$location'. " . 152 "This should be due to the configuration error. See perldoc Plack::Handler::Apache2 for details." 153 ); 154 } 155 156 $env->{PATH_INFO} = $path_info; 157} 158 159sub _handle_response { 160 my ($r, $res) = @_; 161 162 my ($status, $headers, $body) = @{ $res }; 163 164 my $hdrs = ($status >= 200 && $status < 300) 165 ? $r->headers_out : $r->err_headers_out; 166 167 Plack::Util::header_iter($headers, sub { 168 my($h, $v) = @_; 169 if (lc $h eq 'content-type') { 170 $r->content_type($v); 171 } elsif (lc $h eq 'content-length') { 172 $r->set_content_length($v); 173 } else { 174 $hdrs->add($h => $v); 175 } 176 }); 177 178 $r->status($status); 179 180 if (Scalar::Util::blessed($body) and $body->can('path') and my $path = $body->path) { 181 $r->sendfile($path); 182 } elsif (defined $body) { 183 Plack::Util::foreach($body, sub { $r->print(@_) }); 184 $r->rflush; 185 } 186 else { 187 return Plack::Util::inline_object 188 write => sub { $r->print(@_); $r->rflush }, 189 close => sub { $r->rflush }; 190 } 191 192 return Apache2::Const::OK; 193} 194 1951; 196 197__END__ 198 199=encoding utf-8 200 201=head1 NAME 202 203Plack::Handler::Apache2 - Apache 2.0 mod_perl handler to run PSGI application 204 205=head1 SYNOPSIS 206 207 # in your httpd.conf 208 <Location /> 209 SetHandler perl-script 210 PerlResponseHandler Plack::Handler::Apache2 211 PerlSetVar psgi_app /path/to/app.psgi 212 </Location> 213 214 # Optionally preload your apps in startup 215 PerlPostConfigRequire /etc/httpd/startup.pl 216 217See L</STARTUP FILE> for more details on writing a C<startup.pl>. 218 219=head1 DESCRIPTION 220 221This is a mod_perl handler module to run any PSGI application with mod_perl on Apache 2.x. 222 223If you want to run PSGI applications I<behind> Apache instead of using 224mod_perl, see L<Plack::Handler::FCGI> to run with FastCGI, or use 225standalone HTTP servers such as L<Starman> or L<Starlet> proxied with 226mod_proxy. 227 228=head1 CREATING CUSTOM HANDLER 229 230If you want to create a custom handler that loads or creates PSGI 231applications using other means than loading from C<.psgi> files, you 232can create your own handler class and use C<call_app> class method to 233run your application. 234 235 package My::ModPerl::Handler; 236 use Plack::Handler::Apache2; 237 238 sub get_app { 239 # magic! 240 } 241 242 sub handler { 243 my $r = shift; 244 my $app = get_app(); 245 Plack::Handler::Apache2->call_app($r, $app); 246 } 247 248=head1 STARTUP FILE 249 250Here is an example C<startup.pl> to preload PSGI applications: 251 252 #!/usr/bin/env perl 253 254 use strict; 255 use warnings; 256 use Apache2::ServerUtil (); 257 258 BEGIN { 259 return unless Apache2::ServerUtil::restart_count() > 1; 260 261 require lib; 262 lib->import('/path/to/my/perl/libs'); 263 264 require Plack::Handler::Apache2; 265 266 my @psgis = ('/path/to/app1.psgi', '/path/to/app2.psgi'); 267 foreach my $psgi (@psgis) { 268 Plack::Handler::Apache2->preload($psgi); 269 } 270 } 271 272 1; # file must return true! 273 274See L<http://perl.apache.org/docs/2.0/user/handlers/server.html#Startup_File> 275for general information on the C<startup.pl> file for preloading perl modules 276and your apps. 277 278Some things to keep in mind when writing this file: 279 280=over 4 281 282=item * multiple init phases 283 284You have to check that L<Apache2::ServerUtil/restart_count> is C<< > 1 >>, 285otherwise your app will load twice and the env vars you set with 286L<PerlSetEnv|http://perl.apache.org/docs/2.0/user/config/config.html#C_PerlSetEnv_> 287will not be available when your app is loading the first time. 288 289Use the example above as a template. 290 291=item * C<@INC> 292 293The C<startup.pl> file is a good place to add entries to your C<@INC>. 294Use L<lib> to add entries, they can be in your app or C<.psgi> as well, but if 295your modules are in a L<local::lib> or some such, you will need to add the path 296for anything to load. 297 298Alternately, if you follow the example above, you can use: 299 300 PerlSetEnv PERL5LIB /some/path 301 302or 303 304 PerlSwitches -I/some/path 305 306in your C<httpd.conf>, which will also work. 307 308=item * loading errors 309 310Any exceptions thrown in your C<startup.pl> will stop Apache from starting at 311all. 312 313You probably don't want a stray syntax error to bring your whole server down in 314a shared or development environment, in which case it's a good idea to wrap the 315L</preload> call in an eval, using something like this: 316 317 require Plack::Handler::Apache2; 318 319 my @psgis = ('/path/to/app1.psgi', '/path/to/app2.psgi'); 320 321 foreach my $psgi (@psgis) { 322 eval { 323 Plack::Handler::Apache2->preload($psgi); 1; 324 } or do { 325 my $error = $@ || 'Unknown Error'; 326 # STDERR goes to the error_log 327 print STDERR "Failed to load psgi '$psgi': $error\n"; 328 }; 329 } 330 331 332=item * dynamically loaded modules 333 334Some modules load their dependencies at runtime via e.g. L<Class::Load>. These 335modules will not get preloaded into your parent process by just including the 336app/module you are using. 337 338As an optimization, you can dump C<%INC> from a request to see if you are using 339any such modules and preload them in your C<startup.pl>. 340 341Another method is dumping the difference between the C<%INC> on 342process start and process exit. You can use something like this to 343accomplish this: 344 345 my $start_inc = { %INC }; 346 347 END { 348 my @m; 349 foreach my $m (keys %INC) { 350 push @m, $m unless exists $start_inc->{$m}; 351 } 352 353 if (@m) { 354 # STDERR goes to the error_log 355 print STDERR "The following modules need to be preloaded:\n"; 356 print STDERR "$_\n" for @m; 357 } 358 } 359 360=back 361 362=head1 AUTHOR 363 364Tatsuhiko Miyagawa 365 366=head1 CONTRIBUTORS 367 368Paul Driver 369 370Ævar Arnfjörð Bjarmason 371 372Rafael Kitover 373 374=head1 SEE ALSO 375 376L<Plack> 377 378=cut 379