1 package Catalyst::Engine::CGI;
4 extends 'Catalyst::Engine';
6 has _header_buf => (is => 'rw', clearer => '_clear_header_buf', predicate => '_has_header_buf');
10 Catalyst::Engine::CGI - The CGI Engine
14 A script using the Catalyst::Engine::CGI module might look like:
19 use lib '/path/to/MyApp/lib';
24 The application module (C<MyApp>) would use C<Catalyst>, which loads the
25 appropriate engine module.
29 This is the Catalyst engine specialized for the CGI environment.
33 Most web server environments pass the requested path to the application using environment variables,
34 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
35 exposed as C<< $c->request->base >>) and the request path below that base.
37 There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
38 is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
40 =head2 use_request_uri_for_path => 0
42 This is the default (and the) traditional method that Catalyst has used for determining the path information.
43 The path is synthesised from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
44 The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
45 into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
47 However this method has the major disadvantage that it is impossible to correctly decode some elements
48 of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
49 contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
50 can't distinguish / vs %2F in paths.
52 =head2 use_request_uri_for_path => 1
54 This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
55 decoded, this means that applications using this mode can correctly handle URIs including the %2F character
56 (i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
58 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
59 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
60 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
61 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
62 C<< $c->request->base >> will be incorrect.
64 =head1 OVERLOADED METHODS
66 This class overloads some methods from C<Catalyst::Engine>.
68 =head2 $self->finalize_headers($c)
72 sub finalize_headers {
73 my ( $self, $c ) = @_;
75 $c->response->header( Status => $c->response->status );
77 $self->_header_buf($c->response->headers->as_string("\015\012") . "\015\012");
80 =head2 $self->prepare_connection($c)
84 sub prepare_connection {
85 my ( $self, $c ) = @_;
86 local (*ENV) = $self->env || \%ENV;
88 my $request = $c->request;
89 $request->address( $ENV{REMOTE_ADDR} );
93 unless ( ref($c)->config->{using_frontend_proxy} ) {
94 last PROXY_CHECK if $ENV{REMOTE_ADDR} ne '127.0.0.1';
95 last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy};
97 last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_FOR};
99 # If we are running as a backend server, the user will always appear
100 # as 127.0.0.1. Select the most recent upstream IP (last in the list)
101 my ($ip) = $ENV{HTTP_X_FORWARDED_FOR} =~ /([^,\s]+)$/;
102 $request->address($ip);
103 if ( defined $ENV{HTTP_X_FORWARDED_PORT} ) {
104 $ENV{SERVER_PORT} = $ENV{HTTP_X_FORWARDED_PORT};
108 $request->hostname( $ENV{REMOTE_HOST} ) if exists $ENV{REMOTE_HOST};
109 $request->protocol( $ENV{SERVER_PROTOCOL} );
110 $request->user( $ENV{REMOTE_USER} ); # XXX: Deprecated. See Catalyst::Request for removal information
111 $request->remote_user( $ENV{REMOTE_USER} );
112 $request->method( $ENV{REQUEST_METHOD} );
114 if ( $ENV{HTTPS} && uc( $ENV{HTTPS} ) eq 'ON' ) {
118 if ( $ENV{SERVER_PORT} == 443 ) {
121 binmode(STDOUT); # Ensure we are sending bytes.
124 =head2 $self->prepare_headers($c)
128 sub prepare_headers {
129 my ( $self, $c ) = @_;
130 local (*ENV) = $self->env || \%ENV;
131 my $headers = $c->request->headers;
132 # Read headers from %ENV
133 foreach my $header ( keys %ENV ) {
134 next unless $header =~ /^(?:HTTP|CONTENT|COOKIE)/i;
135 ( my $field = $header ) =~ s/^HTTPS?_//;
136 $headers->header( $field => $ENV{$header} );
140 =head2 $self->prepare_path($c)
144 # Please don't touch this method without adding tests in
145 # t/aggregate/unit_core_engine_cgi-prepare_path.t
147 my ( $self, $c ) = @_;
148 local (*ENV) = $self->env || \%ENV;
150 my $scheme = $c->request->secure ? 'https' : 'http';
151 my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
152 my $port = $ENV{SERVER_PORT} || 80;
153 my $script_name = $ENV{SCRIPT_NAME};
154 $script_name =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go if $script_name;
157 if ( exists $ENV{REDIRECT_URL} ) {
158 $base_path = $ENV{REDIRECT_URL};
159 $base_path =~ s/\Q$ENV{PATH_INFO}\E$//;
162 $base_path = $script_name || '/';
165 # If we are running as a backend proxy, get the true hostname
168 unless ( ref($c)->config->{using_frontend_proxy} ) {
169 last PROXY_CHECK if $host !~ /localhost|127.0.0.1/;
170 last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy};
172 last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_HOST};
174 $host = $ENV{HTTP_X_FORWARDED_HOST};
176 # backend could be on any port, so
177 # assume frontend is on the default port
178 $port = $c->request->secure ? 443 : 80;
179 if ( $ENV{HTTP_X_FORWARDED_PORT} ) {
180 $port = $ENV{HTTP_X_FORWARDED_PORT};
184 my $path_info = $ENV{PATH_INFO};
185 if ($c->config->{use_request_uri_for_path}) {
186 # RFC 3875: "Unlike a URI path, the PATH_INFO is not URL-encoded,
187 # and cannot contain path-segment parameters." This means PATH_INFO
188 # is always decoded, and the script can't distinguish / vs %2F.
189 # See https://issues.apache.org/bugzilla/show_bug.cgi?id=35256
190 # Here we try to resurrect the original encoded URI from REQUEST_URI.
191 if (my $req_uri = $ENV{REQUEST_URI}) {
192 if (defined $script_name) {
193 $req_uri =~ s/^\Q$script_name\E//;
195 $req_uri =~ s/\?.*$//;
196 $path_info = $req_uri if $req_uri;
200 # set the request URI
201 my $path = $base_path . ( $path_info || '' );
204 # Using URI directly is way too slow, so we construct the URLs manually
205 my $uri_class = "URI::$scheme";
207 # HTTP_HOST will include the port even if it's 80/443
208 $host =~ s/:(?:80|443)$//;
210 if ( $port !~ /^(?:80|443)$/ && $host !~ /:/ ) {
215 $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
216 $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
218 my $query = $ENV{QUERY_STRING} ? '?' . $ENV{QUERY_STRING} : '';
219 my $uri = $scheme . '://' . $host . '/' . $path . $query;
221 $c->request->uri( bless(\$uri, $uri_class)->canonical );
224 # base must end in a slash
225 $base_path .= '/' unless $base_path =~ m{/$};
227 my $base_uri = $scheme . '://' . $host . $base_path;
229 $c->request->base( bless \$base_uri, $uri_class );
232 =head2 $self->prepare_query_parameters($c)
236 around prepare_query_parameters => sub {
238 my ( $self, $c ) = @_;
239 local (*ENV) = $self->env || \%ENV;
241 if ( $ENV{QUERY_STRING} ) {
242 $self->$orig( $c, $ENV{QUERY_STRING} );
246 =head2 $self->prepare_request($c, (env => \%env))
250 sub prepare_request {
251 my ( $self, $c, %args ) = @_;
254 $self->env( $args{env} );
258 =head2 $self->prepare_write($c)
260 Enable autoflush on the output handle for CGI-based engines.
264 around prepare_write => sub {
265 *STDOUT->autoflush(1);
269 =head2 $self->write($c, $buffer)
271 Writes the buffer to the client.
275 around write => sub {
277 my ( $self, $c, $buffer ) = @_;
279 # Prepend the headers if they have not yet been sent
280 if ( $self->_has_header_buf ) {
281 $buffer = $self->_clear_header_buf . $buffer;
284 return $self->$orig( $c, $buffer );
287 =head2 $self->read_chunk($c, $buffer, $length)
291 sub read_chunk { shift; shift; *STDIN->sysread(@_); }
297 sub run { shift; shift->handle_request( env => \%ENV ) }
301 L<Catalyst>, L<Catalyst::Engine>
305 Catalyst Contributors, see Catalyst.pm
309 This library is free software. You can redistribute it and/or modify it under
310 the same terms as Perl itself.