Updated built in server to restart on win32

diff --git a/Changes b/Changes
index 3c705b2..e3e16eb 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Tis file documents the revision history for Perl extension Catalyst.
 
 5.5
+        - Updated built in server to restart on win32
         - Fixed streaming write from a filehandle to stop writing
           if the browser is closed.
         - Added $c->controller, $c->model and $c->view shortcuts

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 82896f0..2427601 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -1815,6 +1815,8 @@ Robert Sedlacek
 
 Sam Vilain
 
+Sascha Kiefer
+
 Tatsuhiko Miyagawa
 
 Ulf Edvinsson

diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm
index 779378c..37ed3a9 100644 (file)
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -109,25 +109,27 @@ sub run {
     my ( $self, $class, $port, $host, $options ) = @_;
 
     $options ||= {};
-    
+
     our $GOT_HUP;
     local $GOT_HUP = 0;
-    
+
     local $SIG{HUP} = sub { $GOT_HUP = 1; };
     local $SIG{CHLD} = 'IGNORE';
 
+    my $allowed = $options->{allowed} || { '127.0.0.1' => '255.255.255.255' };
+
     # Handle requests
 
     # Setup socket
     $host = $host ? inet_aton($host) : INADDR_ANY;
     socket( HTTPDaemon, PF_INET, SOCK_STREAM, getprotobyname('tcp') )
-        || die "Couldn't assign TCP socket: $!";
+      || die "Couldn't assign TCP socket: $!";
     setsockopt( HTTPDaemon, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) )
-        || die "Couldn't set TCP socket options: $!";
+      || die "Couldn't set TCP socket options: $!";
     bind( HTTPDaemon, sockaddr_in( $port, $host ) )
-        || die "Couldn't bind socket to $port on $host: $!";
+      || die "Couldn't bind socket to $port on $host: $!";
     listen( HTTPDaemon, SOMAXCONN )
-       || die "Couldn't listen to socket on $port on $host: $!";
+      || die "Couldn't listen to socket on $port on $host: $!";
     my $url = 'http://';
     if ( $host eq INADDR_ANY ) {
         require Sys::Hostname;
@@ -213,9 +215,22 @@ sub run {
                 }
             }
         }
+        unless ( uc($method) eq 'KILL' ) {
 
-        # Pass flow control to Catalyst
-        $class->handle_request;
+            # Pass flow control to Catalyst
+            $class->handle_request;
+        }
+        else {
+            my $ipaddr = _inet_addr($peeraddr);
+            my $ready  = 0;
+            while ( my ( $ip, $mask ) = each %$allowed and not $ready ) {
+                $ready = ( $ipaddr & _inet_addr($mask) ) == _inet_addr($ip);
+            }
+            if ($ready) {
+                $GOT_HUP = 1;
+                last;
+            }
+        }
         exit if defined $pid;
     }
     continue {
@@ -226,7 +241,7 @@ sub run {
     if ($GOT_HUP) {
         $SIG{CHLD} = 'DEFAULT';
         wait;
-        exec $^X . ' "' . $0 . '" ' . join(' ', @{$options->{argv}});
+        exec $^X . ' "' . $0 . '" ' . join( ' ', @{ $options->{argv} } );
     }
 }
 
@@ -245,6 +260,8 @@ sub _get_line {
     return $line;
 }
 
+sub _inet_addr { unpack "N*", inet_aton( $_[0] ) }
+
 =back
 
 =head1 SEE ALSO

diff --git a/lib/Catalyst/Engine/HTTP/Restarter.pm b/lib/Catalyst/Engine/HTTP/Restarter.pm
index 56290b8..134e6be 100644 (file)
--- a/lib/Catalyst/Engine/HTTP/Restarter.pm
+++ b/lib/Catalyst/Engine/HTTP/Restarter.pm
@@ -14,31 +14,53 @@ sub run {
     # Setup restarter
     my $restarter;
     my $parent = $$;
-    
+
     unless ( $restarter = fork ) {
 
         # Prepare
         close STDIN;
         close STDOUT;
-        
+
         my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
             directory => File::Spec->catdir( $FindBin::Bin, '..' ),
             regex     => $options->{restart_regex},
             delay     => $options->{restart_delay},
         );
 
+        $host ||= '127.0.0.1';
         while (1) {
+
             # poll for changed files
             my @changed_files = $watcher->watch();
-            
+
             # check if our parent process has died
-            exit if ( getppid == 1 );            
-            
+            exit if $^O ne 'MSWin32' and getppid == 1;
+
             # Restart if any files have changed
-            if ( @changed_files ) {
+            if (@changed_files) {
                 my $files = join ', ', @changed_files;
                 print STDERR qq/File(s) "$files" modified, restarting\n\n/;
-                kill( 1, $parent );
+
+                require IO::Socket::INET;
+                require HTTP::Headers;
+                require HTTP::Request;
+
+                my $client = IO::Socket::INET->new(
+                    PeerAddr => $host,
+                    PeerPort => $port
+                  )
+                  or die "can't create client socket (is server running?): ",
+                  $!;
+
+                # build the Kill request
+                my $req =
+                  HTTP::Request->new( 'KILL', '/',
+                    HTTP::Headers->new( 'Connection' => 'close' ) );
+                $req->protocol('HTTP/1.0');
+
+                $client->send( $req->as_string )
+                  or die "can't send restart instruction: ", $!;
+                $client->close();
                 exit;
             }
         }