X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FHTTP.pm;h=808cbca4cb50e3ae1dd51a40b991315ccfd1629e;hb=00c9932455ecd6ca565d60d76180a2d850b7317b;hp=0024009e2591655bac782e16a717efc3e16de38a;hpb=b5ecfcf07b8ffe7e9984f0279c8781ce51c6ac6a;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm index 0024009..808cbca 100644 --- a/lib/Catalyst/Engine/HTTP.pm +++ b/lib/Catalyst/Engine/HTTP.pm @@ -50,7 +50,12 @@ sub finalize_headers { $c->response->headers->date(time); $c->response->headers->header( Connection => $self->_keep_alive ? 'keep-alive' : 'close' ); - $self->NEXT::finalize_headers($c); + + $c->response->header( Status => $c->response->status ); + + # Avoid 'print() on closed filehandle Remote' warnings when using IE + print $c->response->headers->as_string("\015\012") if *STDOUT->opened(); + print "\015\012" if *STDOUT->opened(); } =head2 $self->finalize_read($c) @@ -106,6 +111,19 @@ sub read_chunk { } } +=head2 $self->write($c, $buffer) + +Writes the buffer to the client. Can only be called once for a request. + +=cut + +sub write { + # Avoid 'print() on closed filehandle Remote' warnings when using IE + return unless *STDOUT->opened(); + + shift->NEXT::write( @_ ); +} + =head2 run =cut @@ -116,6 +134,12 @@ sub run { $options ||= {}; + if ($options->{background}) { + my $child = fork; + die "Can't fork: $!" unless defined($child); + exit if $child; + } + my $restart = 0; local $SIG{CHLD} = 'IGNORE'; @@ -147,9 +171,27 @@ sub run { print "You can connect to your server at $url\n"; + if ($options->{background}) { + open STDIN, "+&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; + } + $self->_keep_alive( $options->{keepalive} || 0 ); - my $parent = $$; my $pid = undef; while ( accept( Remote, $daemon ) ) { # TODO: get while ( my $remote = $daemon->accept ) to work @@ -178,8 +220,10 @@ sub run { my $sockdata = $self->_socket_data( \*Remote ); my $ipaddr = _inet_addr( $sockdata->{peeraddr} ); my $ready = 0; - while ( my ( $ip, $mask ) = each %$allowed and not $ready ) { + foreach my $ip ( keys %$allowed ) { + my $mask = $allowed->{$ip}; $ready = ( $ipaddr & _inet_addr($mask) ) == _inet_addr($ip); + last if $ready; } if ($ready) { $restart = 1; @@ -197,6 +241,13 @@ sub run { 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 . '" ' . join( ' ', @{ $options->{argv} } ); } @@ -302,16 +353,24 @@ sub _parse_request_line { sub _socket_data { my ( $self, $handle ) = @_; - my $remote_sockaddr = getpeername($handle); - my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr); - my $local_sockaddr = getsockname($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 = { - peername => gethostbyaddr( $iaddr, AF_INET ) || "localhost", - peeraddr => inet_ntoa($iaddr) || "127.0.0.1", - localname => gethostbyaddr( $localiaddr, AF_INET ) || "localhost", - localaddr => inet_ntoa($localiaddr) || "127.0.0.1", + peername => $iaddr + ? ( gethostbyaddr( $iaddr, AF_INET ) || 'localhost' ) + : 'localhost', + 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;