Return to ras-load CVS log

Up to [Coherent Logic Development] / RasLoadTester

Increase heartbeat response failure threshold from 5 to 60 secs

    1: #!/usr/bin/env perl
    2: 
    3: # 
    4: # ChivaNet Load Tester
    5: #  Copyright (C) 2025 Coherent Logic Development LLC
    6: #
    7: # Author: Serena Willis <snw@coherent-logic.com>
    8: #
    9: # Licensed AGPL-3.0
   10: #
   11: #   $Log: ras-load,v $
   12: #   Revision 1.3  2025/02/09 03:28:53  snw
   13: #   Increase heartbeat response failure threshold from 5 to 60 secs
   14: #
   15: #   Revision 1.2  2025/02/09 03:04:35  snw
   16: #   Add heartbeat
   17: #
   18: #
   19: #
   20: 
   21: 
   22: use Net::OSCAR;
   23: use Getopt::Long;
   24: 
   25: my $bot_version = "0.0.1";
   26: my $botsn = '';
   27: my $botct = 1;
   28: my $botno = 0;
   29: my $oscar = '';
   30: my $online = 0;
   31: my $room = '';
   32: my %signon = ();
   33: my $ticks = 0;
   34: my $heartbeat = time();
   35: my $hbchk_pending = 0;
   36: 
   37: sub signon_done
   38: {
   39:     my ($oscar) = @_;
   40:     
   41:     print "$botsn:  signon done\n";
   42:     $online = 1;
   43:     $oscar->chat_join("General", 5);    
   44: }
   45: 
   46: sub chat_joined
   47: {
   48:     my($oscar, $chatname, $chat) = @_;
   49: 
   50:     $room = $chat;
   51:     
   52:     print "$botsn:  chat joined\n";
   53: }
   54: 
   55: sub chat_im_in
   56: {
   57: 
   58: }
   59: 
   60: sub im_in
   61: {
   62:     my($oscar, $sender, $message, $is_away) = @_;
   63:     
   64:     if($message eq "ltping") {
   65:         $oscar->send_im($sender, "ltpong");     
   66:     }
   67:     elsif($message eq "ltpong") {
   68:         print "$botsn:  heartbeat OK\n";
   69:         $heartbeat = time();
   70:         $hbchk_pending = 0;
   71:     }
   72: }
   73: 
   74: sub oscar_error
   75: {
   76:     my($oscar, $connection, $error, $description, $fatal) = @_;
   77: 
   78:     if($fatal != 0) {
   79:         die "$botsn:  fatal OSCAR error:  $description\n";       
   80:     }
   81:     else {
   82:         print "$botsn:  recoverable OSCAR error: $description\n";
   83:     }
   84: }
   85: 
   86: sub simulate_load
   87: {
   88:     my @services = ('im', 'chat', 'dice');    
   89:     my $tgtno = 0 + int(rand(($botct + 1) - 0));
   90:     my $tgtsn = "ldtest$tgtno";
   91: 
   92:     my $tgtsvc = $services[rand @services];
   93:     
   94:     if($tgtsvc eq "im") {
   95:         $oscar->send_im($tgtsn, "load test message");
   96:     }
   97:     elsif($tgtsvc eq "chat") {
   98:         if(ref($room) eq "Net::OSCAR::Connection::Chat") {
   99:             $room->chat_send("load test message");            
  100:         }
  101:     }
  102:     elsif($tgtsvc eq 'dice') {
  103:         if(ref($room) eq "Net::OSCAR::Connection::Chat") {
  104:             $room->chat_send("//roll-dice15-sides999");
  105:         }
  106:     }
  107:     $ticks = $ticks + 1;
  108: 
  109:     if($ticks > 20) {
  110:         $heartbeat = time();
  111:         $oscar->send_im($botsn, "ltping");
  112:         print "$botsn:  heartbeat check\n";
  113:         $hbchk_pending = 1;
  114:         $ticks = 0;
  115:     }
  116: 
  117:     if($hbchk_pending == 1) {
  118:         if(time() - $heartbeat > 60) {
  119:             die "$botsn:  heartbeat check FAILED; bot terminating\n";
  120:         }
  121:     }
  122:     
  123:     sleep 1
  124: }
  125: 
  126: sub main
  127: {
  128:     my $botpw = '';
  129:     my $botsrv = '';
  130:     
  131:     GetOptions("botno=n" => \$botno,
  132:                "botct=n" => \$botct,
  133:                "aimpw=s" => \$botpw,
  134:                "aimhost=s" => \$botsrv)
  135:         or die("error in command line arguments");
  136: 
  137:     $botsn = "lt$botno\pr$$";
  138:     
  139:     %signon = (
  140:         screenname => $botsn,
  141:         password => $botpw,
  142:         host => $botsrv,
  143:         ); 
  144: 
  145:     $oscar = Net::OSCAR->new();
  146:     my $realno = $botno + 1;
  147:     
  148:     print "$botsn: $realno of $botct on host $botsrv\n";   
  149:     
  150:     $oscar->set_callback_signon_done(\&signon_done);
  151:     $oscar->set_callback_chat_joined(\&chat_joined);
  152:     $oscar->set_callback_chat_im_in(\&chat_im_in);
  153:     $oscar->set_callback_im_in(\&im_in);
  154:     $oscar->set_callback_error(\&oscar_error);
  155:     $oscar->signon(%signon);
  156: 
  157:     while(1) {
  158:         $oscar->do_one_loop();
  159:         if($online == 1) {
  160:             simulate_load();
  161:         }        
  162:     }
  163: }
  164: 
  165: main()
  166: