Return to ras-load CVS log

Up to [Coherent Logic Development] / RasLoadTester

Increase heartbeat response failure threshold from 5 to 60 secs

#!/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: 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()