dotfiles/.bin/OLD/rtservermon.pl

70 lines
1.9 KiB
Perl
Raw Normal View History

#!/usr/bin/perl
use strict;
use warnings;
#
# ONLY OpenBSD modules included with the default installation are permitted!
#
use HTTP::Tiny;
use Net::Ping;
use Time::HiRes;
# Configuration hash (editable)
my %config = (
'timeout' => 0.20, # How long to wait before giving up on server response, in seconds
'debug' => 1, # Debug output?
'top' => 3, # How many entries to return?
'protocol' => 'tcp', # tcp, udp, icmp, et al
'port' => 'http', # (used in getservbyname sub)
);
# hash to store servers and response times to protocol/port requests
my %serverstats;
# create HTTP::Tiny instance
my $http = HTTP::Tiny->new;
# Get a list of all current OpenBSD FTP servers
my $response = $http->get('http://ftp.eu.openbsd.org/pub/OpenBSD/ftplist');
die "Failed!\n" unless $response->{success};
# Iterate through server list and get TCP/80 response time in ms
foreach my $line (split("\n", $response->{content})) {
if ($line !~ /(cdn)/) {
if ($line =~ /(http:\/\/)(.+?)(\/\S+)/) {
my $response = &httping($2);
$serverstats{$1.$2.$3} = $response if ($response);
}
}
}
# Sort & print servers by response time in ms
my $i = 0;
foreach my $key (sort {$serverstats{$a} <=> $serverstats{$b} } keys %serverstats) {
$i++;
print "$key\n";
last if $i eq $config{'top'};
}
#
# Ping TCP/80 and return response time or 0 if unresponsive + some diagnostic output
#
sub httping ($) {
my $host = shift;
my $ping = Net::Ping->new($config{'protocol'});
$ping->hires();
$ping->{port_num} = getservbyname($config{'port'}, $config{'protocol'});
print ("Trying $host... ") if $config{'debug'};
my ($retval, $duration, $ip) = $ping->ping($host, $config{'timeout'});
$ping->close();
$duration = int($duration * 1000);
if ($retval) {
print ("$duration ms\n") if $config{'debug'};
return $duration;
} else {
print ("unresponsive\n") if $config{'debug'};;
return 0;
}
}