App-SpeedTest
view release on metacpan or search on metacpan
exit 0;
} # pod_text
sub pod_nroff {
first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();
require Pod::Man;
my $p = Pod::Man->new ();
open my $fh, "|-", "nroff", "-man";
$p->parse_from_file ($0, $fh);
close $fh;
exit 0;
} # pod_nroff
# Debugging. Prefer Data::Peek over Data::Dumper if available
{ use Data::Dumper;
my $dp = eval { require Data::Peek; 1; };
sub ddumper {
$dp ? Data::Peek::DDumper (@_)
: print STDERR Dumper (@_);
} # ddumper
}
$timeout ||= 10;
my $ua = LWP::UserAgent->new (
max_redirect => 2,
agent => "speedtest/$VERSION",
parse_head => 0,
timeout => $timeout,
cookie_jar => {},
);
$ua->env_proxy;
binmode STDOUT, ":encoding(utf-8)";
# Speedtest.net defines Mbit/s and kbit/s using 1000 as multiplier,
# https://support.speedtest.net/entries/21057567-What-do-mbps-and-kbps-mean-
my $k = 1000;
my $config = get_config ();
my $client = $config->{"client"} or die "Config saw no client\n";
my $times = $config->{"times"} or die "Config saw no times\n";
my $downld = $config->{"download"} or die "Config saw no download\n";
my $upld = $config->{"upload"} or die "Config saw no upload\n";
$opt_v > 3 and ddumper {
client => $client,
times => $times,
down => $downld,
up => $upld,
};
if ($url || $mini) {
$opt_g = 0;
$opt_c = "";
@server = ();
my $ping = 0.05;
my $name = "";
my $sponsor = "CLI";
if ($mini) {
my $t0 = [ gettimeofday ];
my $rsp = $ua->request (HTTP::Request->new (GET => $mini));
$ping = tv_interval ($t0);
$rsp->is_success or die $rsp->status_line . "\n";
my $tree = HTML::TreeBuilder->new ();
$tree->parse_content ($rsp->content) or die "Cannot parse\n";
my $ext = "";
for ($tree->look_down (_tag => "script")) {
my $c = ($_->content)[0] or next;
ref $c eq "ARRAY" && $c->[0] &&
$c->[0] =~ m{\b (?: upload_? | config ) Extension
\s*: \s* "? ([^"\s]+) }xi or next;
$ext = $1;
last;
}
$ext or die "No ext found\n";
($url = $mini) =~ s{/*$}{/speedtest/upload.$ext};
$sponsor = $_->as_text for $tree->look_down (_tag => "title");
$name ||= $_->as_text for $tree->look_down (_tag => "h1");
$name ||= "Speedtest mini";
}
else {
$name = "Local";
$url =~ m{/\w+\.\w+$} or $url =~ s{/?$}{/speedtest/upload.php};
my $t0 = [ gettimeofday ];
my $rsp = $ua->request (HTTP::Request->new (GET => $url));
$ping = tv_interval ($t0);
$rsp->is_success or die $rsp->status_line . "\n";
}
(my $host = $url) =~ s{^\w+://([^/]+)(?:/.*)?}{$1};
$url = {
cc => "",
country => "",
dist => "0.0",
host => $host,
id => 0,
lat => "0.0000",
lon => "0.0000",
name => $name,
ping => $ping * 1000,
sponsor => $sponsor,
url => $url,
url2 => $url,
};
}
if (@server) {
$opt_c = "";
$opt_a = 1;
unless ($server[0] =~ m{^[0-9]+$}) {
open my $fh, "<", $server[0] or die;#usage (1);
my $data = do { local $/; <$fh>; };
print $data;
$data =~ m/^\s*\{\s*(['"]?)cc\1\s*=>\s*(["'])[A-Z]{1,3}\2\s*,/ &&
$data =~ m/\s(["']?)id\1\s*=>\s*[0-9]+\s*,/ or die;#usage (1);
$data = eval $data;
$data->{dist} = distance ($client->{lat}, $client->{lon},
$data->{lat}, $data->{lon});
($data->{url0} = $data->{url}) =~ s{/speedtest/upload.*}{};
$url = $data;
}
}
else {
if ($opt_c) {
$opt_c = uc $opt_c;
}
elsif ($opt_g) { # Try GeoIP
$opt_v > 5 and say STDERR "Testing Geo location";
my $url = "http://www.geoiptool.com";
my $rsp = $ua->request (HTTP::Request->new (GET => $url));
if ($rsp->is_success) {
my $tree = HTML::TreeBuilder->new ();
if ($tree->parse_content ($rsp->content)) {
foreach my $e ($tree->look_down (_tag => "div", class => "data-item")) {
$opt_v > 2 and say STDERR $e->as_text;
$e->as_text =~ m{Country code(?:\s*:)?\s*([A-Za-z]+)}i or next;
$opt_c = uc $1;
last;
}
}
}
unless ($opt_c) { # GEO-Ip failed :/
$opt_v and warn "GEO-IP failed. Getting country code based on nearest server\n";
my $keep_a = $opt_a;
$opt_a = 1;
my %list = servers ();
my $nearest = { dist => 9999999 };
foreach my $id (keys %list) {
$list{$id}{dist} < $nearest->{dist} and $nearest = $list{$id};
}
$opt_v > 3 and ddumper { nearest => $nearest };
$opt_c = $nearest->{cc};
$opt_a = $keep_a;
}
}
$opt_c ||= "IS"; # Iceland seems like a nice default :P
}
if ($opt_cc) {
my %sl = get_servers ();
my %cc;
foreach my $s (values %sl) {
my $cc = $s->{cc};
$cc{$cc} //= { cc => $cc, country => $s->{country}, count => 0 };
$cc = $cc{$cc};
$cc->{count}++;
}
for (sort { $a->{cc} cmp $b->{cc} } values %cc) {
printf "%2s %-32s %4d\n", $_->{cc}, $_->{country}, $_->{count};
}
exit 0;
}
if ($list) {
my %list = servers ();
my @fld = qw( id sponsor name dist );
my $fmt = "%3d: %5d - %-30.30s %-15.15s %7.2f km\n";
if (defined $url) {
push @fld, "url0";
$fmt .= " %s\n";
}
my $idx = 1;
printf $fmt, $idx++, @{$list{$_}}{@fld}
for sort { $list{$a}{dist} <=> $list{$b}{dist} } keys %list;
exit 0;
}
if ($opt_ping) {
my @fld = qw( id sponsor name dist ping );
my $fmt = "%3d: %5d - %-30.30s %-15.15s %7.2f km %7.0f ms\n";
if (defined $url) {
push @fld, "url0";
$fmt .= " %s\n";
}
my $idx = 1;
printf $fmt, $idx++, @{$_}{@fld} for servers_by_ping ();
exit 0;
}
$opt_v and say STDERR "Testing for $client->{ip} : $client->{isp} ($opt_c)";
$opt_P and print qq{<?xml version="1.0" encoding="UTF-8" ?>\n<prtg>\n},
qq{ <text>Testing from $client->{isp} ($client->{ip})</text>\n};
# default action is to run on fastest server
my @srvrs = $url ? ($url) : servers_by_ping ();
my @hosts = grep { $_->{ping} < 1000 } @srvrs;
@server and $opt_T = @server;
@hosts > $opt_T and splice @hosts, $opt_T;
my @try;
foreach my $host (@hosts) {
$host->{sponsor} =~ s/\s+$//;
if ($opt_P) {
printf do { join "\n", map { " $_" }
"<result>",
" <channel>Ping</channel>",
" <customUnit>ms</customUnit>",
" <float>1</float>",
" <value>%0.2f</value>",
" </result>\n",
}, $host->{ping};
}
elsif ($opt_v) {
my $s = "";
if ($ip) {
(my $h = $host->{url}) =~ s{^\w+://([^/]+)(?:/.*)?$}{$1};
my @ad = gethostbyname ($h);
$s = join " " => "", map { inet_ntoa ($_) } @ad[4 .. $#ad];
}
@hosts > 1 and print STDERR "\n";
printf STDERR "Using %5d: %6.2f km %7.0f ms%s %s\n",
$host->{id}, $host->{dist}, $host->{ping}, $s, $host->{sponsor};
}
$opt_v > 3 and ddumper $host;
(my $base = $host->{url}) =~ s{/[^/]+$}{};
my $dl = "-";
if ($opt_d) {
$opt_v and print STDERR "Test download ";
# http://ookla.extraip.net/speedtest/random350x350.jpg
my @url = @{$host->{dl_list} // [
map { ("$base/random${_}x${_}.jpg") x 4 }
350, 500, 750, 1000, 1500, 2000, 2500, 3000, 3500, 4000 ]};
my @rslt;
$opt_q and splice @url, $opt_q;
foreach my $url (@url) {
my $req = HTTP::Request->new (GET => $url);
my $t0 = [ gettimeofday ];
my $rsp = $ua->request ($req);
my $elapsed = tv_interval ($t0);
unless ($rsp->is_success) {
warn "$url: ", $rsp->status_line, "\n";
next;
}
my $sz = length $rsp->content;
my $speed = 8 * $sz / $elapsed / $k / $k;
push @rslt, [ $sz, $elapsed, $speed ];
$opt_v and print STDERR ".";
$opt_v > 2 and printf STDERR "\n%12.3f %s (%7d) ", $speed, $url, $sz;
}
$dl = result ("Download", $host, scalar @url, @rslt);
}
my $ul = "-";
if ($opt_u) {
$opt_v and print STDERR "Test upload ";
my @data = (0 .. 9, "a" .. "Z", "a" .. "z"); # Random pure ASCII data
my $data = join "" => map { $data[int rand $#data] } 0 .. 4192;
$data = "content1=".($data x 8192); # Total length just over 4 Mb
my @rslt;
my $url = $host->{url}; # .php, .asp, .aspx, .jsp
# see $upld->{mintestsize} and $upld->{maxchunksize} ?
my @size = map { $_ * 1000 }
# ((256) x 10, (512) x 10, (1024) x 10, (4096) x 10);
((256) x 10, (512) x 10, (1024) x 5, (2048) x 5, (4096) x 5, (8192) x 5);
$opt_q and splice @size, $opt_q;
foreach my $sz (@size) {
my $req = HTTP::Request->new (POST => $url);
$req->content (substr $data, 0, $sz);
my $t0 = [ gettimeofday ];
my $rsp = $ua->request ($req);
my $elapsed = tv_interval ($t0);
unless ($rsp->is_success) {
warn "$url: ", $rsp->status_line, "\n";
next;
}
my $speed = 8 * $sz / $elapsed / $k / $k;
push @rslt, [ $sz, $elapsed, $speed ];
$opt_v and print STDERR ".";
$opt_v > 2 and printf STDERR "\n%12.3f %s (%7d) ", $speed, $url, $sz;
}
$ul = result ("Upload", $host, scalar @size, @rslt);
}
my $sum = $dl eq "-" ? 0 : $dl;
$sum += $ul eq "-" ? 0 : $ul;
$sum ||= "-";
push @try => [ $host, $dl, $ul, $sum ];
$opt_1 and print "DL: $dl M$unit->[1]/s, UL: $ul M$unit->[1]/s, SRV: $host->{id}\n";
}
$opt_P and print " </prtg>\n";
if ($opt_T and @try > 1) {
print "\n";
my $rank = 1;
foreach my $t (sort { $b->[-1] <=> $a->[-1] } @try) {
my ($host, $dl, $ul) = @$t;
printf "Rank %02d: Server: %6d %6.2f km %7.0f ms, DL: %s UL: %s\n",
$rank++, $host->{id}, $host->{dist}, $host->{ping}, $dl, $ul;
}
}
sub result {
my ($dir, $host, $n, @rslt) = @_;
my $size = (sum map { $_->[0] } @rslt) // 0;
my $time = (sum map { $_->[1] } @rslt) // 0;
my @speed = sort { $a <=> $b } grep { $_ } map { $_->[2] } @rslt;
$opt_U && @speed == 0 and return;
my $slow = $speed[ 0] // 0.000;
my $fast = $speed[-1] // 999999999.999;
my $sp = sprintf "%8.3f", 8 * ($size / ($time || 1)) / $k / $k / $unit->[0];
if ($opt_C) {
my @d = localtime;
# stamp,id,ping,tests,direction,speed)
printf qq{"%4d-%02d-%02d %02d:%02d:%02d",%d,%.2f,%d,%.1s,%.2f,%.2f,%.2f%s},
$d[5] + 1900, ++$d[4], @d[3,2,1,0],
$host->{id}, $host->{ping},
$n, $dir, $sp, $slow, $fast, $opt_CNL ? "\n" : "\r\n";
}
elsif ($opt_P) {
printf do { join "\n", map { " $_" }
"<result>",
" <channel>%s</channel>",
" <customUnit>M%s/s</customUnit>",
" <float>1</float>",
" <value>%0.2f</value>",
" </result>\n",
}, $dir, $unit->[1], $sp;
}
else {
$opt_q && $opt_v and print $opt_v > 2 ? "\n " : " " x (40 - $opt_q);
$opt_v || !$opt_1 and printf "%-10s %8s M%s/s\n", $dir, $sp, $unit->[1];
$opt_v > 1 and printf " Transfer %10.3f kb in %9.3f s. [%8.3f - %8.3f]\n",
$size / 1024, $time, $slow, $fast;
}
return $sp;
} # result
### ############################################################################
sub get_config {
my $url = "http://www.speedtest.net/speedtest-config.php";
my $rsp = $ua->request (HTTP::Request->new (GET => $url));
$rsp->is_success or die "Cannot get config: ", $rsp->status_line, "\n";
my $xml = XMLin ( $rsp->content,
keeproot => 1,
noattr => 0,
keyattr => [ ],
suppressempty => "",
);
$opt_v > 5 and ddumper $xml->{settings};
return $xml->{settings};
} # get_config
sub get_servers {
my $servlist;
foreach my $url (qw(
http://www.speedtest.net/speedtest-servers-static.php
http://www.speedtest.net/speedtest-servers.php
http://c.speedtest.net/speedtest-servers.php
)) {
$opt_v > 2 and warn "Fetching $url\n";
my $rsp = $ua->request (HTTP::Request->new (GET => $url));
$opt_v > 2 and warn $rsp->status_line, "\n";
$rsp->is_success and $servlist = $rsp->content and last;
}
$servlist or die "Cannot get any config\n";
my $xml = XMLin ($servlist,
keeproot => 1,
noattr => 0,
keyattr => [ ],
suppressempty => "",
);
# 4601 => {
# cc => 'NL',
# country => 'Netherlands',
# dist => '38.5028663935342602', # added later
# id => 4601,
# lat => '52.2167',
# lon => '5.9667',
# name => 'Apeldoorn',
# sponsor => 'Solcon Internetdiensten N.V.',
# url => 'http://speedtest.solcon.net/speedtest/upload.php',
# url2 => 'http://ooklaspeedtest.solcon.net/speedtest/upload.php'
# },
return map { $_->{id} => $_ } @{$xml->{settings}{servers}{server}};
} # get_servers
sub distance {
my ($lat_c, $lon_c, $lat_s, $lon_s) = @_;
my $rad = 6371; # km
# Convert angles from degrees to radians
my $dlat = deg2rad ($lat_s - $lat_c);
my $dlon = deg2rad ($lon_s - $lon_c);
my $x = sin ($dlat / 2) * sin ($dlat / 2) +
cos (deg2rad ($lat_c)) * cos (deg2rad ($lat_s)) *
sin ($dlon / 2) * sin ($dlon / 2);
return $rad * 2 * atan2 (sqrt ($x), sqrt (1 - $x)); # km
} # distance
sub servers {
my %list = get_servers ();
if (my $iid = $config->{"server-config"}{ignoreids}) {
$opt_v > 3 and warn "Removing servers $iid from server list\n";
delete @list{split m/\s*,\s*/ => $iid};
}
$opt_a or delete @list{grep { $list{$_}{cc} ne $opt_c } keys %list};
%list or die "No servers in $opt_c found\n";
for (values %list) {
$_->{dist} = distance ($client->{lat}, $client->{lon},
$_->{lat}, $_->{lon});
($_->{url0} = $_->{url}) =~ s{/speedtest/upload.*}{};
$opt_v > 7 and ddumper $_;
}
return %list;
} # servers
sub servers_by_ping {
my %list = servers;
my @list = values %list;
$opt_v > 1 and say STDERR "Finding fastest host out of @{[scalar @list]} hosts for $opt_c ...";
my $pa = LWP::UserAgent->new (
max_redirect => 2,
agent => "Opera/25.00 opera 25",
parse_head => 0,
cookie_jar => {},
timeout => $timeout,
);
$pa->env_proxy;
$opt_ping ||= 40;
if (@list > $opt_ping) {
@list = sort { $a->{dist} <=> $b->{dist} } @list;
@server or splice @list, $opt_ping;
}
foreach my $h (@list) {
my $t = 0;
if (@server and not first { $h->{id} == $_ } @server) {
$h->{ping} = 999999;
next;
}
$opt_v > 5 and printf STDERR "? %4d %-20.20s %s\n",
$h->{id}, $h->{sponsor}, $h->{url};
my $req = HTTP::Request->new (GET => "$h->{url}/latency.txt");
for (0 .. 3) {
my $t0 = [ gettimeofday ];
my $rsp = $pa->request ($req);
my $elapsed = tv_interval ($t0);
$opt_v > 8 and printf STDERR "%4d %9.2f\n", $_, $elapsed;
if ($elapsed >= 15) {
$t = 40;
last;
}
$t += ($rsp->is_success ? $elapsed : 1000);
}
$h->{ping} = $t * 1000; # report in ms
}
sort { $a->{ping} <=> $b->{ping}
|| $a->{dist} <=> $b->{dist} } @list;
} # servers_by_ping
__END__
=encoding UTF-8
=head1 NAME
App::SpeedTest - Command-line interface to speedtest.net
=head1 SYNOPSIS
$ speedtest [ --no-geo | --country=NL ] [ --list | --ping ] [ options ]
$ speedtest --list
$ speedtest --ping --country=BE
$ speedtest
$ speedtest -s 4358
$ speedtest --url=http://ookla.extraip.net
$ speedtest -q --no-download
$ speedtest -Q --no-upload
=head1 DESCRIPTION
The provided perl script is a command-line interface to the
L<speedtest.net|http://www.speedtest.net/> infrastructure so that
flash is not required
It was written to feature the functionality that speedtest.net offers
without the overhead of flash or java and the need of a browser.
=head1 Raison-d'être
The tool is there to give you a quick indication of the achievable
throughput of your current network. That can drop dramatically if
you are behind (several) firewalls or badly configured networks (or
network parts like switches, hubs and routers).
It was inspired by L<speedtest-cli|https://github.com/sivel/speedtest-cli>,
a project written in python. But I neither like python, nor did I like the
default behavior of that script. I also think it does not take the right
decisions in choosing the server based on distance instead of speed. That
B<does> matter if one has fiber lines. I prefer speed over distance.
=head1 Command-line Arguments
( run in 0.776 second using v1.01-cache-2.11-cpan-f52f0507bed )