perl/tests/connection_manager.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 # Test the connection manager.
   7
   8 # When testing things that are based in time, it is necessary to be
   9 # able to manipulate the time for testing purposes.
  10 sub now {
  11     my $now = shift;
  12     $Thrasher::ConnectionManager::NOW = $now;
  13 }
  14
  15 use Test::More 'no_plan';
  16 use Test::Deep;
  17 use Data::Dumper;
  18
  19 use Time::HiRes qw(time);
  20
  21 BEGIN {
  22     use_ok 'Thrasher::Test', qw(:all);
  23     use_ok 'Thrasher::ConnectionManager', qw(:all);
  24     use_ok 'Thrasher::Component', qw(:all);
  25 }
  26
  27 DECAYABLES: {
  28     # Test that decayables work the way I think they should
  29     # Get the "base time" from time to make sure we can handle
  30     # it as we expect
  31     my $base_time = time;
  32
  33     now($base_time);
  34
  35     my $halfer = decayable(16, .5);
  36
  37     is($halfer->value, 16, "no decay means no decay");
  38     now($base_time + 60);
  39     is($halfer->value, 8, "decay after one minute as expected");
  40
  41     $halfer->add(24);
  42     is($halfer->value, 32, "can add as expected");
  43     now($base_time + 120);
  44     is($halfer->value, 16, "additions stick around and still decay.");
  45 }
  46
  47 my @scheduled;
  48 my $execution_count = 0;
  49
  50 BEHAVIOR: {
  51     $Thrasher::ConnectionManager::scheduler = sub {
  52         push @scheduled, \@_;
  53     };
  54
  55     my $closure = sub { $execution_count++; };
  56
  57     my $base_time = time;
  58     now($base_time);
  59
  60     my $previous_execution_count = 0;
  61     my $incremented = sub {
  62         my $desired = shift;
  63         my $message = shift;
  64
  65         is($execution_count - $previous_execution_count,
  66            $desired, $message);
  67
  68         $previous_execution_count = $execution_count;
  69     };
  70
  71     my $scheduler_advance = sub {
  72         my $advance = shift;
  73         now($base_time + $advance);
  74         $base_time = $base_time + $advance;
  75
  76         Thrasher::ConnectionManager::connection_executor();
  77     };
  78
  79     # First connection immediately executed
  80     request_connect($closure);
  81     $incremented->(1, 'immediately connected the first time');
  82     is($Thrasher::ConnectionManager::hammering->value,
  83        1, 'correctly recorded the hammering value');
  84
  85     for my $i (0..14) {
  86         request_connect($closure);
  87         $incremented->(1, 'still immediately connecting on attempt '
  88                        . ($i+2));
  89     }
  90
  91     # I'm saving this so I can eyeball the results of
  92     # running this, but it is not part of the test suite.
  93     EYEBALL_IT: {
  94         last EYEBALL_IT;
  95         request_connect($closure);
  96         request_connect($closure);
  97         request_connect($closure);
  98         request_connect($closure);
  99         request_connect($closure);
 100         request_connect($closure);
 101         request_connect($closure);
 102         request_connect($closure);
 103         request_connect($closure);
 104         $incremented->(0, "finally stopped immediately connecting");
 105
 106         is(scalar(@scheduled), 1,
 107            'only one scheduling call executed');
 108
 109         $scheduler_advance->(10);
 110         $incremented->(6, "we connected several times before 10 seconds went by.");
 111         is(scalar(@scheduled), 2, 'scheduled again');
 112
 113         request_connect($closure);
 114         request_connect($closure);
 115         is(scalar(@scheduled), 2, 'did not cause fresh schedule');
 116
 117         # This isn't a realistic test of the timing, but it tests
 118         # that connection_executor correctly does as much as it
 119         # can. This can arise in some circumstances.
 120         $scheduler_advance->(30);
 121         $incremented->(5, "we connected a lot since time went by");
 122
 123         $scheduler_advance->(100);
 124         $incremented->(0, "correctly flushed out the queue as expected");
 125         ok($Thrasher::ConnectionManager::hammering->value < .1,
 126            'sanity check on the hammering passes');
 127
 128         # Let's check the behavior of the connection success and failure.
 129         cmp_deeply(schedule_request, [0, 0],
 130                    'right now, we get immediate execution');
 131
 132         # Uh oh! Failure!
 133         connection_failure;
 134         my ($delay, $hammering) = @{schedule_request()};
 135         is($hammering, 0, 'not hammering');
 136         ok($delay < 15, 'not much delay');
 137
 138         $scheduler_advance->(1);
 139
 140         # Uh oh! A pattern of failure!
 141         connection_failure;
 142         ($delay, undef) = @{schedule_request()};
 143         ok($delay > 1, 'ready to panic');
 144
 145         $scheduler_advance->(1);
 146
 147         # And somebody made it through, strong evidence that everything
 148         # is working.
 149         connection_success;
 150         ($delay, undef) = @{schedule_request()};
 151         print "Delay: $delay\n";
 152
 153         $scheduler_advance->(1);
 154
 155         connection_success;
 156         ($delay, undef) = @{schedule_request()};
 157         print "Delay: $delay\n";
 158
 159         connection_success;
 160         $scheduler_advance->(5);
 161         ($delay, undef) = @{schedule_request()};
 162         print "Delay: $delay\n";
 163         connection_success;
 164         $scheduler_advance->(5);
 165         ($delay, undef) = @{schedule_request()};
 166         print "Delay: $delay\n";
 167         connection_success;
 168         $scheduler_advance->(5);
 169         ($delay, undef) = @{schedule_request()};
 170         print "Delay: $delay\n";
 171         connection_success;
 172         $scheduler_advance->(5);
 173         ($delay, undef) = @{schedule_request()};
 174         print "Delay: $delay\n";
 175         connection_success;
 176         $scheduler_advance->(5);
 177         ($delay, undef) = @{schedule_request()};
 178         print "Delay: $delay\n";
 179         connection_success;
 180         $scheduler_advance->(5);
 181         ($delay, undef) = @{schedule_request()};
 182         print "Delay: $delay\n";
 183         connection_success;
 184         $scheduler_advance->(5);
 185         ($delay, undef) = @{schedule_request()};
 186         print "Delay: $delay\n";
 187
 188         print "Connection cut\n\n\n";
 189         connection_failure;
 190         $scheduler_advance->(5);
 191         ($delay, undef) = @{schedule_request()};
 192         print "Delay: $delay\n";
 193         connection_failure;
 194         $scheduler_advance->(5);
 195         ($delay, undef) = @{schedule_request()};
 196         print "Delay: $delay\n";
 197         connection_failure;
 198         $scheduler_advance->(5);
 199         ($delay, undef) = @{schedule_request()};
 200         print "Delay: $delay\n";
 201         connection_failure;
 202         $scheduler_advance->(5);
 203         ($delay, undef) = @{schedule_request()};
 204         print "Delay: $delay\n";
 205         connection_failure;
 206         $scheduler_advance->(5);
 207         ($delay, undef) = @{schedule_request()};
 208         print "Delay: $delay\n";
 209         connection_success;
 210         $scheduler_advance->(5);
 211         ($delay, undef) = @{schedule_request()};
 212         print "Delay: $delay\n";
 213         connection_success;
 214         $scheduler_advance->(5);
 215         ($delay, undef) = @{schedule_request()};
 216         print "Delay: $delay\n";
 217         connection_success;
 218         $scheduler_advance->(5);
 219         ($delay, undef) = @{schedule_request()};
 220         print "Delay: $delay\n";
 221         connection_success;
 222         $scheduler_advance->(5);
 223         ($delay, undef) = @{schedule_request()};
 224         print "Delay: $delay\n";
 225
 226         print "Connection restored\n\n\n";
 227         $scheduler_advance->(5);
 228         ($delay, undef) = @{schedule_request()};
 229         print "Delay: $delay\n";
 230         connection_success;
 231         $scheduler_advance->(5);
 232         ($delay, undef) = @{schedule_request()};
 233         print "Delay: $delay\n";
 234         connection_success;
 235         $scheduler_advance->(5);
 236         ($delay, undef) = @{schedule_request()};
 237         print "Delay: $delay\n";
 238         connection_success;
 239         $scheduler_advance->(5);
 240         ($delay, undef) = @{schedule_request()};
 241         print "Delay: $delay\n";
 242         connection_success;
 243         $scheduler_advance->(5);
 244         ($delay, undef) = @{schedule_request()};
 245         print "Delay: $delay\n";
 246         connection_success;
 247         $scheduler_advance->(5);
 248         ($delay, undef) = @{schedule_request()};
 249         print "Delay: $delay\n";
 250         connection_success;
 251         $scheduler_advance->(5);
 252         ($delay, undef) = @{schedule_request()};
 253         print "Delay: $delay\n";
 254     }
 255 }
 256
 257 my $JID = transport_jid;
 258
 259 # Test the interaction with the component, in particular to
 260 # verify that the component outputs the expected presence tags.
 261 TEST_COMPONENT_INTERACTION: {
 262     my $comp = get_registered_comp;
 263     my $direct_connect =
 264         \$Thrasher::Component::WILL_BE_DIRECTLY_CONNECTED;
 265
 266     $$direct_connect = 0;
 267
 268     # Log in and verify we get a message about being delayed.
 269     $comp->xml_in(<<LOGIN);
 270 <presence from='romeo\@montague.lit/orchard'
 271           to='$JID'/>
 272 LOGIN
 273
 274     my $expected = clean_xml(<<EXPECTED);
 275 <presence from='test.transport'
 276           to='romeo\@montague.lit'
 277           type='unavailable'>
 278     <status>connection queued</status>
 279     <thrasher:connection-queued xmlns:thrasher='xmpp:x:thrasher:presence'/>
 280 </presence>
 281 EXPECTED
 282
 283     is($expected, output,
 284        "Connection correctly notifies the user that it is delayed");
 285 }