ircd/test/test-driver.pl

   1 #! /usr/bin/perl -wT
   2
   3 # If you edit this file, please check carefully that the garbage
   4 # collection isn't broken.  POE is sometimes too clever for our good
   5 # in finding references to sessions, and keeps running even after we
   6 # want to stop.
   7 # $Id: test-driver.pl,v 1.3 2005/05/31 00:26:19 entrope Exp $
   8
   9 # This interprets a simple scripting language.  Lines starting with a
  10 # hash mark (#, aka octothorpe, pound sign, etc) are ignored.  The
  11 # special commands look like this, where angle brackets indicate a
  12 # metavariable:
  13 #  define <macro> <value>
  14 #  undef <macro>
  15 #  connect <name> <nick> <ident> <server> :<userinfo>
  16 #  sync <name1>,<name2>[,<name3>]*
  17 #  :<name> <command>[ <args]*
  18 # For the last line syntax, <command> may be an IRC or IRC-like
  19 # command.  Supported non-IRC commands are:
  20 #  :<name> expect <source|*name2> [...]
  21 #  :<name> raw <text>
  22 #  :<name> sleep <seconds>
  23 #  :<name> wait <name2>
  24
  25 require 5.006;
  26
  27 use bytes;
  28 use warnings;
  29 use strict;
  30 use vars;
  31 use constant DELAY => 2;
  32 use constant EXPECT_TIMEOUT => 15;
  33 use constant RECONNECT_TIMEOUT => 5;
  34 use constant THROTTLED_TIMEOUT => 90;
  35
  36 use FileHandle;
  37 use POE;
  38 use POE::Component::IRC;
  39
  40 # this defines commands that take "zero time" to execute
  41 # (specifically, those which do not send commands from the issuing
  42 # client to the server)
  43 our $zero_time = {
  44                   expect => 1,
  45                   sleep => 1,
  46                   wait => 1,
  47                  };
  48
  49 # Create the main session and start POE.
  50 # All the empty anonymous subs are just to make POE:Session::ASSERT_STATES happy.
  51 POE::Session->create(inline_states =>
  52                      {
  53                       # POE kernel interaction
  54                       _start => \&drv_start,
  55                       _child => sub {},
  56                       _stop => sub {
  57                         my $heap = $_[HEAP];
  58                         print "\nThat's all, folks!";
  59                         print "(exiting at line $heap->{lineno}: $heap->{line})"
  60                           if $heap->{line};
  61                         print "\n";
  62                       },
  63                       _default => \&drv_default,
  64                       # generic utilities or miscellaneous functions
  65                       heartbeat => \&drv_heartbeat,
  66                       timeout_expect => \&drv_timeout_expect,
  67                       reconnect => \&drv_reconnect,
  68                       enable_client => sub { $_[ARG0]->{ready} = 1; },
  69                       disable_client => sub { $_[ARG0]->{ready} = 0; },
  70                       die => sub { $_[KERNEL]->signal($_[SESSION], 'TERM'); },
  71                       # client-based command issuers
  72                       cmd_die => \&cmd_generic,
  73                       cmd_expect => \&cmd_expect,
  74                       cmd_invite => \&cmd_generic,
  75                       cmd_join => \&cmd_generic,
  76                       cmd_mode => \&cmd_generic,
  77                       cmd_nick => \&cmd_generic,
  78                       cmd_notice => \&cmd_message,
  79                       cmd_oper => \&cmd_generic,
  80                       cmd_part => \&cmd_generic,
  81                       cmd_privmsg => \&cmd_message,
  82                       cmd_quit => \&cmd_generic,
  83                       cmd_raw => \&cmd_raw,
  84                       cmd_sleep => \&cmd_sleep,
  85                       cmd_wait => \&cmd_wait,
  86                       # handlers for messages from IRC
  87                       irc_001 => \&irc_connected, # Welcome to ...
  88                       irc_snotice => sub {}, # notice from a server (anonymous/our uplink)
  89                       irc_notice => \&irc_notice, # NOTICE to self or channel
  90                       irc_msg => \&irc_msg, # PRIVMSG to self
  91                       irc_public => \&irc_public, # PRIVMSG to channel
  92                       irc_connected => sub {},
  93                       irc_ctcp_action => sub {},
  94                       irc_ctcp_ping => sub {},
  95                       irc_ctcp_time => sub {},
  96                       irc_ctcpreply_ping => sub {},
  97                       irc_ctcpreply_time => sub {},
  98                       irc_invite => \&irc_invite, # INVITE to channel
  99                       irc_join => sub {},
 100                       irc_kick => sub {},
 101                       irc_kill => sub {},
 102                       irc_mode => sub {},
 103                       irc_nick => sub {},
 104                       irc_part => sub {},
 105                       irc_ping => sub {},
 106                       irc_pong => sub {},
 107                       irc_rpong => sub {},
 108                       irc_quit => sub {},
 109                       irc_topic => sub {},
 110                       irc_plugin_add => sub {},
 111                       irc_error => \&irc_error,
 112                       irc_disconnected => \&irc_disconnected,
 113                       irc_socketerr => \&irc_socketerr,
 114                      },
 115                      args => [@ARGV]);
 116
 117 $| = 1;
 118 $poe_kernel->run();
 119 exit;
 120
 121 # Core/bookkeeping test driver functions
 122
 123 sub drv_start {
 124   my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
 125
 126   # initialize heap
 127   $heap->{clients} = {}; # session details, indexed by (short) session name
 128   $heap->{sessions} = {}; # session details, indexed by session ref
 129   $heap->{servers} = {}; # server addresses, indexed by short names
 130   $heap->{macros} = {}; # macros
 131
 132   # Parse arguments
 133   foreach my $arg (@_[ARG0..$#_]) {
 134     if ($arg =~ /^-D$/) {
 135       $heap->{irc_debug} = 1;
 136     } elsif ($arg =~ /^-V$/) {
 137       $heap->{verbose} = 1;
 138     } elsif ($arg =~ /^-vhost=(.*)$/) {
 139       $heap->{vhost} = $1;
 140     } else {
 141       die "Extra command-line argument $arg\n" if $heap->{script};
 142       $heap->{script} = new FileHandle($arg, 'r')
 143         or die "Unable to open $arg for reading: $!\n";
 144     }
 145   }
 146   die "No test name specified\n" unless $heap->{script};
 147
 148   # hook in to POE
 149   $kernel->alias_set('control');
 150   $kernel->yield('heartbeat');
 151 }
 152
 153 sub drv_heartbeat {
 154   my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
 155   my $script = $heap->{script};
 156   my $used = {};
 157   my $delay = DELAY;
 158
 159   while (1) {
 160     my ($line, $lineno);
 161     if ($heap->{line}) {
 162       $line = delete $heap->{line};
 163     } elsif (defined($line = <$script>)) {
 164       $heap->{lineno} = $.;
 165       print "." unless $heap->{irc_debug};
 166     } else {
 167       # close all connections
 168       foreach my $client (values %{$heap->{clients}}) {
 169         $kernel->call($client->{irc}, 'quit', "I fell off the end of my script");
 170         $client->{quitting} = 1;
 171       }
 172       # unalias the control session
 173       $kernel->alias_remove('control');
 174       # die in a few seconds
 175       $kernel->delay_set('die', 5);
 176       return;
 177     }
 178
 179     chomp $line;
 180     # ignore comments and blank lines
 181     next if $line =~ /^\#/ or $line !~ /\S/;
 182
 183     # expand any macros in the line
 184     $line =~ s/(?<=[^\\])%(\S+?)%/$heap->{macros}->{$1}
 185       or die "Use of undefined macro $1 at $heap->{lineno}\n"/eg;
 186     # remove any \-escapes
 187     $line =~ s/\\(.)/$1/g;
 188     # figure out the type of line
 189     if ($line =~ /^#/) {
 190       # comment, silently ignore it
 191     } elsif ($line =~ /^define (\S+) (.+)$/i) {
 192       # define a new macro
 193       $heap->{macros}->{$1} = $2;
 194     } elsif ($line =~ /^undef (\S+)$/i) {
 195       # remove the macro
 196       delete $heap->{macros}->{$1};
 197     } elsif ($line =~ /^connect (\S+) (\S+) (\S+) (\S+) :(.+)$/i) {
 198       # connect a new session (named $1) to server $4
 199       my ($name, $nick, $ident, $server, $userinfo, $port) = ($1, $2, $3, $4, $5, 6667);
 200       $server = $heap->{servers}->{$server} || $server;
 201       if ($server =~ /(.+):(\d+)/) {
 202         $server = $1;
 203         $port = $2;
 204       }
 205       die "Client with nick $nick already exists (line $heap->{lineno})" if $heap->{clients}->{$nick};
 206       my $alias = "client_$name";
 207       POE::Component::IRC->new($alias)
 208           or die "Unable to create new user $nick (line $heap->{lineno}): $!";
 209       my $client = { name => $name,
 210                      nick => $nick,
 211                      ready => 0,
 212                      expect => [],
 213                      expect_alarms => [],
 214                      irc => $kernel->alias_resolve($alias),
 215                      params => { Nick     => $nick,
 216                                  Server   => $server,
 217                                  Port     => $port,
 218                                  Username => $ident,
 219                                  Ircname  => $userinfo,
 220                                  Debug    => $heap->{irc_debug},
 221                                }
 222                    };
 223       $client->params->{LocalAddr} = $heap->{vhost}
 224         if $heap->{vhost};
 225       $heap->{clients}->{$client->{name}} = $client;
 226       $heap->{sessions}->{$client->{irc}} = $client;
 227       $kernel->call($client->{irc}, 'register', 'all');
 228       $kernel->call($client->{irc}, 'connect', $client->{params});
 229       $used->{$name} = 1;
 230     } elsif ($line =~ /^sync (.+)$/i) {
 231       # do multi-way synchronization between every session named in $1
 232       my @synced = split(/,|\s/, $1);
 233       # first, check that they exist and are ready
 234       foreach my $clnt (@synced) {
 235         die "Unknown session name $clnt (line $heap->{lineno})" unless $heap->{clients}->{$clnt};
 236         goto REDO unless $heap->{clients}->{$clnt}->{ready};
 237       }
 238       # next we actually send the synchronization signals
 239       foreach my $clnt (@synced) {
 240         my $client = $heap->{clients}->{$clnt};
 241         $client->{sync_wait} = [map { $_ eq $clnt ? () : $heap->{clients}->{$_}->{nick} } @synced];
 242         $kernel->call($client->{irc}, 'notice', $client->{sync_wait}, 'SYNC');
 243         $kernel->call($session, 'disable_client', $client);
 244       }
 245     } elsif ($line =~ /^:(\S+) (\S+)(.*)$/i) {
 246       # generic command handler
 247       my ($names, $cmd, $args) = ($1, lc($2), $3);
 248       my (@avail, @unavail);
 249       # figure out whether each listed client is available or not
 250       foreach my $c (split ',', $names) {
 251         my $client = $heap->{clients}->{$c};
 252         if (not $client) {
 253           print "ERROR: Unknown session name $c (line $heap->{lineno}; ignoring)\n";
 254         } elsif (($used->{$c} and not $zero_time->{$cmd}) or not $client->{ready}) {
 255           push @unavail, $c;
 256         } else {
 257           push @avail, $c;
 258         }
 259       }
 260       # redo command with unavailable clients
 261       if (@unavail) {
 262         # This will break if the command can cause a redo for
 263         # available clients.. this should be fixed sometime
 264         $line = ':'.join(',', @unavail).' '.$cmd.$args;
 265         $heap->{redo} = 1;
 266       }
 267       # do command with available clients
 268       if (@avail) {
 269         # split up the argument part of the line
 270         $args =~ /^((?:(?: [^:])|[^ ])+)?(?: :(.+))?$/;
 271         $args = [($1 ? split(' ', $1) : ()), ($2 ? $2 : ())];
 272         # find the client and figure out if we need to wait
 273         foreach my $c (@avail) {
 274           my $client = $heap->{clients}->{$c};
 275           die "Client $c used twice as source (line $heap->{lineno})" if $used->{c} and not $zero_time->{$cmd};
 276           $kernel->call($session, 'cmd_'.$cmd, $client, $args);
 277           $used->{$c} = 1 unless $zero_time->{$cmd};
 278         }
 279       }
 280     } else {
 281       die "Unrecognized input line $heap->{lineno}: $line";
 282     }
 283     if ($heap->{redo}) {
 284     REDO:
 285       delete $heap->{redo};
 286       $heap->{line} = $line;
 287       last;
 288     }
 289   }
 290   # issue new heartbeat with appropriate delay
 291   $kernel->delay_set('heartbeat', $delay);
 292 }
 293
 294 sub drv_timeout_expect {
 295   my ($kernel, $session, $client) = @_[KERNEL, SESSION, ARG0];
 296   print "ERROR: Dropping timed-out expectation by $client->{name}: ".join(',', @{$client->{expect}->[0]})."\n";
 297   $client->{expect_alarms}->[0] = undef;
 298   unexpect($kernel, $session, $client);
 299 }
 300
 301 sub drv_reconnect {
 302   my ($kernel, $session, $client) = @_[KERNEL, SESSION, ARG0];
 303   $kernel->call($client->{irc}, 'connect', $client->{params});
 304 }
 305
 306 sub drv_default {
 307   my ($kernel, $heap, $sender, $session, $state, $args) = @_[KERNEL, HEAP, SENDER, SESSION, ARG0, ARG1];
 308   if ($state =~ /^irc_(\d\d\d)$/) {
 309     my $client = $heap->{sessions}->{$sender};
 310     if (@{$client->{expect}}
 311         and $args->[0] eq $client->{expect}->[0]->[0]
 312         and $client->{expect}->[0]->[1] eq "$1") {
 313       my $expect = $client->{expect}->[0];
 314       my $mismatch;
 315       for (my $x=2; ($x<=$#$expect) and ($x<=$#$args) and not $mismatch; $x++) {
 316         $mismatch = 1 unless $args->[$x] =~ /$expect->[$x]/i;
 317       }
 318       unexpect($kernel, $session, $client) unless $mismatch;
 319     }
 320     return undef;
 321   }
 322   print "ERROR: Unexpected event $state to test driver (from ".$sender->ID.")\n"
 323     unless $state eq '_signal';
 324   return undef;
 325 }
 326
 327 # client-based command issuers
 328
 329 sub cmd_message {
 330   my ($kernel, $heap, $event, $client, $args) = @_[KERNEL, HEAP, STATE, ARG0, ARG1];
 331   die "Missing arguments" unless $#$args >= 1;
 332   # translate each target as appropriate (e.g. *sessionname)
 333   my @targets = split(/,/, $args->[0]);
 334   foreach my $target (@targets) {
 335     if ($target =~ /^\*(.+)$/) {
 336       my $other = $heap->{clients}->{$1} or die "Unknown session name $1 (line $heap->{lineno})\n";
 337       $target = $other->{nick};
 338     }
 339   }
 340   $kernel->call($client->{irc}, substr($event, 4), \@targets, $args->[1]);
 341 }
 342
 343 sub cmd_generic {
 344   my ($kernel, $heap, $event, $client, $args) = @_[KERNEL, HEAP, STATE, ARG0, ARG1];
 345   $event =~ s/^cmd_//;
 346   $kernel->call($client->{irc}, $event, @$args);
 347 }
 348
 349 sub cmd_raw {
 350   my ($kernel, $heap, $client, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
 351   die "Missing argument" unless $#$args >= 0;
 352   $kernel->call($client->{irc}, 'sl', $args->[0]);
 353 }
 354
 355 sub cmd_sleep {
 356   my ($kernel, $session, $heap, $client, $args) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1];
 357   die "Missing argument" unless $#$args >= 0;
 358   $kernel->call($session, 'disable_client', $client);
 359   $kernel->delay_set('enable_client', $args->[0], $client);
 360 }
 361
 362 sub cmd_wait {
 363   my ($kernel, $session, $heap, $client, $args) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1];
 364   die "Missing argument" unless $#$args >= 0;
 365   # if argument was comma-delimited, split it up (space-delimited is split by generic parser)
 366   $args = [split(/,/, $args->[0])] if $args->[0] =~ /,/;
 367   # make sure we only wait if all the other clients are ready
 368   foreach my $other (@$args) {
 369     if (not $heap->{clients}->{$other}->{ready}) {
 370       $heap->{redo} = 1;
 371       return;
 372     }
 373   }
 374   # disable this client, make the others send SYNC to it
 375   $kernel->call($session, 'disable_client', $client);
 376   $client->{sync_wait} = [map { $heap->{clients}->{$_}->{nick} } @$args];
 377   foreach my $other (@$args) {
 378     die "Cannot wait on self" if $other eq $client->{name};
 379     $kernel->call($heap->{clients}->{$other}->{irc}, 'notice', $client->{nick}, 'SYNC');
 380   }
 381 }
 382
 383 sub cmd_expect {
 384   my ($kernel, $session, $heap, $client, $args) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1];
 385   die "Missing argument" unless $#$args >= 0;
 386   push @{$client->{expect}}, $args;
 387   push @{$client->{expect_alarms}}, $kernel->delay_set('timeout_expect', EXPECT_TIMEOUT, $client);
 388   $kernel->call($session, 'disable_client', $client);
 389 }
 390
 391 # handlers for messages from IRC
 392
 393 sub unexpect {
 394   my ($kernel, $session, $client) = @_;
 395   shift @{$client->{expect}};
 396   my $alarm_id = shift @{$client->{expect_alarms}};
 397   $kernel->alarm_remove($alarm_id) if $alarm_id;
 398   $kernel->call($session, 'enable_client', $client) unless @{$client->{expect}};
 399 }
 400
 401 sub check_expect {
 402   my ($kernel, $session, $heap, $poe_sender, $sender, $text) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1];
 403   my $client = $heap->{sessions}->{$poe_sender};
 404   my $expected = $client->{expect}->[0];
 405
 406   # check sender
 407   if ($expected->[0] =~ /\*(.+)/) {
 408     # we expect *sessionname, so look up session's current nick
 409     my $exp = $1;
 410     $sender =~ /^(.+)!/;
 411     return 0 if lc($heap->{clients}->{$exp}->{nick}) ne lc($1);
 412   } elsif ($expected->[0] =~ /^:?(.+!.+)/) {
 413     # expect :nick!user@host, so compare whole thing
 414     return 0 if lc($1) ne lc($sender);
 415   } else {
 416     # we only expect :nick, so compare that part
 417     $sender =~ /^:?(.+)!/;
 418     return 0 if lc($expected->[0]) ne lc($1);
 419   }
 420
 421   # compare text
 422   return 0 if lc($text) !~ /$expected->[2]/i;
 423
 424   # drop expectation of event
 425   unexpect($kernel, $session, $client);
 426 }
 427
 428 sub irc_connected {
 429   my ($kernel, $session, $heap, $sender) = @_[KERNEL, SESSION, HEAP, SENDER];
 430   my $client = $heap->{sessions}->{$sender};
 431   print "Client $client->{name} connected to server $_[ARG0]\n" if $heap->{verbose};
 432   $kernel->call($session, 'enable_client', $client);
 433 }
 434
 435 sub irc_disconnected {
 436   my ($kernel, $session, $heap, $sender, $server) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0];
 437   my $client = $heap->{sessions}->{$sender};
 438   print "Client $client->{name} disconnected from server $_[ARG0]\n" if $heap->{verbose};
 439   if ($client->{quitting}) {
 440     $kernel->call($sender, 'unregister', 'all');
 441     delete $heap->{sessions}->{$sender};
 442     delete $heap->{clients}->{$client->{name}};
 443   } else {
 444     if ($client->{disconnect_expected}) {
 445       delete $client->{disconnect_expected};
 446     } else {
 447       print "Got unexpected disconnect for $client->{name} (nick $client->{nick})\n";
 448     }
 449     $kernel->call($session, 'disable_client', $client);
 450     $kernel->delay_set('reconnect', $client->{throttled} ? THROTTLED_TIMEOUT : RECONNECT_TIMEOUT, $client);
 451     delete $client->{throttled};
 452   }
 453 }
 454
 455 sub irc_socketerr {
 456   my ($kernel, $session, $heap, $sender, $msg) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0];
 457   my $client = $heap->{sessions}->{$sender};
 458   print "Client $client->{name} (re-)connect error: $_[ARG0]\n";
 459   if ($client->{quitting}) {
 460     $kernel->call($sender, 'unregister', 'all');
 461     delete $heap->{sessions}->{$sender};
 462     delete $heap->{clients}->{$client->{name}};
 463   } else {
 464     if ($client->{disconnect_expected}) {
 465       delete $client->{disconnect_expected};
 466     } else {
 467       print "Got unexpected disconnect for $client->{name} (nick $client->{nick})\n";
 468     }
 469     $kernel->call($session, 'disable_client', $client);
 470     $kernel->delay_set('reconnect', $client->{throttled} ? THROTTLED_TIMEOUT : RECONNECT_TIMEOUT, $client);
 471     delete $client->{throttled};
 472   }
 473 }
 474
 475 sub irc_notice {
 476   my ($kernel, $session, $heap, $sender, $from, $to, $text) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1, ARG2];
 477   my $client = $heap->{sessions}->{$sender};
 478   if ($client->{sync_wait} and $text eq 'SYNC') {
 479     $from =~ s/!.+$//;
 480     my $x;
 481     # find who sent it..
 482     for ($x=0; $x<=$#{$client->{sync_wait}}; $x++) {
 483       last if $from eq $client->{sync_wait}->[$x];
 484     }
 485     # exit if we don't expect them
 486     if ($x>$#{$client->{sync_wait}}) {
 487       print "Got unexpected SYNC from $from to $client->{name} ($client->{nick})\n";
 488       return;
 489     }
 490     # remove from the list of people we're waiting for
 491     splice @{$client->{sync_wait}}, $x, 1;
 492     # re-enable client if we're done waiting
 493     if ($#{$client->{sync_wait}} == -1) {
 494       delete $client->{sync_wait};
 495       $kernel->call($session, 'enable_client', $client);
 496     }
 497   } elsif (@{$client->{expect}}
 498            and $client->{expect}->[0]->[1] =~ /notice/i) {
 499     check_expect(@_[0..ARG0], $text);
 500   }
 501 }
 502
 503 sub irc_msg {
 504   my ($kernel, $session, $heap, $sender, $from, $to, $text) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1, ARG2];
 505   my $client = $heap->{sessions}->{$sender};
 506   if (@{$client->{expect}}
 507       and $client->{expect}->[0]->[1] =~ /msg/i) {
 508     check_expect(@_[0..ARG0], $text);
 509   }
 510 }
 511
 512 sub irc_public {
 513   my ($kernel, $session, $heap, $sender, $from, $to, $text) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1, ARG2];
 514   my $client = $heap->{sessions}->{$sender};
 515   if (@{$client->{expect}}
 516       and $client->{expect}->[0]->[1] =~ /public/i
 517       and grep($client->{expect}->[0]->[2], @$to)) {
 518     splice @{$client->{expect}->[0]}, 2, 1;
 519     check_expect(@_[0..ARG0], $text);
 520   }
 521 }
 522
 523 sub irc_invite {
 524   my ($kernel, $session, $heap, $sender, $from, $to) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1, ARG2];
 525   my $client = $heap->{sessions}->{$sender};
 526   if (ref $client->{expect} eq 'ARRAY'
 527       and $client->{expect}->[0]->[1] =~ /invite/i
 528       and $to =~ /$client->{expect}->[0]->[2]/) {
 529     check_expect(@_[0..ARG0], $to);
 530   }
 531 }
 532
 533 sub irc_error {
 534   my ($kernel, $session, $heap, $sender, $what) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0];
 535   my $client = $heap->{sessions}->{$sender};
 536   if (@{$client->{expect}}
 537       and $client->{expect}->[0]->[1] =~ /error/i) {
 538     splice @{$client->{expect}->[0]}, 2, 1;
 539     unexpect($kernel, $session, $client);
 540     $client->{disconnect_expected} = 1;
 541   } else {
 542     print "ERROR: From server to $client->{name}: $what\n";
 543   }
 544   $client->{throttled} = 1 if $what =~ /throttled/i;
 545 }