X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FHTTP.pm;h=37ed3a95d1e4eaf7863f1a494c4c22e278792adf;hb=1cf1c56a0c68611a361dbb8c797891baf6d0974f;hp=de1681b96d6b73394f9309788582d006af844bc0;hpb=4c980e7668ca115edb52d7ec19a8d769fc73532c;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm
index de1681b..37ed3a9 100644
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -3,9 +3,6 @@ package Catalyst::Engine::HTTP;
 use strict;
 use base 'Catalyst::Engine::CGI';
 use Errno 'EWOULDBLOCK';
-use FindBin;
-use File::Find;
-use File::Spec;
 use HTTP::Status;
 use NEXT;
 use Socket;
@@ -113,73 +110,26 @@ sub run {
 
     $options ||= {};
 
-    # Setup restarter
-    my $restarter;
-    if ( $options->{restart} ) {
-        my $parent = $$;
-        unless ( $restarter = fork ) {
-
-            # Prepare
-            close STDIN;
-            close STDOUT;
-
-            # Index parent directory
-            my $dir = File::Spec->catdir( $FindBin::Bin, '..' );
-
-            my $regex = $options->{restart_regex};
-            my $one   = _index( $dir, $regex );
-          RESTART: while (1) {
-                sleep $options->{restart_delay} || 1;
-                
-                # check if our parent has died
-                exit if ( getppid == 1 );
-                
-                my $two     = _index( $dir,         $regex );
-                my $changes = _compare_index( $one, $two );
-                if (@$changes) {
-                    $one = $two;
-
-                    # Test modified pm's
-                    for my $file (@$changes) {
-                        next unless $file =~ /\.pm$/;
-                        if ( my $error = _test($file) ) {
-                            print STDERR
-                              qq/File "$file" modified, not restarting\n\n/;
-                            print STDERR '*' x 80, "\n";
-                            print STDERR $error;
-                            print STDERR '*' x 80, "\n";
-                            next RESTART;
-                        }
-                    }
-
-                    # Restart
-                    my $files = join ', ', @$changes;
-                    print STDERR qq/"$files" modified, restarting\n\n/;
-                    kill( 1, $parent );
-                    exit;
-                }
-            }
-        }
-    }
-    
     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;
@@ -265,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 {
@@ -278,24 +241,10 @@ sub run {
     if ($GOT_HUP) {
         $SIG{CHLD} = 'DEFAULT';
         wait;
-        exec {$0}( ( ( -x $0 ) ? () : ($^X) ), $0, @{ $options->{argv} } );
+        exec $^X . ' "' . $0 . '" ' . join( ' ', @{ $options->{argv} } );
     }
 }
 
-sub _compare_index {
-    my ( $one, $two ) = @_;
-    my %clone = %$two;
-    my @changes;
-    while ( my ( $key, $val ) = each %$one ) {
-        if ( !$clone{$key} || ( $clone{$key} ne $val ) ) {
-            push @changes, $key;
-        }
-        delete $clone{$key};
-    }
-    for my $key ( keys %clone ) { push @changes, $key }
-    return \@changes;
-}
-
 sub _get_line {
     my ( $self, $handle ) = @_;
 
@@ -311,68 +260,7 @@ sub _get_line {
     return $line;
 }
 
-# The list of files/directories we check for modification
-our $file_index;
-
-sub _index {
-    my ( $dir, $regex ) = @_;
-    
-    if ( ref $file_index ) {
-        # don't run a File::Find, but just check file/dir mod times
-        my %index = %{$file_index};
-        foreach my $file ( keys %index ) {
-            if ( my @stat = stat $file ) {
-                $index{$file} = $stat[9];
-            }
-            else {
-                delete $index{$file};
-            }
-        }
-        return \%index;
-    }
-    else {
-        # first time, run a File::Find to locate files and dirs to watch
-        my $index = {};
-        finddepth(
-            {
-                wanted => sub {
-                    my $file = File::Spec->rel2abs($File::Find::name);
-                    $file =~ s{/script/..}{};
-                    return unless $file =~ /$regex/;
-                    return unless -f $file;
-                    $index->{$file} = ( stat $file )[9];
-                    
-                    # also watch the directory the file is in
-                    my $cur_dir = File::Spec->rel2abs($File::Find::dir);
-                    $cur_dir =~ s{/script/..}{};
-                    unless ( $index->{$cur_dir} ) {
-                        $index->{$cur_dir} = ( stat $cur_dir )[9];
-                    }
-                },
-                no_chdir => 1
-            },
-            $dir
-        );
-        $file_index = $index;
-        return $file_index;
-    }
-}
-
-sub _test {
-    my $file = shift;
-    delete $INC{$file};
-    
-    # if the file has been deleted, don't try to test it
-    return 0 unless -f $file;
-    
-    local $SIG{__WARN__} = sub { };
-    open my $olderr, '>&STDERR';
-    open STDERR, '>', File::Spec->devnull;
-    eval "require '$file'";
-    open STDERR, '>&', $olderr;
-    return $@ if $@;
-    return 0;
-}
+sub _inet_addr { unpack "N*", inet_aton( $_[0] ) }
 
 =back