+++ /dev/null
-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<MyApp>) would use C<Catalyst>, which loads the
-appropriate engine module.
-
-=head1 DESCRIPTION
-
-This is the Catalyst engine specialized for the CGI environment.
-
-=head1 OVERLOADED METHODS
-
-This class overloads some methods from C<Catalyst::Engine>.
-
-=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;
- 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/$ENV{PATH_INFO}$//;
- }
- 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};
- }
- }
-
- # 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.
- my $path_info = $ENV{PATH_INFO};
- if (my $req_uri = $ENV{REQUEST_URI}) {
- $req_uri =~ s/^\Q$base_path\E//;
- $req_uri =~ s/\?.*$//;
- if ($req_uri) {
- # Note that if REQUEST_URI doesn't start with a /, then the user
- # is probably using mod_rewrite or something to rewrite requests
- # into a sub-path of their application..
- # This means that REQUEST_URI needs information from PATH_INFO
- # prepending to it to be useful, otherwise the sub path which is
- # being redirected to becomes the app base address which is
- # incorrect.
- if (substr($req_uri, 0, 1) ne '/') {
- my ($match) = $req_uri =~ m|^([^/]+)|;
- my $idx = index($path_info, $match) + length($match);
- my $path_info_part = substr($path_info, 0, $idx);
- substr($req_uri, 0, length($match), $path_info_part);
- }
- $path_info = $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 );
-
- # 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->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 ) {
- $buffer = $self->_clear_header_buf . $buffer;
- }
-
- 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<Catalyst>, L<Catalyst::Engine>
-
-=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;
+++ /dev/null
-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<Catalyst::Engine::CGI>.
-
-=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;
-
- $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},
- }
- );
-
- # 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 ) = @_;
-
- 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<not> 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</dev/null>).
-
-=cut
-
-sub daemon_detach {
- my $self = shift;
- print "FastCGI daemon started (pid $$)\n";
- open STDIN, "+</dev/null" or die $!;
- open STDOUT, ">&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/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<MUST NOT> exist --
-it's a virtual file name. With some versions of C<mod_fastcgi> or
-C<mod_fcgid>, 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:
-
- <VirtualHost *:80>
- ServerName www.myapp.com
- DocumentRoot /path/to/MyApp
-
- # Allow CGI script to run
- <Directory /path/to/MyApp>
- Options +ExecCGI
- </Directory>
-
- # Tell Apache this is a FastCGI application
- <Files myapp_fastcgi.pl>
- SetHandler fastcgi-script
- </Files>
- </VirtualHost>
-
-Then a request for /script/myapp_fastcgi.pl will run the
-application.
-
-For more information on using FastCGI under Apache, visit
-L<http://www.fastcgi.com/mod_fastcgi/docs/mod_fastcgi.html>
-
-=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<Catalyst::Plugin::Authentication::Credential::HTTP> 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<http://www.lighttpd.net/documentation/fastcgi.html>
-
-=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</etc/nginx/fastcgi_params>) 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<http://nginx.net>
-
-=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<http://www.iis.net/extensions/FastCGI>. 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/<number>/ServerComment"
- ; to get all details: "cscript adsutil.vbs GET /W3SVC/<number>"
- ; - 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<Catalyst>, L<FCGI>.
-
-=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
+++ /dev/null
-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->{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, "+</dev/null" or die $!;
- open STDOUT, ">&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, AF_INET ) || 'localhost',
- localaddr => inet_ntoa($localiaddr) || '127.0.0.1',
- };
-
- return $data;
-}
-
-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<Catalyst>, L<Catalyst::Engine>
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 THANKS
-
-Many parts are ripped out of C<HTTP::Server::Simple> 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;
projects / catagits/Catalyst-Runtime.git / commitdiff