[Catalyst-commits] r7085 - in
trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP:
. Sprocket
andyg at dev.catalyst.perl.org
andyg at dev.catalyst.perl.org
Wed Oct 31 22:21:47 GMT 2007
Author: andyg
Date: 2007-10-31 22:21:46 +0000 (Wed, 31 Oct 2007)
New Revision: 7085
Modified:
trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket.pm
trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm
trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm
Log:
Sprocket engine now passes all but 1 test, added more HTTP/1.1 support including chunked responses, still need to do keep-alive
Modified: trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm 2007-10-31 12:53:32 UTC (rev 7084)
+++ trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm 2007-10-31 22:21:46 UTC (rev 7085)
@@ -31,10 +31,16 @@
my ( $class, $config ) = @_;
# Process control params
- $config->{start_servers} ||= 5; # number of children to start on startup
- $config->{min_spare} ||= 5; # min number of idle children
- $config->{max_spare} ||= 10; # max number of idle children
- $config->{idle_timeout} ||= 30; # kill idle children > min_spare after this time
+ $config->{start_servers} ||= 5; # number of children to start on startup
+ if ( !defined $config->{min_spare} ) {
+ $config->{min_spare} = 5; # min number of idle children
+ }
+ if ( !defined $config->{max_spare} ) {
+ $config->{max_spare} = 10; # max number of idle children
+ }
+ if ( !defined $config->{idle_timeout} ) {
+ $config->{idle_timeout} = 30; # kill idle children > min_spare after this time
+ }
if ( HAS_AIO ) {
# Try to serve everything under /static using AIO
@@ -223,6 +229,9 @@
my $min_spare = $self->{config}->{min_spare};
my $max_spare = $self->{config}->{max_spare};
+ # No reason to bother with this if min/max are set to 0
+ return unless $min_spare && $max_spare;
+
# Check that we have at least min_spare idle children
my $idle = grep { !$_ } values %{ $self->{child_busy} };
@@ -350,7 +359,6 @@
$con->call( 'child_reset' );
- # XXX: Sprocket bug doesn't close connections properly?
$con->close();
}
}
@@ -364,6 +372,8 @@
sub local_receive {
my ( $self, $server, $con, $input ) = @_;
+ #DEBUG && warn "[$con] local_receive: " . dump($input) . "\n";
+
# If this connection is already being handled, just pass the data along
if ( my $id = $con->x->{handler_id} ) {
DEBUG && warn "[$con] [$id] Passed along " . length($input) . " bytes of body data\n";
@@ -371,12 +381,11 @@
return 1;
}
- DEBUG && warn "[$con] local_receive: " . dump($input) . "\n";
-
# Update stats
$self->{stats}->{num_reqs}++;
if ( $self->{config}->{aio_static} && $input =~ m{^GET /static/([^ \?]+)} ) {
+ # XXX: is this secure?
my $file = $self->{config}->{aio_static_path} . '/' . uri_unescape($1);
DEBUG && warn "[$con] directly serving static file $file\n";
@@ -474,19 +483,19 @@
sub child_stdout {
my ( $kernel, $self, $input, $wheel_id ) = @_[ KERNEL, OBJECT, ARG0, ARG1 ];
- #DEBUG && warn "Child $wheel_id stdout: " . dump($input) . "\n";
+ DEBUG && warn "Child $wheel_id stdout: " . dump($input) . "\n";
my $con = $self->{child_busy}->{ $wheel_id };
if ( !$con ) {
# Remote host probably closed the connection, we will just ignore further data
- DEBUG && warn "*** Got stdout data after con was closed: " . dump($input) . "\n";
+ DEBUG && warn "*** Got stdout data after con was closed: " . dump($input) . "\n";
return;
}
if ( $input =~ s/$DONE_REGEX// ) {
# Send any data prior to the magic done string
- if ( defined $input ) {
+ if ( defined $input && length($input) ) {
$con->send( $input );
if ( DEBUG ) {
@@ -499,7 +508,6 @@
$con->call( 'child_reset' );
# XXX: keep-alive support, just close connection for now
- # XXX: Sprocket bug doesn't close connections properly?
$con->close();
return;
Modified: trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm 2007-10-31 12:53:32 UTC (rev 7084)
+++ trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm 2007-10-31 22:21:46 UTC (rev 7085)
@@ -6,6 +6,7 @@
use base qw(Catalyst::Engine::CGI);
use Data::Dump qw(dump);
+use HTTP::Date qw(time2str);
use HTTP::Headers;
use HTTP::Response;
use HTTP::Status qw(status_message);
@@ -73,19 +74,17 @@
if ( $buf !~ s/^(\w+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012// ) {
# Invalid request
DEBUG && warn "[$$] Bad request: $buf\n";
-
- my $status = 400;
- my $message = status_message($status);
- my $response = HTTP::Response->new( $status => $message );
- $response->content_type( 'text/plain' );
- $response->content( "$status $message" );
- syswrite STDOUT, $response->as_string("\x0D\x0A");
+
+ $self->send_error_response( 400, 'Malformed request line' );
next;
}
my $method = $1;
my $uri = $2;
my $proto = $3 || 'HTTP/0.9';
+
+ # Strip out absolute part of uri, if any (required by HTTP/1.1)
+ $uri =~ s{^https?://[^/]+}{};
DEBUG && warn "[$$] $method $uri $proto\n";
@@ -143,6 +142,12 @@
$ENV{$key} = $val;
}
} );
+
+ # Check for a Host header if HTTP/1.1
+ if ( $proto eq 'HTTP/1.1' && !$ENV{HTTP_HOST} ) {
+ $self->send_error_response( 400, 'Missing Host header' );
+ next;
+ }
# Save inputbuf for use in read_chunk and reset
# inputbuf for the next request.
@@ -152,16 +157,41 @@
# Pass flow to Catalyst
$config->{appclass}->handle_request();
}
+ else {
+ # If the request is HTTP/1.1, response with 100 Continue
+ if ( $input =~ m/(HTTP\/\d+\.\d+)/ ) {
+ my $proto = $1;
+ if ( $proto eq 'HTTP/1.1' ) {
+ syswrite STDOUT, 'HTTP/1.1 100 Continue' . "\x0D\x0A";
+ }
+ }
+ }
}
}
sub finalize_headers {
my ( $self, $c ) = @_;
- my $protocol = 'HTTP/1.0'; # no 1.1 support yet
- my $status = $c->response->status;
- my $message = status_message($status);
+ my $protocol = $c->request->protocol;
+ my $status = $c->response->status;
+ my $message = status_message($status);
+ # Switch on Transfer-Encoding: chunked if we don't know
+ # Content-Length. This should move to main Catalyst at some point
+ if ( $protocol eq 'HTTP/1.1' && !$c->response->content_length ) {
+ if ( $c->response->status !~ /^1\d\d|[23]04$/ ) {
+ $c->response->header( 'Transfer-Encoding' => 'chunked' );
+ $c->response->{_chunked} = 1;
+ }
+ }
+
+ if ( !$c->response->header('Date') ) {
+ $c->response->header( Date => time2str( time() ) );
+ }
+
+ # XXX: keep-alive support
+ $c->response->header( Connection => 'close' );
+
$self->NEXT::finalize_headers($c);
# Buffer the initial line so it's sent together with the headers
@@ -173,6 +203,8 @@
sub read_chunk {
my ( $self, $c ) = ( shift, shift );
+ # XXX: Transfer-Encoding: chunked request support
+
# If we have existing body data, deal with that first
my $existing_len;
@@ -210,9 +242,43 @@
$self->NEXT::finalize_body( $c );
+ if ( $c->response->{_chunked} ) {
+ # Write the final '0' chunk
+ syswrite STDOUT, '0' . "\x0D\x0A";
+ }
+
# We need to notify the parent when a response has finished
# We do this by sending a special magic string
syswrite STDOUT, $self->{config}->{child_done};
}
+sub write {
+ my ( $self, $c, $buffer ) = @_;
+
+ if ( $c->response->{_chunked} ) {
+ $buffer = sprintf( "%X", length($buffer) ) . "\x0D\x0A" . $buffer . "\x0D\x0A";
+ }
+
+ $self->NEXT::write( $c, $buffer );
+}
+
+sub send_error_response {
+ my ( $self, $code, $reason ) = @_;
+
+ my $status = $code || 500;
+ my $message = status_message($status);
+ my $response = HTTP::Response->new( $status => $message );
+ $response->content_type( 'text/plain' );
+
+ if ( !$reason ) {
+ $reason = $message;
+ }
+
+ $response->content( "$status $reason" );
+
+ syswrite STDOUT,
+ $response->as_string("\x0D\x0A")
+ . "\x0D\x0A" . $self->{config}->{child_done};
+}
+
1;
Modified: trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket.pm 2007-10-31 12:53:32 UTC (rev 7084)
+++ trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket.pm 2007-10-31 22:21:46 UTC (rev 7085)
@@ -10,7 +10,7 @@
use Catalyst::Engine::HTTP::Sprocket::Server;
-our $VERSION = '0.01';
+our $VERSION = '0.50';
sub DEBUG () { $ENV{CATALYST_POE_DEBUG} || 0 }
More information about the Catalyst-commits
mailing list