|
|
| version 1.1.1.1, 2025/02/08 23:09:15 | version 1.3, 2025/02/09 03:28:53 |
|---|---|
| Line 1 | Line 1 |
| #!/usr/bin/env perl | #!/usr/bin/env perl |
| # | |
| # ChivaNet Load Tester | |
| # Copyright (C) 2025 Coherent Logic Development LLC | |
| # | |
| # Author: Serena Willis <snw@coherent-logic.com> | |
| # | |
| # Licensed AGPL-3.0 | |
| # | |
| # $Log$ | |
| # Revision 1.3 2025/02/09 03:28:53 snw | |
| # Increase heartbeat response failure threshold from 5 to 60 secs | |
| # | |
| # Revision 1.2 2025/02/09 03:04:35 snw | |
| # Add heartbeat | |
| # | |
| # | |
| # | |
| use Net::OSCAR; | use Net::OSCAR; |
| use Getopt::Long; | use Getopt::Long; |
| Line 10 my $botno = 0; | Line 29 my $botno = 0; |
| my $oscar = ''; | my $oscar = ''; |
| my $online = 0; | my $online = 0; |
| my $room = ''; | my $room = ''; |
| my %signon = (); | |
| my $ticks = 0; | |
| my $heartbeat = time(); | |
| my $hbchk_pending = 0; | |
| sub signon_done | sub signon_done |
| { | { |
| Line 37 sub chat_im_in | Line 60 sub chat_im_in |
| sub im_in | sub im_in |
| { | { |
| my($oscar, $sender, $message, $is_away) = @_; | my($oscar, $sender, $message, $is_away) = @_; |
| print "$botsn: message received from $sender\n"; | |
| if($message eq "ltping") { | |
| $oscar->send_im($sender, "ltpong"); | |
| } | |
| elsif($message eq "ltpong") { | |
| print "$botsn: heartbeat OK\n"; | |
| $heartbeat = time(); | |
| $hbchk_pending = 0; | |
| } | |
| } | } |
| sub oscar_error | sub oscar_error |
| Line 45 sub oscar_error | Line 76 sub oscar_error |
| my($oscar, $connection, $error, $description, $fatal) = @_; | my($oscar, $connection, $error, $description, $fatal) = @_; |
| if($fatal != 0) { | if($fatal != 0) { |
| print "$botsn: fatal OSCAR error: $description\n"; | die "$botsn: fatal OSCAR error: $description\n"; |
| } | } |
| else { | else { |
| print "$botsn: recoverable OSCAR error: $description\n"; | print "$botsn: recoverable OSCAR error: $description\n"; |
| Line 73 sub simulate_load | Line 104 sub simulate_load |
| $room->chat_send("//roll-dice15-sides999"); | $room->chat_send("//roll-dice15-sides999"); |
| } | } |
| } | } |
| sleep 1; | $ticks = $ticks + 1; |
| if($ticks > 20) { | |
| $heartbeat = time(); | |
| $oscar->send_im($botsn, "ltping"); | |
| print "$botsn: heartbeat check\n"; | |
| $hbchk_pending = 1; | |
| $ticks = 0; | |
| } | |
| if($hbchk_pending == 1) { | |
| if(time() - $heartbeat > 60) { | |
| die "$botsn: heartbeat check FAILED; bot terminating\n"; | |
| } | |
| } | |
| sleep 1 | |
| } | } |
| sub main | sub main |
| Line 88 sub main | Line 134 sub main |
| "aimhost=s" => \$botsrv) | "aimhost=s" => \$botsrv) |
| or die("error in command line arguments"); | or die("error in command line arguments"); |
| $botsn = "ldtest$botno"; | $botsn = "lt$botno\pr$$"; |
| my %signon = ( | %signon = ( |
| screenname => $botsn, | screenname => $botsn, |
| password => $botpw, | password => $botpw, |
| host => $botsrv, | host => $botsrv, |
| Line 112 sub main | Line 158 sub main |
| $oscar->do_one_loop(); | $oscar->do_one_loop(); |
| if($online == 1) { | if($online == 1) { |
| simulate_load(); | simulate_load(); |
| } | } |
| } | } |
| } | } |