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 (in addition to other encoded values).
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 Given that this method of path resolution is provably more correct, it is recommended that you use
59 this unless you have a specific need to deploy your application in a non-standard environment, and you are
60 aware of the implications of not being able to handle encoded URI paths correctly.
62 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
63 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
64 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
65 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
66 C<< $c->request->base >> will be incorrect.
68 =head1 OVERLOADED METHODS
70 This class overloads some methods from C<Catalyst::Engine>.
72 =head2 $self->finalize_headers($c)
76 sub finalize_headers {
77 my ( $self, $c ) = @_;
79 $c->response->header( Status => $c->response->status );
81 $self->_header_buf($c->response->headers->as_string("\015\012") . "\015\012");
84 =head2 $self->prepare_connection($c)
88 sub prepare_connection {
89 my ( $self, $c ) = @_;
90 local (*ENV) = $self->env || \%ENV;
92 my $request = $c->request;
93 $request->address( $ENV{REMOTE_ADDR} );
97 unless ( ref($c)->config->{using_frontend_proxy} ) {
98 last PROXY_CHECK if $ENV{REMOTE_ADDR} ne '127.0.0.1';
99 last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy};
101 last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_FOR};
103 # If we are running as a backend server, the user will always appear
104 # as 127.0.0.1. Select the most recent upstream IP (last in the list)
105 my ($ip) = $ENV{HTTP_X_FORWARDED_FOR} =~ /([^,\s]+)$/;
106 $request->address($ip);
107 if ( defined $ENV{HTTP_X_FORWARDED_PORT} ) {
108 $ENV{SERVER_PORT} = $ENV{HTTP_X_FORWARDED_PORT};
112 $request->hostname( $ENV{REMOTE_HOST} ) if exists $ENV{REMOTE_HOST};
113 $request->protocol( $ENV{SERVER_PROTOCOL} );
114 $request->user( $ENV{REMOTE_USER} ); # XXX: Deprecated. See Catalyst::Request for removal information
115 $request->remote_user( $ENV{REMOTE_USER} );
116 $request->method( $ENV{REQUEST_METHOD} );
118 if ( $ENV{HTTPS} && uc( $ENV{HTTPS} ) eq 'ON' ) {
122 if ( $ENV{SERVER_PORT} == 443 ) {
125 binmode(STDOUT); # Ensure we are sending bytes.
128 =head2 $self->prepare_headers($c)
132 sub prepare_headers {
133 my ( $self, $c ) = @_;
134 local (*ENV) = $self->env || \%ENV;
135 my $headers = $c->request->headers;
136 # Read headers from %ENV
137 foreach my $header ( keys %ENV ) {
138 next unless $header =~ /^(?:HTTP|CONTENT|COOKIE)/i;
139 ( my $field = $header ) =~ s/^HTTPS?_//;
140 $headers->header( $field => $ENV{$header} );
144 =head2 $self->prepare_path($c)
148 # Please don't touch this method without adding tests in
149 # t/aggregate/unit_core_engine_cgi-prepare_path.t
151 my ( $self, $c ) = @_;
152 local (*ENV) = $self->env || \%ENV;
154 my $scheme = $c->request->secure ? 'https' : 'http';
155 my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
156 my $port = $ENV{SERVER_PORT} || 80;
159 if ($ENV{SERVER_SOFTWARE} && $ENV{SERVER_SOFTWARE} =~ m{IIS/[6-9]\.\d}) {
160 $ENV{PATH_INFO} =~ s/^\Q$ENV{SCRIPT_NAME}\E//;
163 my $script_name = $ENV{SCRIPT_NAME};
164 $script_name =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go if $script_name;
167 if ( exists $ENV{REDIRECT_URL} ) {
168 $base_path = $ENV{REDIRECT_URL};
169 $base_path =~ s/\Q$ENV{PATH_INFO}\E$//;
172 $base_path = $script_name || '/';
175 # If we are running as a backend proxy, get the true hostname
178 unless ( ref($c)->config->{using_frontend_proxy} ) {
179 last PROXY_CHECK if $host !~ /localhost|127.0.0.1/;
180 last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy};
182 last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_HOST};
184 $host = $ENV{HTTP_X_FORWARDED_HOST};
186 # backend could be on any port, so
187 # assume frontend is on the default port
188 $port = $c->request->secure ? 443 : 80;
189 if ( $ENV{HTTP_X_FORWARDED_PORT} ) {
190 $port = $ENV{HTTP_X_FORWARDED_PORT};
194 my $path_info = $ENV{PATH_INFO};
195 if ($c->config->{use_request_uri_for_path}) {
196 # RFC 3875: "Unlike a URI path, the PATH_INFO is not URL-encoded,
197 # and cannot contain path-segment parameters." This means PATH_INFO
198 # is always decoded, and the script can't distinguish / vs %2F.
199 # See https://issues.apache.org/bugzilla/show_bug.cgi?id=35256
200 # Here we try to resurrect the original encoded URI from REQUEST_URI.
201 if (my $req_uri = $ENV{REQUEST_URI}) {
202 if (defined $script_name) {
203 $req_uri =~ s/^\Q$script_name\E//;
205 $req_uri =~ s/\?.*$//;
206 $path_info = $req_uri if $req_uri;
210 # set the request URI
211 my $path = $base_path . ( $path_info || '' );
214 # Using URI directly is way too slow, so we construct the URLs manually
215 my $uri_class = "URI::$scheme";
217 # HTTP_HOST will include the port even if it's 80/443
218 $host =~ s/:(?:80|443)$//;
220 if ( $port !~ /^(?:80|443)$/ && $host !~ /:/ ) {
225 $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
226 $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
228 my $query = $ENV{QUERY_STRING} ? '?' . $ENV{QUERY_STRING} : '';
229 my $uri = $scheme . '://' . $host . '/' . $path . $query;
231 $c->request->uri( bless(\$uri, $uri_class)->canonical );
234 # base must end in a slash
235 $base_path .= '/' unless $base_path =~ m{/$};
237 my $base_uri = $scheme . '://' . $host . $base_path;
239 $c->request->base( bless \$base_uri, $uri_class );
242 =head2 $self->prepare_query_parameters($c)
246 around prepare_query_parameters => sub {
248 my ( $self, $c ) = @_;
249 local (*ENV) = $self->env || \%ENV;
251 if ( $ENV{QUERY_STRING} ) {
252 $self->$orig( $c, $ENV{QUERY_STRING} );
256 =head2 $self->prepare_request($c, (env => \%env))
260 sub prepare_request {
261 my ( $self, $c, %args ) = @_;
264 $self->env( $args{env} );
268 =head2 $self->prepare_write($c)
270 Enable autoflush on the output handle for CGI-based engines.
274 around prepare_write => sub {
275 *STDOUT->autoflush(1);
279 =head2 $self->write($c, $buffer)
281 Writes the buffer to the client.
285 around write => sub {
287 my ( $self, $c, $buffer ) = @_;
289 # Prepend the headers if they have not yet been sent
290 if ( $self->_has_header_buf ) {
291 my $headers = $self->_clear_header_buf;
293 $buffer = defined $buffer
294 ? $headers . $buffer : $headers;
297 return $self->$orig( $c, $buffer );
300 =head2 $self->read_chunk($c, $buffer, $length)
304 sub read_chunk { shift; shift; *STDIN->sysread(@_); }
310 sub run { shift; shift->handle_request( env => \%ENV ) }
314 L<Catalyst>, L<Catalyst::Engine>
318 Catalyst Contributors, see Catalyst.pm
322 This library is free software. You can redistribute it and/or modify it under
323 the same terms as Perl itself.