X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FHTTP.pm;h=f4fef51a6420014dc1e4197662a99fac8260baf5;hb=1b45d7e568761cc47399c1dffab8ce983d076b6f;hp=4062d33f82aab20ce8a4762c731d8595d0a21302;hpb=1661e231e145cda7f7d7b7cadbc2481522e02439;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm
index 4062d33..f4fef51 100644
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -57,9 +57,21 @@ sub finalize_headers {
     push @headers, "$protocol $status $message";
     
     $c->response->headers->header( Date => HTTP::Date::time2str(time) );
-    $c->response->headers->header( Connection => 'close' );
     $c->response->headers->header( Status => $status );
     
+    # Should we keep the connection open?
+    my $connection = $c->request->header('Connection');
+    if (   $self->{options}->{keepalive} 
+        && $connection 
+        && $connection =~ /^keep-alive$/i
+    ) {
+        $c->response->headers->header( Connection => 'keep-alive' );
+        $self->{_keepalive} = 1;
+    }
+    else {
+        $c->response->headers->header( Connection => 'close' );
+    }
+    
     push @headers, $c->response->headers->as_string("\x0D\x0A");
     
     # Buffer the headers so they are sent with the first write() call
@@ -247,20 +259,12 @@ sub run {
 
             Remote->blocking(1);
         
-            # Read until we see a newline
+            # Read until we see all headers
             $self->{inputbuf} = '';
-        
-            while (1) {
-                my $read = sysread Remote, my $buf, CHUNKSIZE;
             
-                if ( !$read ) {
-                    DEBUG && warn "EOF or error: $!\n";
-                    next LISTEN;
-                }
-            
-                DEBUG && warn "Read $read bytes\n";
-                $self->{inputbuf} .= $buf;
-                last if $self->{inputbuf} =~ /(\x0D\x0A?|\x0A\x0D?)/s;
+            if ( !$self->_read_headers ) {
+                # Error reading, give up
+                next LISTEN;
             }
 
             my ( $method, $uri, $protocol ) = $self->_parse_request_line;
@@ -272,17 +276,30 @@ sub run {
             unless ( uc($method) eq 'RESTART' ) {
 
                 # Fork
-                if ( $options->{fork} ) { next if $pid = fork }
+                if ( $options->{fork} ) { 
+                    if ( $pid = fork ) {
+                        DEBUG && warn "Forked child $pid\n";
+                        next;
+                    }
+                }
 
                 $self->_handler( $class, $port, $method, $uri, $protocol );
             
                 if ( my $error = delete $self->{_write_error} ) {
                     DEBUG && warn "Write error: $error\n";
                     close Remote;
-                    next LISTEN;
+                    
+                    if ( !defined $pid ) {
+                        next LISTEN;
+                    }
                 }
 
-                $daemon->close if defined $pid;
+                if ( defined $pid ) {
+                    # Child process, close connection and exit
+                    DEBUG && warn "Child process exiting\n";
+                    $daemon->close;
+                    exit;
+                }
             }
             else {
                 my $sockdata = $self->_socket_data( \*Remote );
@@ -298,8 +315,6 @@ sub run {
                     last;
                 }
             }
-
-            exit if defined $pid;
         }
         continue {
             close Remote;
@@ -342,6 +357,9 @@ sub _handler {
     $sel->add( \*STDIN );
     
     REQUEST:
+    while (1) {
+        my ( $path, $query_string ) = split /\?/, $uri, 2;
+        
         # Initialize CGI environment
         local %ENV = (
             PATH_INFO       => $path         || '',
@@ -355,36 +373,68 @@ sub _handler {
             %copy_of_env,
         );
 
-    # Initialize CGI environment
-    local %ENV = (
-        PATH_INFO       => $path         || '',
-        QUERY_STRING    => $query_string || '',
-        REMOTE_ADDR     => $sockdata->{peeraddr},
-        REMOTE_HOST     => $sockdata->{peername},
-        REQUEST_METHOD  => $method || '',
-        SERVER_NAME     => $sockdata->{localname},
-        SERVER_PORT     => $port,
-        SERVER_PROTOCOL => "HTTP/$protocol",
-        %copy_of_env,
-    );
-
-    # Parse headers
-    if ( $protocol >= 1 ) {
-        $self->_parse_headers;
-    }
+        # Parse headers
+        if ( $protocol >= 1 ) {
+            $self->_parse_headers;
+        }
 
-    # Pass flow control to Catalyst
-    $class->handle_request;
+        # Pass flow control to Catalyst
+        $class->handle_request;
     
-    DEBUG && warn "Request done\n";
+        DEBUG && warn "Request done\n";
     
-    # XXX: We used to have a hack for keep-alive here but keep-alive
-    # has no place in a single-tasking server like this.  Use HTTP::POE
-    # if you want keep-alive.
+        # Allow keepalive requests, this is a hack but we'll support it until
+        # the next major release.
+        if ( delete $self->{_keepalive} ) {
+            
+            DEBUG && warn "Reusing previous connection for keep-alive request\n";
+            
+            if ( $sel->can_read(1) ) {            
+                if ( !$self->_read_headers ) {
+                    # Error reading, give up
+                    last REQUEST;
+                }
+
+                ( $method, $uri, $protocol ) = $self->_parse_request_line;
+                
+                DEBUG && warn "Parsed request: $method $uri $protocol\n";
+                
+                # Force HTTP/1.0
+                $protocol = '1.0';
+                
+                next REQUEST;
+            }
+            
+            DEBUG && warn "No keep-alive request within 1 second\n";
+        }
+        
+        last REQUEST;
+    }
+    
+    DEBUG && warn "Closing connection\n";
 
     close Remote;
 }
 
+sub _read_headers {
+    my $self = shift;
+    
+    while (1) {
+        my $read = sysread Remote, my $buf, CHUNKSIZE;
+    
+        if ( !$read ) {
+            DEBUG && warn "EOF or error: $!\n";
+            return;
+        }
+    
+        DEBUG && warn "Read $read bytes\n";
+        $self->{inputbuf} .= $buf;
+        last if $self->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s;
+    }
+    
+    return 1;
+}
+
 sub _parse_request_line {
     my $self = shift;