2011-01-25 00:56:55 +01:00
|
|
|
# File: LagChecker.pm
|
|
|
|
# Author: pragma_
|
|
|
|
#
|
|
|
|
# Purpose: sends PING command to IRC server and times duration for PONG reply in
|
|
|
|
# order to maintain lag history and average.
|
|
|
|
|
2017-03-05 22:33:31 +01:00
|
|
|
# This Source Code Form is subject to the terms of the Mozilla Public
|
|
|
|
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
|
|
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
|
|
|
2011-01-25 00:56:55 +01:00
|
|
|
package PBot::LagChecker;
|
2020-02-15 23:38:32 +01:00
|
|
|
|
2020-02-08 20:04:13 +01:00
|
|
|
use parent 'PBot::Class';
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2020-02-08 20:04:13 +01:00
|
|
|
use warnings; use strict;
|
2019-07-11 03:40:53 +02:00
|
|
|
use feature 'unicode_strings';
|
2011-01-25 00:56:55 +01:00
|
|
|
|
|
|
|
use Time::HiRes qw(gettimeofday tv_interval);
|
|
|
|
use Time::Duration;
|
|
|
|
|
|
|
|
sub initialize {
|
2020-02-15 23:38:32 +01:00
|
|
|
my ($self, %conf) = @_;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
|
|
|
# average of entries in lag history, in seconds
|
|
|
|
$self->{lag_average} = undef;
|
|
|
|
|
|
|
|
# string representation of lag history and lag average
|
|
|
|
$self->{lag_string} = undef;
|
|
|
|
|
|
|
|
# history of previous PING/PONG timings
|
|
|
|
$self->{lag_history} = [];
|
|
|
|
|
|
|
|
# tracks pong replies; undef if no ping sent; 0 if ping sent but no pong reply yet; 1 if ping/pong completed
|
|
|
|
$self->{pong_received} = undef;
|
|
|
|
|
|
|
|
# when last ping was sent
|
|
|
|
$self->{ping_send_time} = undef;
|
2020-02-15 23:38:32 +01:00
|
|
|
|
|
|
|
# maximum number of lag history entries to retain
|
|
|
|
$self->{pbot}->{registry}->add_default('text', 'lagchecker', 'lag_history_max', $conf{lag_history_max} // 3);
|
|
|
|
|
|
|
|
# lagging is true if lag_average reaches or exceeds this threshold, in milliseconds
|
|
|
|
$self->{pbot}->{registry}->add_default('text', 'lagchecker', 'lag_threshold', $conf{lag_threshhold} // 2000);
|
|
|
|
|
|
|
|
# how often to send PING, in seconds
|
|
|
|
$self->{pbot}->{registry}->add_default('text', 'lagchecker', 'lag_history_interval', $conf{lag_history_interval} // 10);
|
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
# registry trigger for lag_history_interval changes
|
|
|
|
$self->{pbot}->{registry}->add_trigger('lagchecker', 'lag_history_interval', sub { $self->trigger_lag_history_interval(@_) });
|
2020-02-15 23:38:32 +01:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
# timer to send PINGs
|
2020-02-15 23:38:32 +01:00
|
|
|
$self->{pbot}->{timer}->register(
|
|
|
|
sub { $self->send_ping },
|
|
|
|
$self->{pbot}->{registry}->get_value('lagchecker', 'lag_history_interval'),
|
2020-03-06 22:28:06 +01:00
|
|
|
'lag check'
|
2020-02-15 23:38:32 +01:00
|
|
|
);
|
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
# lagcheck bot command
|
2020-05-04 22:21:35 +02:00
|
|
|
$self->{pbot}->{commands}->register(sub { $self->cmd_lagcheck(@_) }, "lagcheck", 0);
|
2021-06-05 22:20:03 +02:00
|
|
|
|
|
|
|
# PONG IRC handler
|
2020-02-15 23:38:32 +01:00
|
|
|
$self->{pbot}->{event_dispatcher}->register_handler('irc.pong', sub { $self->on_pong(@_) });
|
2011-01-25 00:56:55 +01:00
|
|
|
}
|
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
# registry trigger fires when value changes
|
|
|
|
sub trigger_lag_history_interval {
|
2020-02-15 23:38:32 +01:00
|
|
|
my ($self, $section, $item, $newvalue) = @_;
|
2020-03-06 22:28:06 +01:00
|
|
|
$self->{pbot}->{timer}->update_interval('lag check', $newvalue);
|
2014-05-19 12:30:25 +02:00
|
|
|
}
|
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
# lagcheck bot command
|
|
|
|
sub cmd_lagcheck {
|
|
|
|
my ($self, $context) = @_;
|
|
|
|
|
|
|
|
if (defined $self->{pong_received} and $self->{pong_received} == 0) {
|
|
|
|
# a ping has been sent (pong_received is not undef) and no pong has been received yet
|
|
|
|
my $elapsed = tv_interval($self->{ping_send_time});
|
|
|
|
my $lag_total = $elapsed;
|
|
|
|
my $len = @{$self->{lag_history}};
|
|
|
|
|
2021-06-05 22:37:49 +02:00
|
|
|
my @entries;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
|
|
|
foreach my $entry (@{$self->{lag_history}}) {
|
|
|
|
my ($send_time, $lag_result) = @$entry;
|
2021-06-05 22:37:49 +02:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
$lag_total += $lag_result;
|
2021-06-05 22:37:49 +02:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
my $ago = concise ago(gettimeofday - $send_time);
|
2021-06-05 22:37:49 +02:00
|
|
|
|
|
|
|
push @entries, "[$ago] " . sprintf "%.1f ms", $lag_result;
|
2021-06-05 22:20:03 +02:00
|
|
|
}
|
|
|
|
|
2021-06-05 22:37:49 +02:00
|
|
|
push @entries, "[waiting for pong] $elapsed";
|
|
|
|
|
|
|
|
my $lagstring = join '; ', @entries;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
|
|
|
my $average = $lag_total / ($len + 1);
|
2021-06-05 22:37:49 +02:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
$lagstring .= "; average: " . sprintf "%.1f ms", $average;
|
2021-06-05 22:37:49 +02:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
return $lagstring;
|
|
|
|
}
|
|
|
|
|
|
|
|
return "My lag: " . $self->lagstring;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2011-01-25 00:56:55 +01:00
|
|
|
sub send_ping {
|
2020-02-15 23:38:32 +01:00
|
|
|
my $self = shift;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
return unless defined $self->{pbot}->{conn};
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
$self->{ping_send_time} = [gettimeofday];
|
|
|
|
$self->{pong_received} = 0;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
$self->{pbot}->{conn}->sl("PING :lagcheck");
|
2011-01-25 00:56:55 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub on_pong {
|
2020-02-15 23:38:32 +01:00
|
|
|
my $self = shift;
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
$self->{pong_received} = 1;
|
2011-12-12 00:33:01 +01:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
my $elapsed = tv_interval($self->{ping_send_time});
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
push @{$self->{lag_history}}, [$self->{ping_send_time}[0], $elapsed * 1000];
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
my $len = @{$self->{lag_history}};
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
my $lag_history_max = $self->{pbot}->{registry}->get_value('lagchecker', 'lag_history_max');
|
2014-05-19 04:42:18 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
while ($len > $lag_history_max) {
|
|
|
|
shift @{$self->{lag_history}};
|
|
|
|
$len--;
|
|
|
|
}
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
$self->{lag_string} = '';
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
my @entries;
|
2020-02-15 23:38:32 +01:00
|
|
|
my $lag_total = 0;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
foreach my $entry (@{$self->{lag_history}}) {
|
|
|
|
my ($send_time, $lag_result) = @$entry;
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
$lag_total += $lag_result;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
my $ago = concise ago(gettimeofday - $send_time);
|
2021-06-05 22:20:03 +02:00
|
|
|
|
|
|
|
push @entries, "[$ago] " . sprintf "%.1f ms", $lag_result;
|
2020-02-15 23:38:32 +01:00
|
|
|
}
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
$self->{lag_string} = join '; ', @entries;
|
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
$self->{lag_average} = $lag_total / $len;
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
$self->{lag_string} .= "; average: " . sprintf "%.1f ms", $self->{lag_average};
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
return 0;
|
2011-01-25 00:56:55 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub lagging {
|
2021-06-05 22:20:03 +02:00
|
|
|
my ($self) = @_;
|
2011-01-25 00:56:55 +01:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
if (defined $self->{pong_received} and $self->{pong_received} == 0) {
|
|
|
|
# a ping has been sent (pong_received is not undef) and no pong has been received yet
|
|
|
|
my $elapsed = tv_interval($self->{ping_send_time});
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
return $elapsed >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold');
|
|
|
|
}
|
|
|
|
|
|
|
|
return 0 if not defined $self->{lag_average};
|
2021-06-05 22:20:03 +02:00
|
|
|
|
2020-02-15 23:38:32 +01:00
|
|
|
return $self->{lag_average} >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold');
|
2011-01-25 00:56:55 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub lagstring {
|
2021-06-05 22:20:03 +02:00
|
|
|
my ($self) = @_;
|
2011-12-12 00:44:04 +01:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
my $lag = $self->{lag_string} || "initializing";
|
2011-12-12 00:44:04 +01:00
|
|
|
|
2021-06-05 22:20:03 +02:00
|
|
|
return $lag;
|
2011-01-25 00:56:55 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
1;
|