$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)
}
}
+=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
$options ||= {};
+ if ($options->{background}) {
+ my $child = fork;
+ die "Can't fork: $!" unless defined($child);
+ exit if $child;
+ }
+
my $restart = 0;
local $SIG{CHLD} = 'IGNORE';
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;
+ }
+
$self->_keep_alive( $options->{keepalive} || 0 );
- my $parent = $$;
my $pid = undef;
while ( accept( Remote, $daemon ) )
{ # TODO: get while ( my $remote = $daemon->accept ) to work
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;
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} } );
}
$name = 'HTTP_' . $name
unless $name =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/;
if ( exists $ENV{$name} ) {
- $ENV{$name} .= "; $value";
+ $ENV{$name} .= ", $value";
}
else {
$ENV{$name} = $value;
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;