1 package Catalyst::Engine::SCGI;
4 use base 'Catalyst::Engine::CGI';
6 die "Please install SCGI\n" if $@;
11 my $uri_proto=URI->new();
15 Catalyst::Engine::SCGI - SCGI Engine
19 This is the SCGI engine.
21 =head1 OVERLOADED METHODS
23 This class overloads some methods from C<Catalyst::Engine::CGI>.
25 =head2 $self->run($c, $port, $detach)
27 Start the SCGI server. If $port is not set default to port 9000. If $detach is set, server will go into the background.
32 my ( $self, $class, $port, $detach ) = @_;
35 $port = 9000 unless defined $port;
36 my $socket = IO::Socket::INET->new(
40 ) or die "cannot bind to port $port: $!";
41 $sock = SCGI->new( $socket, blocking => 1 )
42 or die "Failed to open SCGI socket; $!";
44 $self->daemon_fork() if defined $detach;
45 $self->daemon_detach() if defined $detach;
46 while ( my $request = $sock->accept ) {
47 eval { $request->read_env };
53 $self->{_request} = $request;
54 $class->handle_request( env => $request->env );
55 # make sure to close once we are done.
61 =head2 $self->finalize_headers ( $c )
63 Write finalized headers to socket
66 sub finalize_headers {
67 my ( $self, $c ) = @_;
68 $c->response->header( Status => $c->response->status );
69 $self->{_request}->connection->print(
70 $c->response->headers->as_string("\015\012") . "\015\012" );
73 =head2 $self->write ( $c, $buffer )
75 Write directly to socket
79 my ( $self, $c, $buffer ) = @_;
81 unless ( $self->{_prepared_write} ) {
82 $self->prepare_write($c);
83 $self->{_prepared_write} = 1;
86 $self->{_request}->connection->print($buffer);
89 =head2 $self->prepare_path($c)
93 my ( $self, $c ) = @_;
94 local (*ENV) = $self->env || \%ENV;
96 my $scheme = $c->request->secure ? 'https' : 'http';
97 my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
98 my $port = $ENV{SERVER_PORT} || 80;
100 if ( exists $ENV{REDIRECT_URL} ) {
101 $base_path = $ENV{REDIRECT_URL};
102 $base_path =~ s/$ENV{PATH_INFO}$//;
105 $base_path = $ENV{SCRIPT_NAME} || '/';
108 # If we are running as a backend proxy, get the true hostname
111 unless ( $c->config->{using_frontend_proxy} ) {
112 last PROXY_CHECK if $host !~ /localhost|127.0.0.1/;
113 last PROXY_CHECK if $c->config->{ignore_frontend_proxy};
115 last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_HOST};
117 $host = $ENV{HTTP_X_FORWARDED_HOST};
119 # backend could be on any port, so
120 # assume frontend is on the default port
121 $port = $c->request->secure ? 443 : 80;
124 my $path = $base_path . ( $ENV{PATH_INFO} || '' );
127 my $uri = $uri_proto->clone;
128 $uri->scheme($scheme);
132 $uri->query( $ENV{QUERY_STRING} ) if $ENV{QUERY_STRING};
135 $uri = $uri->canonical;
136 $c->request->uri($uri);
139 # base must end in a slash
140 $base_path .= '/' unless ( $base_path =~ /\/$/ );
141 my $base = $uri->clone;
143 my ($base_uri) = $base_path=~ /(.*?)\//;
144 $base_uri .= '/' unless ($base_uri =~/\/$/ );
146 $base->path_query($base_uri);
147 $c->request->base($base);
150 =head2 $self->read_chunk ( $c, $buffer, $readlen )
152 Read Body content to $_[3]'s set length and direct output to $_[2].
156 my ( $self, $c ) = @_;
157 my $rc = read( $self->{_request}->connection, $_[2], $_[3] );
161 =head2 $self->daemon_fork()
163 Performs the first part of daemon initialisation. Specifically,
164 forking. STDERR, etc are still connected to a terminal.
173 =head2 $self->daemon_detach( )
175 Performs the second part of daemon initialisation. Specifically,
176 disassociates from the terminal.
178 However, this does B<not> change the current working directory to "/",
179 as normal daemons do. It also does not close all open file
180 descriptors (except STDIN, STDOUT and STDERR, which are re-opened from
187 print "SCGI daemon started (pid $$)\n";
188 open STDIN, "+</dev/null" or die $!;
189 open STDOUT, ">&STDIN" or die $!;
190 open STDERR, ">&STDIN" or die $!;