#!/usr/bin/env perl # # ChivaNet Load Tester # Copyright (C) 2025 Coherent Logic Development LLC # # Author: Serena Willis # # Licensed AGPL-3.0 # # $Log: ras-load,v $ # 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 Getopt::Long; my $bot_version = "0.0.1"; my $botsn = ''; my $botct = 1; my $botno = 0; my $oscar = ''; my $online = 0; my $room = ''; my %signon = (); my $ticks = 0; my $heartbeat = time(); my $hbchk_pending = 0; sub signon_done { my ($oscar) = @_; print "$botsn: signon done\n"; $online = 1; $oscar->chat_join("General", 5); } sub chat_joined { my($oscar, $chatname, $chat) = @_; $room = $chat; print "$botsn: chat joined\n"; } sub chat_im_in { } sub im_in { my($oscar, $sender, $message, $is_away) = @_; 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 { my($oscar, $connection, $error, $description, $fatal) = @_; if($fatal != 0) { die "$botsn: fatal OSCAR error: $description\n"; } else { print "$botsn: recoverable OSCAR error: $description\n"; } } sub simulate_load { my @services = ('im', 'chat', 'dice'); my $tgtno = 0 + int(rand(($botct + 1) - 0)); my $tgtsn = "ldtest$tgtno"; my $tgtsvc = $services[rand @services]; if($tgtsvc eq "im") { $oscar->send_im($tgtsn, "load test message"); } elsif($tgtsvc eq "chat") { if(ref($room) eq "Net::OSCAR::Connection::Chat") { $room->chat_send("load test message"); } } elsif($tgtsvc eq 'dice') { if(ref($room) eq "Net::OSCAR::Connection::Chat") { $room->chat_send("//roll-dice15-sides999"); } } $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 { my $botpw = ''; my $botsrv = ''; GetOptions("botno=n" => \$botno, "botct=n" => \$botct, "aimpw=s" => \$botpw, "aimhost=s" => \$botsrv) or die("error in command line arguments"); $botsn = "lt$botno\pr$$"; %signon = ( screenname => $botsn, password => $botpw, host => $botsrv, ); $oscar = Net::OSCAR->new(); my $realno = $botno + 1; print "$botsn: $realno of $botct on host $botsrv\n"; $oscar->set_callback_signon_done(\&signon_done); $oscar->set_callback_chat_joined(\&chat_joined); $oscar->set_callback_chat_im_in(\&chat_im_in); $oscar->set_callback_im_in(\&im_in); $oscar->set_callback_error(\&oscar_error); $oscar->signon(%signon); while(1) { $oscar->do_one_loop(); if($online == 1) { simulate_load(); } } } main()