t/optional_http-server-restart.t

   1 # This test tests the standalone server's auto-restart feature.
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 BEGIN {
   8     plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
   9 }
  10
  11 use File::Path;
  12 use FindBin;
  13 use LWP::Simple;
  14 use IO::Socket;
  15 use IPC::Open3;
  16 use Time::HiRes qw/sleep/;
  17 eval "use Catalyst::Devel 1.0;";
  18
  19 plan skip_all => 'Catalyst::Devel required' if $@;
  20 plan skip_all => 'Catalyst::Devel >= 1.04 required' if $Catalyst::Devel::VERSION <= 1.03;
  21 eval "use File::Copy::Recursive";
  22 plan skip_all => 'File::Copy::Recursive required' if $@;
  23
  24 plan tests => 120;
  25
  26 my $tmpdir = "$FindBin::Bin/../t/tmp";
  27
  28 # clean up
  29 rmtree $tmpdir if -d $tmpdir;
  30
  31 # create a TestApp and copy the test libs into it
  32 mkdir $tmpdir;
  33 chdir $tmpdir;
  34
  35 system( $^X, "-I$FindBin::Bin/../lib", "$FindBin::Bin/../script/catalyst.pl", 'TestApp' );
  36
  37 chdir "$FindBin::Bin/..";
  38 File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
  39
  40 # remove TestApp's tests
  41 rmtree 't/tmp/TestApp/t';
  42
  43 # spawn the standalone HTTP server
  44 my $port = 30000 + int rand( 1 + 10000 );
  45
  46 my( $server, $pid );
  47 $pid = open3( undef, $server, undef,
  48   $^X, "-I$FindBin::Bin/../lib",
  49   "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
  50   $port, '-restart' )
  51     or die "Unable to spawn standalone HTTP server: $!";
  52
  53 # switch to non-blocking reads so we can fail
  54 # gracefully instead of just hanging forever
  55
  56 $server->blocking( 0 );
  57
  58 # wait for it to start
  59 print "Waiting for server to start...\n";
  60 while ( check_port( 'localhost', $port ) != 1 ) {
  61     sleep 1;
  62 }
  63
  64 # change various files
  65 my @files = (
  66     "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",
  67     "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",
  68 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm",
  69 );
  70
  71 # change some files and make sure the server restarts itself
  72 NON_ERROR_RESTART:
  73 for ( 1 .. 20 ) {
  74     my $index = rand @files;
  75     open my $pm, '>>', $files[$index]
  76       or die "Unable to open $files[$index] for writing: $!";
  77     print $pm "\n";
  78     close $pm;
  79
  80     # give the server time to notice the change and restart
  81     my $count = 0;
  82     my $line;
  83
  84     while ( ( $line || '' ) !~ /can connect/ ) {
  85         # wait for restart message
  86         $line = $server->getline;
  87         sleep 0.1;
  88         if ( $count++ > 100 ) {
  89             fail "Server restarted";
  90             SKIP: {
  91                 skip "Server didn't restart, no sense in checking response", 1;
  92             }
  93             next NON_ERROR_RESTART;
  94         }
  95     };
  96     pass "Server restarted";
  97
  98     $count = 0;
  99     while ( check_port( 'localhost', $port ) != 1 ) {
 100         # wait for it to restart
 101         sleep 0.1;
 102         die "Server appears to have died" if $count++ > 100;
 103     }
 104     my $response = get("http://localhost:$port/action/default");
 105     like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
 106
 107     # give the server some time to reindex its files
 108     sleep 1;
 109 }
 110
 111 # add errors to the file and make sure server does not die or restart
 112 NO_RESTART_ON_ERROR:
 113 for ( 1 .. 20 ) {
 114     my $index = rand @files;
 115     open my $pm, '>>', $files[$index]
 116       or die "Unable to open $files[$index] for writing: $!";
 117     print $pm "bleh";
 118     close $pm;
 119
 120     my $count = 0;
 121     my $line;
 122
 123     while ( ( $line || '' ) !~ /failed/ ) {
 124         # wait for restart message
 125         $line = $server->getline;
 126         sleep 0.1;
 127         if ( $count++ > 100 ) {
 128             fail "Server restarted";
 129             SKIP: {
 130                 skip "Server didn't restart, no sense in checking response", 1;
 131             }
 132             next NO_RESTART_ON_ERROR;
 133         }
 134     };
 135
 136     pass "Server refused to restart";
 137
 138     if ( check_port( 'localhost', $port ) != 1 ) {
 139         die "Server appears to have died";
 140     }
 141     my $response = get("http://localhost:$port/action/default");
 142     like( $response, qr/Catalyst::Request/,
 143         'Syntax error, no restart, request OK' );
 144
 145     # give the server some time to reindex its files
 146     sleep 1;
 147
 148 }
 149
 150 # multiple restart directories
 151
 152 # we need different options so we have to rebuild most
 153 # of the testing environment
 154
 155 kill 'KILL', $pid;
 156 close $server;
 157
 158 # pick next port because the last one might still be blocked from
 159 # previous server. This might fail if this port is unavailable
 160 # but picking the first one has the same problem so this is acceptable
 161
 162 $port += 1;
 163
 164 { no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; }
 165 File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
 166
 167 # change various files
 168 @files = (
 169   "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",
 170   "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm",
 171 );
 172
 173 my $app_root = "$FindBin::Bin/../t/tmp/TestApp";
 174 my $restartdirs = join ' ', map{
 175     "-restartdirectory $app_root/lib/TestApp/Controller/$_"
 176 } qw/Action Engine/;
 177
 178 $pid = open3( undef, $server, undef,
 179   $^X, "-I$FindBin::Bin/../lib",
 180   "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
 181   $port, '-restart', $restartdirs )
 182     or die "Unable to spawn standalone HTTP server: $!";
 183 $server->blocking( 0 );
 184
 185
 186 # wait for it to start
 187 print "Waiting for server to start...\n";
 188 while ( check_port( 'localhost', $port ) != 1 ) {
 189     sleep 1;
 190 }
 191
 192 MULTI_DIR_RESTART:
 193 for ( 1 .. 20 ) {
 194     my $index = rand @files;
 195     open my $pm, '>>', $files[$index]
 196       or die "Unable to open $files[$index] for writing: $!";
 197     print $pm "\n";
 198     close $pm;
 199
 200     # give the server time to notice the change and restart
 201     my $count = 0;
 202     my $line;
 203
 204     while ( ( $line || '' ) !~ /can connect/ ) {
 205         # wait for restart message
 206         $line = $server->getline;
 207         sleep 0.1;
 208         if ( $count++ > 100 ) {
 209             fail "Server restarted";
 210             SKIP: {
 211                 skip "Server didn't restart, no sense in checking response", 1;
 212             }
 213             next MULTI_DIR_RESTART;
 214         }
 215     };
 216     pass "Server restarted with multiple restartdirs";
 217
 218     $count = 0;
 219     while ( check_port( 'localhost', $port ) != 1 ) {
 220         # wait for it to restart
 221         sleep 0.1;
 222         die "Server appears to have died" if $count++ > 100;
 223     }
 224     my $response = get("http://localhost:$port/action/default");
 225     like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
 226
 227     # give the server some time to reindex its files
 228     sleep 1;
 229 }
 230
 231 # shut it down again
 232
 233 kill 'KILL', $pid;
 234 close $server;
 235
 236 # clean up
 237 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
 238
 239 sub check_port {
 240     my ( $host, $port ) = @_;
 241
 242     my $remote = IO::Socket::INET->new(
 243         Proto    => "tcp",
 244         PeerAddr => $host,
 245         PeerPort => $port
 246     );
 247     if ($remote) {
 248         close $remote;
 249         return 1;
 250     }
 251     else {
 252         return 0;
 253     }
 254 }