[Rt-commit] rt branch, 4.0/parallel-test-race, created. rt-4.0.1rc1-8-ge3d23b8

[Alex Vandiver]

The branch, 4.0/parallel-test-race has been created
        at  e3d23b8cd0be091f9e27909ee89a70bf5d2a9142 (commit)

- Log -----------------------------------------------------------------
commit e3d23b8cd0be091f9e27909ee89a70bf5d2a9142
Author: Alex Vandiver <alexmv at bestpractical.com>
Date:   Tue Jun 7 15:45:23 2011 -0400

    Use a locked file to eliminate race conditions when picking a port and db name
    
    The previous method of picking a random port and testing if it was
    unused failed under high concurrency, as there is a large gap between
    when the port is checked for availability and when the server is started
    to claim it.  This is particularly important because (in parallel
    testing) the database name is based on the port, so failures show up
    even if there is no server started in the test, as the computed database
    names conflict.
    
    Thus, provide a flock()-protected file which provides a list of ports
    which we know to have claimed, as _well_ as checking the port for being
    already bound.  This provides a stronger requirement for the race
    condition to be met.

diff --git a/lib/RT/Test.pm b/lib/RT/Test.pm
index b468aae..e5d18bd 100644
--- a/lib/RT/Test.pm
+++ b/lib/RT/Test.pm
@@ -60,8 +60,6 @@ use File::Path qw(mkpath);
 use File::Spec;
 
 our @EXPORT = qw(is_empty diag parse_mail works fails);
-our ($port, $dbname);
-our @SERVERS;
 
 my %tmp = (
     directory => undef,
@@ -93,26 +91,8 @@ problem in Perl that hides the top-level optree from L<Devel::Cover>.
 
 =cut
 
-sub generate_port {
-    my $self = shift;
-    my $port = 1024 + int rand(10000) + $$ % 1024;
-
-    my $paddr = sockaddr_in( $port, inet_aton('localhost') );
-    socket( SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp') )
-      or die "socket: $!";
-    if ( connect( SOCK, $paddr ) ) {
-        close(SOCK);
-        return generate_port();
-    }
-    close(SOCK);
-
-    return $port;
-}
-
-BEGIN {
-    $port   = generate_port();
-    $dbname = $ENV{RT_TEST_PARALLEL}? "rt4test_$port" : "rt4test";
-};
+our $port;
+our @SERVERS;
 
 sub import {
     my $class = shift;
@@ -137,6 +117,8 @@ sub import {
 
     $class->bootstrap_tempdir;
 
+    $class->bootstrap_port;
+
     $class->bootstrap_plugins_paths( %args );
 
     $class->bootstrap_config( %args );
@@ -208,6 +190,49 @@ sub db_requires_no_dba {
     return 1 if $db_type eq 'SQLite';
 }
 
+sub bootstrap_port {
+    my $class = shift;
+
+    my %ports;
+
+    # Determine which ports are in use
+    use Fcntl qw(:DEFAULT :flock);
+    sysopen(PORTS, "t/tmp/ports", O_RDWR|O_CREAT)
+        or die "Can't write to ports file: $!";
+    flock(PORTS, LOCK_EX)
+        or die "Can't write-lock ports file: $!";
+    $ports{$_}++ for split ' ', join("",<PORTS>);
+
+    # Pick a random port, checking that the port isn't in our in-use
+    # list, and that something isn't already listening there.
+    {
+        $port = 1024 + int rand(10_000) + $$ % 1024;
+        redo if $ports{$port};
+
+        # There is a race condition in here, where some non-RT::Test
+        # process claims the port after we check here but before our
+        # server binds.  However, since we mostly care about race
+        # conditions with ourselves under high concurrency, this is
+        # generally good enough.
+        my $paddr = sockaddr_in( $port, inet_aton('localhost') );
+        socket( SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp') )
+            or die "socket: $!";
+        if ( connect( SOCK, $paddr ) ) {
+            close(SOCK);
+            redo;
+        }
+        close(SOCK);
+    }
+
+    $ports{$port}++;
+
+    # Write back out the in-use ports
+    seek(PORTS, 0, 0);
+    truncate(PORTS, 0);
+    print PORTS "$_\n" for sort {$a <=> $b} keys %ports;
+    close(PORTS) or die "Can't close ports file: $!";
+}
+
 sub bootstrap_tempdir {
     my $self = shift;
     my $test_file = (
@@ -231,6 +256,7 @@ sub bootstrap_config {
     open( my $config, '>', $tmp{'config'}{'RT'} )
         or die "Couldn't open $tmp{'config'}{'RT'}: $!";
 
+    my $dbname = $ENV{RT_TEST_PARALLEL}? "rt4test_$port" : "rt4test";
     print $config qq{
 Set( \$WebDomain, "localhost");
 Set( \$WebPort,   $port);
@@ -1446,6 +1472,22 @@ END {
     if ( $ENV{RT_TEST_PARALLEL} && $created_new_db ) {
         __drop_database();
     }
+
+    # Drop our port from t/tmp/ports; do this after dropping the
+    # database, as our port lock is also a lock on the database name.
+    if ($port) {
+        my %ports;
+        sysopen(PORTS, "t/tmp/ports", O_RDWR|O_CREAT)
+            or die "Can't write to ports file: $!";
+        flock(PORTS, LOCK_EX)
+            or die "Can't write-lock ports file: $!";
+        $ports{$_}++ for split ' ', join("",<PORTS>);
+        delete $ports{$port};
+        seek(PORTS, 0, 0);
+        truncate(PORTS, 0);
+        print PORTS "$_\n" for sort {$a <=> $b} keys %ports;
+        close(PORTS) or die "Can't close ports file: $!";
+    }
 }
 
 { 
diff --git a/t/fts/indexed_mysql.t b/t/fts/indexed_mysql.t
index f0395a5..8966f1c 100644
--- a/t/fts/indexed_mysql.t
+++ b/t/fts/indexed_mysql.t
@@ -25,7 +25,9 @@ ok $q && $q->id, 'loaded or created queue';
 my $queue = $q->Name;
 
 sub setup_indexing {
-    my $port = RT::Test->generate_port;
+    # Since we're not running a webserver in this test, use the
+    # known-safe port we determined at test setup
+    my $port = $RT::Test::port;
     my ($exit_code, $output) = RT::Test->run_and_capture(
         'no-ask'       => 1,
         command        => $RT::SbinPath .'/rt-setup-fulltext-index',

-----------------------------------------------------------------------