├── .gitignore ├── .aspell.local.pws ├── .whitesource ├── xt ├── 02_pod.t ├── 00_pod.t ├── 60_changelog.t └── 01_pod.t ├── MANIFEST ├── MANIFEST.SKIP ├── .travis.yml ├── sandbox ├── make-pm ├── genMETA.pl ├── twiggish.pl ├── speedtest2.pl ├── genMETA.pm └── config.dd ├── CONTRIBUTING.md ├── cpanfile ├── t └── 01-help.t ├── Makefile.PL ├── examples └── speedtest-graph.pl ├── README.md ├── ChangeLog ├── SECURITY.md ├── doc ├── make-doc.pl ├── speedtest.md ├── speedtest.man ├── speedtest.html └── speedtest.3 ├── LICENSE └── speedtest /.gitignore: -------------------------------------------------------------------------------- 1 | blib 2 | cover_db 3 | Makefile 4 | META.yml 5 | MYMETA.yml 6 | MYMETA.json 7 | pm_to_blib 8 | lib 9 | tmp 10 | *.tar.gz 11 | *.tgz 12 | *.old 13 | *.tmp 14 | -------------------------------------------------------------------------------- /.aspell.local.pws: -------------------------------------------------------------------------------- 1 | personal_ws-1.1 en 14 2 | cli 3 | cXX 4 | être 5 | geo 6 | ip 7 | latencies 8 | Makefile 9 | mXX 10 | NYI 11 | prtg 12 | raison 13 | speedtest 14 | être 15 | -------------------------------------------------------------------------------- /.whitesource: -------------------------------------------------------------------------------- 1 | { 2 | "generalSettings": { 3 | "shouldScanRepo": true 4 | }, 5 | "checkRunSettings": { 6 | "vulnerableCheckRunConclusionLevel": "failure" 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /xt/02_pod.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use Test::More; 4 | 5 | eval "use Test::Pod::Links"; 6 | plan skip_all => "Test::Pod::Links required for testing POD Links" if $@; 7 | Test::Pod::Links->new->all_pod_files_ok; 8 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | ChangeLog 2 | speedtest 3 | Makefile.PL 4 | MANIFEST 5 | CONTRIBUTING.md 6 | SECURITY.md 7 | LICENSE 8 | README.md 9 | cpanfile 10 | examples/speedtest-graph.pl 11 | lib/App/SpeedTest.pm 12 | t/01-help.t 13 | -------------------------------------------------------------------------------- /xt/00_pod.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | $^W = 1; 5 | 6 | use Test::More; 7 | 8 | eval "use Test::Pod 1.00"; 9 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 10 | all_pod_files_ok (); 11 | -------------------------------------------------------------------------------- /xt/60_changelog.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | eval "use Test::CPAN::Changes"; 8 | plan skip_all => "Test::CPAN::Changes required for this test" if $@; 9 | 10 | changes_file_ok ("ChangeLog"); 11 | 12 | done_testing; 13 | -------------------------------------------------------------------------------- /xt/01_pod.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | eval "use Test::Pod::Coverage tests => 1"; 9 | plan skip_all => "Test::Pod::Coverage required for testing POD Coverage" if $@; 10 | pod_coverage_ok ("Text::CSV_XS", "Text::CSV_XS is covered"); 11 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | \.old$ 2 | \.tar\.gz$ 3 | \.tgz$ 4 | \.git 5 | \.releaserc 6 | \.tmp$ 7 | \.travis.yml 8 | \.whitesource 9 | xt/ 10 | blib/ 11 | doc/ 12 | cover_db/ 13 | config.dd 14 | Makefile 15 | MANIFEST.SKIP 16 | MYMETA.json 17 | MYMETA.yml 18 | pm_to_blib 19 | sandbox/ 20 | \.aspell\.local\.pws 21 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | os: 3 | - linux 4 | dist: trusty 5 | perl: 6 | - "5.30" 7 | - "5.28" 8 | - "5.26" 9 | - "5.26-shrplib" 10 | - "5.24" 11 | - "5.22" 12 | - "5.20" 13 | - "5.18" 14 | - "5.16" 15 | - "5.14" 16 | - "5.12" 17 | - "5.10" 18 | - "5.8" 19 | env: 20 | global: 21 | - AUTOMATED_TESTING=1 22 | install: 23 | - cpanm --quiet --installdeps --with-all-features --notest . || true 24 | notifications: 25 | irc: 26 | channels: 27 | - "irc.perl.org#csv" 28 | on_success: always 29 | on_failure: always 30 | -------------------------------------------------------------------------------- /sandbox/make-pm: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.18.2; 4 | use warnings; 5 | 6 | open my $fh, "<", "speedtest" or die; 7 | my ($v) = grep m/\bVERSION\s*=/ => <$fh>; 8 | close $fh; 9 | 10 | my @pm; 11 | while () { 12 | push @pm, m/^V/ ? $v : $_; 13 | } 14 | 15 | open $fh, "<", "speedtest"; 16 | while (<$fh>) { 17 | /__END__/ .. -1 and push @pm, $_; 18 | } 19 | close $fh; 20 | 21 | -d "lib" or mkdir "lib"; 22 | -d "lib/App" or mkdir "lib/App"; 23 | open $fh, ">", "lib/App/SpeedTest.pm" or die; 24 | print $fh @pm; 25 | close $fh; 26 | 27 | __END__ 28 | #!/usr/bin/perl 29 | 30 | package App::SpeedTest; 31 | 32 | use strict; 33 | use warnings; 34 | 35 | VERSION = ""; 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # General 2 | 3 | I am always open to improvements and suggestions. Use issues at 4 | https://github.com/Tux/speedtest/issues 5 | 6 | # Style 7 | 8 | I will never accept pull request that do not strictly conform to my 9 | style, however you might hate it. You can read the reasoning behind 10 | my preferences here: http://tux.nl/style.html 11 | 12 | I really don not care about mixed spaces and tabs in (leading) whitespace 13 | 14 | # Mail 15 | 16 | Please, please, please, do *NOT* use HTML mail. 17 | [Plain text](https://useplaintext.email) 18 | [without](http://www.goldmark.org/jeff/stupid-disclaimers/) 19 | [disclaimers](https://www.economist.com/business/2011/04/07/spare-us-the-e-mail-yada-yada) 20 | will do fine! 21 | 22 | # Requirements 23 | 24 | Currently, the script is simple enough to require perl-5.10.0. It 25 | would probably also run fine under 5.8.x if I were not to use "say". 26 | I got lazy and used to that. I test with very recent versions of perl. 27 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires "Data::Dumper"; 2 | requires "Data::Peek"; 3 | requires "Getopt::Long"; 4 | requires "HTML::TreeBuilder"; 5 | requires "LWP::UserAgent"; 6 | requires "List::Util"; 7 | requires "Math::Trig"; 8 | requires "Socket"; 9 | requires "Time::HiRes"; 10 | requires "XML::Simple"; 11 | 12 | recommends "Data::Dumper" => "2.154"; 13 | recommends "Data::Peek" => "0.53"; 14 | recommends "Getopt::Long" => "2.58"; 15 | recommends "HTML::TreeBuilder" => "5.07"; 16 | recommends "LWP::UserAgent" => "6.78"; 17 | recommends "Socket" => "2.038"; 18 | recommends "Text::CSV_XS" => "1.60"; 19 | recommends "Time::HiRes" => "1.9777"; 20 | recommends "XML::Simple" => "2.25"; 21 | 22 | suggests "Data::Dumper" => "2.189"; 23 | 24 | on "configure" => sub { 25 | requires "ExtUtils::MakeMaker"; 26 | 27 | recommends "ExtUtils::MakeMaker" => "7.22"; 28 | 29 | suggests "ExtUtils::MakeMaker" => "7.72"; 30 | }; 31 | 32 | on "test" => sub { 33 | requires "Test::More"; 34 | 35 | recommends "Test::More" => "1.302209"; 36 | }; 37 | -------------------------------------------------------------------------------- /t/01-help.t: -------------------------------------------------------------------------------- 1 | #!env perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | $ENV{NO_COLOR} = 1; 8 | 9 | my @txt = qx{$^X ./speedtest --help}; 10 | ok ($#txt > 40, "--help gives enough output"); 11 | like ("@txt", qr{--help}, "Help has --help"); 12 | 13 | @txt = qx{$^X ./speedtest --version}; 14 | is (scalar @txt, 1, "--version gives exactly 1 line"); 15 | like ($txt[0], qr{^speedtest\s+\[[0-9.]+\]}, "--version shows command + version"); 16 | 17 | @txt = grep m/\S/ => qx{$^X ./speedtest --man}; 18 | ok (250 < scalar @txt, "--man gives the manual"); 19 | if ($txt[0] =~ m/^NAME\b/) { # No nroff available, fallback to Text 20 | like ($txt[1], qr{^\s+App::SpeedTest\s}i, "Pod was correctly parsed"); 21 | } 22 | elsif ($^O eq "solaris") { 23 | # I don't have its output to check against, but it fails 24 | ok (1, "Don't know how to check this on Solaris"); 25 | } 26 | else { 27 | # SPEEDTEST(1) User Contributed Perl Documentation SPEEDTEST(1) 28 | # User Contributed Perl Documentation SPEEDTEST(1) 29 | $txt[0] =~ s/(?:\e\[|\x9b)[0-9;]*m//g; # groff-1.24 starts colorizing 30 | like ($txt[0], qr{\bSPEEDTEST\s*\(1\)}i, "It generated a standard header"); 31 | } 32 | 33 | chomp (@txt = grep m/\S/ => qx{$^X ./speedtest --info}); 34 | ok (250 < scalar @txt, "--info gives the manual as simple text"); 35 | is ($txt[0], "NAME", "The manual starts with section NAME"); 36 | 37 | done_testing (); 38 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | require 5.010; 5 | 6 | use ExtUtils::MakeMaker; 7 | 8 | my %wm = ( 9 | NAME => "App::SpeedTest", 10 | DISTNAME => "App-SpeedTest", 11 | ABSTRACT => "Command line interface to speedtest.net", 12 | AUTHOR => "H.Merijn Brand ", 13 | VERSION_FROM => "speedtest", 14 | EXE_FILES => [ "speedtest" ], 15 | PREREQ_FATAL => 0, 16 | PREREQ_PM => { 17 | "Data::Dumper" => 0, 18 | "Data::Peek" => 0, 19 | "Getopt::Long" => 0, 20 | "HTML::TreeBuilder" => 0, 21 | "LWP::UserAgent" => 0, 22 | "List::Util" => 0, 23 | "Math::Trig" => 0, 24 | "Socket" => 0, 25 | "Time::HiRes" => 0, 26 | "XML::Simple" => 0, 27 | }, 28 | macro => { TARFLAGS => "--format=ustar -c -v -f", }, 29 | ); 30 | $ExtUtils::MakeMaker::VERSION > 6.30 and $wm{LICENSE} = "perl"; 31 | 32 | my $rv = WriteMakefile (%wm); 33 | 34 | package MY; 35 | 36 | sub postamble { 37 | my @pc; 38 | $] >= 5.010 && -d "xt" && ($ENV{AUTOMATED_TESTING} || 0) != 1 and 39 | push @pc, 40 | 'test :: lib/App/SpeedTest.pm', 41 | ' -@env TEST_FILES="xt/*.t" make -e test_dynamic', 42 | ' perl doc/make-doc.pl', 43 | ''; 44 | join "\n" => 45 | 'spellcheck: lib/App/SpeedTest.pm doc', 46 | ' pod-spell-check --aspell', 47 | '', 48 | 'checkmeta: spellcheck', 49 | ' perl sandbox/genMETA.pl -c', 50 | '', 51 | 'fixmeta: lib/App/SpeedTest.pm distmeta', 52 | ' perl sandbox/genMETA.pl', 53 | '', 54 | 'lib/App/SpeedTest.pm: speedtest', 55 | ' perl sandbox/make-pm', 56 | '', 57 | 'tgzdist: checkmeta fixmeta $(DISTVNAME).tar.gz distcheck', 58 | ' -@mv -f $(DISTVNAME).tar.gz $(DISTVNAME).tgz', 59 | ' -@cpants_lint.pl $(DISTVNAME).tgz', 60 | ' -@rm -f Debian_CPANTS.txt', 61 | '', 62 | 'doc docs: doc/speedtest.md doc/speedtest.html doc/speedtest.man', 63 | ' -@rm -f pod2html.tmp', 64 | 'doc/speedtest.md: speedtest', 65 | ' perl doc/make-doc.pl', 66 | '', 67 | @pc; 68 | } # postamble 69 | 70 | 1; 71 | -------------------------------------------------------------------------------- /examples/speedtest-graph.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.14.2; 4 | use warnings; 5 | 6 | our $VERSION = "0.02 - 20190822"; 7 | our $CMD = $0 =~ s{.*/}{}r; 8 | 9 | sub usage { 10 | my $err = shift and select STDERR; 11 | say "usage: $CMD [--graph=speedtest.jpg] [--log=speedtest.csv | speedtest.csv]"; 12 | say " -l LOG --log=LOG specify CSV logfile to scan (speedtest.csv)"; 13 | say " -g JPG --graph=JPG specify filename of produced image (speedtest.jpg)"; 14 | exit $err; 15 | } # usage 16 | 17 | use Time::Local; 18 | use Text::CSV_XS "csv"; 19 | use Chart::Strip; 20 | use Getopt::Long qw(:config bundling); 21 | GetOptions ( 22 | "help|?" => sub { usage (0); }, 23 | "V|version" => sub { say "$CMD [$VERSION]"; exit 0; }, 24 | 25 | "l|in|csv|log=s" => \(my $log = "speedtest.csv"), 26 | "g|out|graph|jpg=s" => \ my $graph, 27 | "w|width=i" => \ my $gwidth, 28 | "h|height=i" => \ my $gheight, 29 | 30 | "v|verbose:1" => \(my $opt_v = 0), 31 | ) or usage (1); 32 | 33 | @ARGV && -f $ARGV[0] and $log = shift; 34 | 35 | $graph //= $log =~ s{\.\w+$}{.jpg}r; 36 | 37 | my %color = ( 38 | Umin => "#e00000", 39 | Uspeed => "#800000", 40 | Umax => "#b00000", 41 | Dmin => "#00e000", 42 | Dspeed => "#008000", 43 | Dmax => "#00b000", 44 | ); 45 | 46 | my $headers = "auto"; 47 | open my $fh, "<", $log or die "$log: $!\n"; 48 | scalar <$fh> =~ m/^"?[0-9]{4}/ and 49 | $headers = [qw( stamp server ping tests direction speed min max )]; 50 | close $fh; 51 | 52 | my %data; 53 | foreach my $e (@{csv (in => $log, headers => $headers)}) { 54 | my @stamp = ($e->{stamp} =~ m/(\d+)/g); 55 | my $time = timelocal (@stamp[5,4,3,2], $stamp[1] - 1, $stamp[0] - 1900); 56 | 57 | push @{$data{$e->{direction}.$_}}, { 58 | time => $time, 59 | value => $e->{$_} + 0., 60 | color => $color{$e->{direction}.$_}, 61 | } for qw( min speed max ); 62 | } 63 | 64 | $gwidth ||= 640; 65 | $gheight ||= 192; 66 | my $chart = Chart::Strip->new (width => $gwidth, height => $gheight); 67 | $chart->add_data ($data{$_}, { 68 | style => "points", color => $color{$_}, label => $_}) 69 | for qw( Umin Umax Dmin Dmax ); 70 | $chart->add_data ($data{$_}, { 71 | style => "line", color => $color{$_}, label => $_}) 72 | for qw( Uspeed Dspeed ); 73 | 74 | open $fh, ">:raw", $graph; 75 | print $fh $chart->jpeg (); 76 | close $fh; 77 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ### Speedtest (a perl CLI) 2 | 3 | The provided perl script is a command-line interface to the 4 | [speedtest.net](http://www.speedtest.net/) infrastructure so that 5 | flash is not required 6 | 7 | It was written to feature the functionality that speedtest.net offers 8 | without the overhead of flash or java and the need of a browser. 9 | 10 | ### Raison-d'être 11 | 12 | The tool is there to give you a quick indication of the achievable 13 | throughput of your current network. That can drop dramatically if 14 | you are behind (several) firewalls or badly configured networks (or 15 | network parts like switches, hubs and routers). 16 | 17 | It was inspired by the same project written in python: 18 | [speedtest-cli](https://github.com/sivel/speedtest-cli), but I 19 | neither like python, nor did I like the default behavior of that 20 | script. I also think it does not take the right decisions in choosing 21 | the server based on distance instead of speed. That *does* matter if 22 | one has fiber lines. I prefer speed over distance. 23 | 24 | #### Requirements 25 | 26 | The script requires perl 5.10.0 or newer. It requires the following 27 | modules to be available (from CPAN or from CORE): 28 | 29 | - Data::Dumper CORE module since perl-5.005 30 | - Getopt::Long CORE module since perl-5 31 | - HTML::TreeBuilder 32 | - LWP::UserAgent 33 | - Math::Trig CORE module since perl-5.004 34 | - Time::HiRes CORE module since perl-5.7.3 35 | - XML::Simple 36 | - Data::Peek optional but recommended. does fallback 37 | to Data::Dumper if not available 38 | 39 | The script runs on every system that runs perl. I tested on Linux, 40 | HP-UX, AIX and Windows 7. 41 | 42 | Debian wheezy will run with just two additional packages: 43 | 44 | # apt-get install libxml-simple-perl libdata-peek-perl 45 | 46 | ### Contributing 47 | 48 | See CONTRIBUTING.md which states where and how you can contribute 49 | 50 | ### TODO 51 | 52 | - Make an installer 53 | - Enable alternative XML parsers 54 | 55 | ### Disclaimer 56 | 57 | Due to language implementation, it may report speeds that are not 58 | consistent with the speeds reported by the web interface or other 59 | speed-test tools. Likewise for reported latencies, which are not 60 | to be compared to those reported by tools like ping. 61 | 62 | Share and enjoy 63 | 64 | *H.Merijn Brand (Tux)* 65 | h.m.brand@xs4all.nl 66 | -------------------------------------------------------------------------------- /sandbox/genMETA.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Getopt::Long qw(:config bundling nopermute); 7 | GetOptions ( 8 | "c|check" => \ my $check, 9 | "u|update!" => \ my $update, 10 | "v|verbose:1" => \(my $opt_v = 0), 11 | ) or die "usage: $0 [--check]\n"; 12 | 13 | use lib "sandbox"; 14 | use genMETA; 15 | my $meta = genMETA->new ( 16 | from => "speedtest", 17 | verbose => $opt_v, 18 | ); 19 | 20 | $meta->from_data (); 21 | $meta->security_md ($update); 22 | $meta->gen_cpanfile (); 23 | 24 | if ($check) { 25 | $meta->check_encoding (); 26 | $meta->check_required (); 27 | $meta->check_minimum ("5.010000", [ "speedtest" ]); 28 | $meta->done_testing (); 29 | } 30 | elsif ($opt_v) { 31 | $meta->print_yaml (); 32 | } 33 | else { 34 | $meta->fix_meta (); 35 | } 36 | 37 | __END__ 38 | --- #YAML:1.0 39 | name: App-SpeedTest 40 | version: VERSION 41 | abstract: Command line interface to speedtest.net 42 | license: perl 43 | author: 44 | - H.Merijn Brand 45 | generated_by: Author 46 | distribution_type: module 47 | provides: 48 | App::SpeedTest: 49 | file: speedtest 50 | version: VERSION 51 | requires: 52 | perl: 5.010000 53 | Data::Dumper: 0 54 | Data::Peek: 0 55 | Getopt::Long: 0 56 | HTML::TreeBuilder: 0 57 | LWP::UserAgent: 0 58 | List::Util: 0 59 | Math::Trig: 0 60 | Socket: 0 61 | Time::HiRes: 0 62 | XML::Simple: 0 63 | recommends: 64 | Data::Dumper: 2.154 65 | Data::Peek: 0.53 66 | Getopt::Long: 2.58 67 | HTML::TreeBuilder: 5.07 68 | LWP::UserAgent: 6.78 69 | Socket: 2.038 70 | Time::HiRes: 1.9777 71 | XML::Simple: 2.25 72 | Text::CSV_XS: 1.60 73 | suggests: 74 | Data::Dumper: 2.189 75 | configure_requires: 76 | ExtUtils::MakeMaker: 0 77 | configure_recommends: 78 | ExtUtils::MakeMaker: 7.22 79 | configure_suggests: 80 | ExtUtils::MakeMaker: 7.72 81 | test_requires: 82 | Test::More: 0 83 | test_recommends: 84 | Test::More: 1.302209 85 | resources: 86 | license: http://dev.perl.org/licenses/ 87 | homepage: https://metacpan.org/pod/App::SpeedTest 88 | repository: https://github.com/Tux/speedtest 89 | bugtracker: https://github.com/Tux/speedtest/issues 90 | IRC: irc://irc.perl.org/#csv 91 | meta-spec: 92 | version: 1.4 93 | url: http://module-build.sourceforge.net/META-spec-v1.4.html 94 | -------------------------------------------------------------------------------- /sandbox/twiggish.pl: -------------------------------------------------------------------------------- 1 | use 5.10.0; 2 | use warnings; 3 | use strict; 4 | use LWP::UserAgent; 5 | 6 | ## switch to a maintained (more performant?) module 7 | use XML::Twig; 8 | 9 | use Data::Peek; 10 | ##### force the dump of $config, only for this test 11 | my $opt_v = 6; 12 | 13 | my $ua = LWP::UserAgent->new ( 14 | max_redirect => 2, 15 | agent => "Opera/25.00 opera 25", 16 | parse_head => 0, 17 | cookie_jar => {}, 18 | ); 19 | ###NEW THINGS FROM HERE ON 20 | ### 21 | my $client; 22 | my $times; 23 | my $downld; 24 | my $upld; 25 | #new 26 | my $ignore_ids; 27 | 28 | my %list; ## a global instead my %list = get_servers (); at line 385 29 | my $config = {}; ## a global 30 | 31 | get_config_and_servers_Twig (); 32 | 33 | ## SAME TEST BUT INVERTED ASSIGNMENT 34 | $config->{client} = $client or die "Config saw no client\n"; 35 | $config->{times} = $times or die "Config saw no times\n"; 36 | $config->{download} = $downld or die "Config saw no download\n"; 37 | $config->{upload} = $upld or die "Config saw no upload\n"; 38 | 39 | $config->{"server-config"}{"ignoreids"} = $ignore_ids 40 | or die "Config saw no ignore ids\n"; 41 | 42 | $opt_v > 5 and DDumper $config; 43 | 44 | ### ############################################################################ 45 | 46 | sub get_config_and_servers_Twig 47 | { 48 | my $url = "http://www.speedtest.net/speedtest-config.php"; 49 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 50 | $rsp->is_success or die "Cannot get config: ", $rsp->status_line, "\n"; 51 | 52 | ## 53 | my $twig_config = XML::Twig->new (twig_handlers => { 54 | "settings/client" => sub { 55 | map { $$client{$_} = $_[1]->att ($_) } 56 | qw{ ip isp ispdlavg isprating ispulavg lat loggedin lon rating }; 57 | }, 58 | # times seems not used by your program!! 59 | "settings/times" => sub { 60 | map { $$times{$_} = $_[1]->att ($_) } 61 | qw{ dl1 dl2 dl3 ul1 ul2 ul3 }; 62 | }, 63 | "settings/download" => sub { 64 | map { $$downld{$_} = $_[1]->att ($_) } 65 | qw{ initialtest mintestsize testlength threadsperurl }; 66 | }, 67 | "settings/upload" => sub { 68 | map { $$upld{$_} = $_[1]->att ($_) } 69 | qw{ initialtest maxchunkcount maxchunksize mintestsize 70 | ratio testlength threads threadsperurl }; 71 | }, 72 | # 73 | "settings/server-config" => sub { 74 | $ignore_ids = $_[1]->att ("ignoreids") }, 75 | }, 76 | ); 77 | 78 | $twig_config->parse ($rsp->content); 79 | 80 | # now get_servers 81 | 82 | my $url_servers = "http://www.speedtest.net/speedtest-servers-static.php"; 83 | my $rsp_servers = $ua->request (HTTP::Request->new (GET => $url_servers)); 84 | # ATTENTION the die was die "Cannot get config: " AND NOT get servers.. 85 | $rsp_servers->is_success or 86 | die "Cannot get servers ", $rsp_servers->status_line, "\n"; 87 | my $twig_servers = XML::Twig->new (twig_handlers => { 88 | "settings/servers/server" => sub { 89 | $list{$_[1]->att ("id")} = { 90 | map { $_ => $_[1]->att ($_) } 91 | qw{ cc country lat lon name sponsor url url2 }}; 92 | }, 93 | }); 94 | $twig_servers->parse ($rsp_servers->content); 95 | 96 | # HERE IS TOO SOON.....$opt_v > 5 and DDumper $config;##was $xml->{settings} 97 | #return $xml->{settings}; 98 | } # get_config_and_servers_Twig 99 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 0.31 2025-03-17 2 | * 3 | 4 | 0.30 2025-01-06 5 | * Add SECURITY.md 6 | * Fix document encoding 7 | 8 | 0.29 2024-06-18 9 | * Make requirements more specific based on known CVE's 10 | * Work around groff-1.24 11 | * It is 2024 12 | * Tested with perl-5.40 13 | 14 | 0.28 2022-01-01 15 | * It is 2021 - No changes in 2021 16 | * It is 2022 17 | 18 | 0.27 2020-12-23 19 | * Some man pages are not the same as other man pages 20 | 21 | 0.26 2020-12-17 22 | * Fix META to include bugtracker 23 | 24 | 0.25 2020-04-14 25 | * Require List::Util for consistency 26 | * Add static docs for github 27 | * Allow multiple -s ID 28 | 29 | 0.24 2020-04-10 30 | * Switch to Pod::Text when nroff is not available 31 | 32 | 0.23 2020-04-09 33 | * Move pod tests to xt 34 | * Add simple tests for basic CLI 35 | * Make ping-list-length settable 36 | * Do not truncate server list when a specific server is selected 37 | * It's 2020 38 | 39 | 0.22 2019-09-02 40 | * Add --list-cc 41 | * Add cpanfile 42 | * Add -U / --skip-undef 43 | * Provide cpanfile 44 | * Add help and options to examples/speedtest-graph.pl 45 | * Fix warning when using --no-upload or --no-download (issue#13) 46 | 47 | 0.21 2019-03-21 48 | * Add --csv-eol-unix 49 | 50 | 0.20 2019-01-01 51 | * Versions 52 | * It's 2017 53 | * Show a ranked summary of the tries with --try 54 | * It's 2018 55 | * Deal with proxy settings in env 56 | * Add index to list/ping lists 57 | * It's 2019 58 | 59 | 0.19 2016-01-02 60 | * Try multiple addresses for the server list RT#110400 61 | * It's 2016 62 | 63 | 0.18 2015-10-10 64 | * Add --prtg option 65 | * Add --bytes option 66 | * Cleanup code to calculate average 67 | 68 | 0.17 2015-03-27 69 | * Add graph example 70 | * Update version in .pm 71 | 72 | 0.16 2015-02-11 73 | * Set a limit of 40 of the number of hosts to ping 74 | * Remove perl recommendation from META as it breaks cpan clients 75 | 76 | 0.15 2015-01-15 77 | * Renamed to speedtest 78 | * Do not report/show origin on --list & --ping 79 | * Documentation/Manual + --man and --info 80 | * Put on CPAN 81 | 82 | 0.12 2015-01-24 83 | * Add --csv 84 | * Update README 85 | 86 | 0.11 2015-01-21 87 | * Add --timeout 88 | * Update copyright 89 | * Warning about speedtest not being ping 90 | * Data::Peek optional (but still recommended) 91 | * Fallback to distance in absence of GEO-IP 92 | 93 | 0.10 2014-12-17 94 | * Add latency for --mini and --url 95 | * Optionally show server IP 96 | * Don't show full path in help 97 | * Fix typo in help (issue#4) 98 | * Empty line separation in multi-host tests (issue#7) 99 | * Make README more github-like 100 | * Add Debian info for requirements 101 | * Contribution update 102 | * Browser-neutral agent-ident 103 | 104 | 0.09 2014-12-02 105 | * Improve --help 106 | * Add --simple (alias for -v0) 107 | * Implement --mini 108 | 109 | 0.08 2014-11-30 110 | * Report latency in ms 111 | * Shorten timeouts on detecting server speeds 112 | 113 | 0.07 2014-11-26 114 | * Allow fetching list off ALL servers 115 | * Country codes (upper case) 116 | * Ignore country-code when it does not apply 117 | 118 | 0.06 2014-11-18 119 | * Add option --one-line 120 | * Allow specifying a server-url 121 | 122 | 0.05 2014-10-14 123 | * Allow test on multiple servers 124 | * Put on github 125 | 126 | 0.04 2014-10-10 127 | * Require 5.12.0 instead of 5.16.3 128 | * Options -q and -Q accept count 129 | * Verbose levels 130 | * Values for min and max speeds druing test 131 | * Speed report improvement 132 | * Use random data in upload 133 | * Remove ignored servers from list 134 | 135 | 0.03 2014-10-10 136 | * First checkin to git 137 | -------------------------------------------------------------------------------- /SECURITY.md: -------------------------------------------------------------------------------- 1 | # Security Policy for the App::SpeedTest distribution. 2 | 3 | Report issues via email at: H.Merijn Brand . 4 | 5 | 6 | This is the Security Policy for App::SpeedTest. 7 | 8 | The latest version of the Security Policy can be found in the 9 | [git repository for App::SpeedTest](https://github.com/Tux/speedtest). 10 | 11 | This text is based on the CPAN Security Group's Guidelines for Adding 12 | a Security Policy to Perl Distributions (version 1.0.0) 13 | https://security.metacpan.org/docs/guides/security-policy-for-authors.html 14 | 15 | # How to Report a Security Vulnerability 16 | 17 | Security vulnerabilities can be reported by e-mail to the current 18 | project maintainers at H.Merijn Brand . 19 | 20 | Please include as many details as possible, including code samples 21 | or test cases, so that we can reproduce the issue. Check that your 22 | report does not expose any sensitive data, such as passwords, 23 | tokens, or personal information. 24 | 25 | If you would like any help with triaging the issue, or if the issue 26 | is being actively exploited, please copy the report to the CPAN 27 | Security Group (CPANSec) at . 28 | 29 | Please *do not* use the public issue reporting system on RT or 30 | GitHub issues for reporting security vulnerabilities. 31 | 32 | Please do not disclose the security vulnerability in public forums 33 | until past any proposed date for public disclosure, or it has been 34 | made public by the maintainers or CPANSec. That includes patches or 35 | pull requests. 36 | 37 | For more information, see 38 | [Report a Security Issue](https://security.metacpan.org/docs/report.html) 39 | on the CPANSec website. 40 | 41 | ## Response to Reports 42 | 43 | The maintainer(s) aim to acknowledge your security report as soon as 44 | possible. However, this project is maintained by a single person in 45 | their spare time, and they cannot guarantee a rapid response. If you 46 | have not received a response from them within 10 days, then 47 | please send a reminder to them and copy the report to CPANSec at 48 | . 49 | 50 | Please note that the initial response to your report will be an 51 | acknowledgement, with a possible query for more information. It 52 | will not necessarily include any fixes for the issue. 53 | 54 | The project maintainer(s) may forward this issue to the security 55 | contacts for other projects where we believe it is relevant. This 56 | may include embedded libraries, system libraries, prerequisite 57 | modules or downstream software that uses this software. 58 | 59 | They may also forward this issue to CPANSec. 60 | 61 | # Which Software This Policy Applies To 62 | 63 | Any security vulnerabilities in App::SpeedTest are covered by this policy. 64 | 65 | Security vulnerabilities are considered anything that allows users 66 | to execute unauthorised code, access unauthorised resources, or to 67 | have an adverse impact on accessibility or performance of a system. 68 | 69 | Security vulnerabilities in upstream software (embedded libraries, 70 | prerequisite modules or system libraries, or in Perl), are not 71 | covered by this policy unless they affect App::SpeedTest, or App::SpeedTest can 72 | be used to exploit vulnerabilities in them. 73 | 74 | Security vulnerabilities in downstream software (any software that 75 | uses App::SpeedTest, or plugins to it that are not included with the 76 | App::SpeedTest distribution) are not covered by this policy. 77 | 78 | ## Supported Versions of App::SpeedTest 79 | 80 | The maintainer(s) will only commit to releasing security fixes for 81 | the latest version of App::SpeedTest. 82 | 83 | Note that the App::SpeedTest project only supports major versions of Perl 84 | released in the past 5 years, even though App::SpeedTest will run on 85 | older versions of Perl. If a security fix requires us to increase 86 | the minimum version of Perl that is supported, then we may do so. 87 | 88 | # Installation and Usage Issues 89 | 90 | The distribution metadata specifies minimum versions of 91 | prerequisites that are required for App::SpeedTest to work. However, some 92 | of these prerequisites may have security vulnerabilities, and you 93 | should ensure that you are using up-to-date versions of these 94 | prerequisites. 95 | 96 | Where security vulnerabilities are known, the metadata may indicate 97 | newer versions as recommended. 98 | 99 | ## Usage 100 | 101 | Please see the software documentation for further information. 102 | -------------------------------------------------------------------------------- /doc/make-doc.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.038002; 4 | use warnings; 5 | 6 | our $VERSION = "0.05 - 20250116"; 7 | our $CMD = $0 =~ s{.*/}{}r; 8 | 9 | sub usage { 10 | my $err = shift and select STDERR; 11 | say "usage: $CMD [-v[#]] [--pod]"; 12 | exit $err; 13 | } # usage 14 | 15 | use Cwd; 16 | use Pod::Text; 17 | use File::Find; 18 | use List::Util qw( first ); 19 | use Encode qw( encode decode ); 20 | use Getopt::Long qw(:config bundling); 21 | GetOptions ( 22 | "help|?" => sub { usage (0); }, 23 | "V|version" => sub { say "$CMD [$VERSION]"; exit 0; }, 24 | 25 | "p|pod!" => \ my $pod, 26 | 27 | "v|verbose:1" => \(my $opt_v = 0), 28 | ) or usage (1); 29 | 30 | -d "doc" or mkdir "doc", 0775; 31 | 32 | my @pm; # Do *NOT* scan t/ 33 | -d "lib" and find (sub { m/\.pm$/ and push @pm => $File::Find::name }, "lib"); 34 | @pm or @pm = sort glob "*.pm"; 35 | if (@pm == 0 and open my $fh, "<", "Makefile.PL") { 36 | my @mpl = <$fh>; 37 | close $fh; 38 | if (my @vf = grep m/\bVERSION_FROM\s*=>\s*(.*)/) { 39 | push @pm => $vf[0] =~ s/["']//gr; 40 | last; 41 | } 42 | if (my @ef = grep m/\bEXE_FILES\s*=>\s*\[(.*)\]/) { 43 | push @pm => eval qq{($1)}; 44 | last; 45 | } 46 | } 47 | 48 | push @pm => @ARGV; 49 | @pm = sort grep { ! -l $_ } @pm; 50 | @pm or die "No documentation source files found\n"; 51 | 52 | if ($opt_v) { 53 | say "Using these sources for static documentation:"; 54 | say " $_" for @pm; 55 | } 56 | 57 | sub dext { 58 | my ($pm, $ext) = @_; 59 | my $fn = $pm =~ s{^lib/}{}r 60 | =~ s{^(?:App|scripts|examples)/}{}r 61 | =~ s{/}{-}gr 62 | =~ s{(?:\.pm)?$}{.$ext}r # examples, scripts 63 | =~ s{^(?=CSV_XS\.)}{Text-}r 64 | =~ s{^(?=Peek\.)} {Data-}r 65 | =~ s{^(?=Read\.)} {Spreadsheet-}r 66 | =~ s{^(SpeedTest)} {\L$1}ri 67 | =~ s{^}{doc/}r; 68 | getcwd =~ m/Config-Perl/ and 69 | $fn =~ s{doc/\K}{Config-Perl-}; 70 | $fn; 71 | } # dext 72 | 73 | my %enc; 74 | my %pod; 75 | { # Check if file had pod at all 76 | foreach my $pm (@pm) { 77 | open my $fh, ">", \$pod{$pm}; 78 | Pod::Text->new->parse_from_file ($pm, $fh); 79 | close $fh; 80 | 81 | $pod && $pod{$pm} and link $pm => dext ($pm, "pod"); 82 | } 83 | } 84 | 85 | eval { require Pod::Checker; }; 86 | if ($@) { 87 | warn "Cannot convert pod to markdown: $@\n"; 88 | } 89 | else { 90 | my $fail = 0; 91 | my %ignore_empty = ( 92 | "lib/DBI/ProfileData.pm" => 7, 93 | "Peek.pm" => 4, 94 | "Read.pm" => 5, 95 | ); 96 | foreach my $pm (@pm) { 97 | open my $eh, ">", \my $err; 98 | my $pc = Pod::Checker->new (); 99 | my $ok = $pc->parse_from_file ($pm, $eh); 100 | close $eh; 101 | $enc{$pm} = $pc->{encoding}; 102 | $err && $err =~ m/\S/ or next; 103 | # Ignore warnings here on empty previous paragraphs as it 104 | # uses =head2 for all possible invocation alternatives 105 | if (my $ni = $ignore_empty{$pm}) { 106 | my $pat = qr{ WARNING: empty section }; 107 | my @err = split m/\n+/ => $err; 108 | my @wrn = grep m/$pat/ => @err; 109 | @wrn == $ni and $err = join "\n" => grep !m/$pat/ => @err; 110 | $err =~ m/\S/ or next; 111 | } 112 | say $pm; 113 | say $err; 114 | $err =~ m/ ERROR:/ and $fail++; 115 | } 116 | $fail and die "POD has errors. Fix them first!\n"; 117 | } 118 | 119 | eval { require Pod::Markdown; }; 120 | if ($@) { 121 | warn "Cannot convert pod to markdown: $@\n"; 122 | } 123 | else { 124 | foreach my $pm (@pm) { 125 | my $md = dext ($pm, "md"); 126 | my $enc = $enc{$pm} ? "encoding($enc{$pm})" : "bytes"; 127 | printf STDERR "%-43s <- %s (%s)\n", $md, $pm, $enc if $opt_v; 128 | open my $ph, "<:$enc", $pm; 129 | my $p = Pod::Markdown->new (); 130 | $p->output_string (\my $m); 131 | $p->parse_file ($ph); 132 | close $ph; 133 | 134 | $m && $m =~ m/\S/ or next; 135 | if (open my $old, "<:encoding(utf-8)", $md) { 136 | local $/; 137 | $m eq scalar <$old> and next; 138 | } 139 | $opt_v and say "Writing $md (", length $m, ")"; 140 | open my $oh, ">:encoding(utf-8)", $md or die "$md: $!\n"; 141 | print $oh $m; 142 | close $oh; 143 | } 144 | } 145 | 146 | eval { require Pod::Html; }; 147 | if ($@) { 148 | warn "Cannot convert pod to HTML: $@\n"; 149 | } 150 | else { 151 | foreach my $pm (@pm) { 152 | $pod{$pm} or next; # Skip HTML for files without pod 153 | my $html = dext ($pm, "html"); 154 | printf STDERR "%-43s <- %s (%s)\n", $html, $pm, $enc{$pm} // "-" if $opt_v; 155 | my $tf = "x_$$.html"; 156 | unlink $tf if -e $tf; 157 | Pod::Html::pod2html ("--infile=$pm", "--outfile=$tf", "--quiet"); 158 | my $h = do { local (@ARGV, $/) = ($tf); <> } =~ s/[\r\n\s]+\z/\n/r; 159 | unlink $tf if -e $tf; 160 | $h && $h =~ m/\S/ or next; 161 | if (open my $old, "<:encoding(utf-8)", $html) { 162 | local $/; 163 | $h eq scalar <$old> and next; 164 | } 165 | $opt_v and say "Writing $html (", length $h, ")"; 166 | open my $oh, ">:encoding(utf-8)", $html or die "$html: $!\n"; 167 | print $oh $h; 168 | close $oh; 169 | } 170 | unlink "pod2htmd.tmp"; 171 | } 172 | 173 | eval { require Pod::Man; }; 174 | if ($@) { 175 | warn "Cannot convert pod to man: $@\n"; 176 | } 177 | else { 178 | my $nrf = first { -x } 179 | map { "$_/nroff" } 180 | grep { length and -d } 181 | split m/:+/ => $ENV{PATH}; 182 | $opt_v and say $nrf; 183 | foreach my $pm (@pm) { 184 | my $man = dext ($pm, "3"); 185 | printf STDERR "%-43s <- %s\n", $man, $pm if $opt_v; 186 | open my $fh, ">", \my $p; 187 | Pod::Man->new (section => 3)->parse_from_file ($pm, $fh); 188 | close $fh; 189 | $p && $p =~ m/\S/ or next; 190 | $p = decode ("utf-8", $p); 191 | if (open my $old, "<:encoding(utf-8)", $man) { 192 | local $/; 193 | $p eq scalar <$old> and next; 194 | } 195 | $opt_v and say "Writing $man (", length $p, ")"; 196 | open my $oh, ">:encoding(utf-8)", $man or die "$man: $!\n"; 197 | print $oh $p; 198 | close $oh; 199 | $nrf or next; 200 | if (open my $fh, "-|", $nrf, "-mandoc", "-T", "utf8", $man) { 201 | local $/; 202 | $p = <$fh>; 203 | close $fh; 204 | $p = decode ("utf-8", $p 205 | =~ s{(?:\x{02dc}|\xcb\x9c )}{~}grx # ~ 206 | =~ s{(?:\x{02c6}|\xcb\x86 )}{^}grx # ^ 207 | =~ s{(?:\x{2018}|\xe2\x80\x98 208 | |\x{2019}|\xe2\x80\x99 )}{'}grx # ' 209 | =~ s{(?:\x{201c}|\xe2\x80\x9c 210 | |\x{201d}|\xe2\x80\x9d )}{"}grx # " 211 | =~ s{(?:\x{2212}|\xe2\x88\x92 212 | |\x{2010}|\xe2\x80\x90 )}{-}grx # - 213 | =~ s{(?:\x{2022}|\xe2\x80\xa2 )}{*}grx # BULLET 214 | =~ s{(?:\e\[|\x9b)[0-9;]*m} {}grx); # colors 215 | } 216 | 217 | my $mfn = $man =~ s/3$/man/r; 218 | if (open my $mh, "<:encoding(utf-8)", $mfn) { 219 | local $/; 220 | $p eq <$mh> and next; 221 | } 222 | $opt_v and say "Writing $mfn (", length $p, ")"; 223 | open $oh, ">:encoding(utf-8)", $mfn or die "$mfn: $!\n"; 224 | # nroff / troff / grotty cause double-encoding 225 | print $oh encode ("iso-8859-1", decode ("utf-8", $p)); 226 | close $oh; 227 | } 228 | } 229 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2006, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 202 | -------------------------------------------------------------------------------- /sandbox/speedtest2.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | # speedtest.pl - test network speed using speedtest.net 4 | # (m)'14 [2014-12-02] Copyright H.M.Brand 2014-2015 5 | 6 | use 5.10.0; 7 | use warnings; 8 | 9 | my $VERSION = "0.09"; 10 | 11 | sub usage 12 | { 13 | my $err = shift and select STDERR; 14 | (my $p = $0) =~ s{.*/}{}; 15 | print <<"EOH"; 16 | usage: $p [ --no-geo | --country=NL ] [ --list | --ping ] [ options ] 17 | --geo use Geo location (default true) for closest testserver 18 | --all include *all* servers (default only in own country) 19 | -c --country=IS use ISO country code for closest test server 20 | -1 --one-line show summary in one line 21 | 22 | -l --list list test servers in chosen country sorted by distance 23 | -p --ping list test servers in chosen country sorted by latency 24 | --url show server url in list 25 | 26 | -s --server=nnn use testserver with id nnn 27 | --url=sss use specific server url (do not scan) ext php 28 | --mini=sss use specific server url (do not scan) ext from sss 29 | --download test download speed (default true) 30 | --upload test upload speed (default true) 31 | -q --quick[=20] do a quick test (only the fastest 20 tests) 32 | -Q --realquick do a real quick test (only the fastest 10 tests) 33 | -T --try[=5] try all tests on the n fastest servers 34 | 35 | -v --verbose[=1] set verbosity 36 | --simple alias for -v0 37 | --ip show IP for server 38 | -V --version show version and exit 39 | -? --help show this help 40 | 41 | $p --list 42 | $p --ping --country=BE 43 | $p 44 | $p -s 4358 45 | $p --url=http://ookla.extraip.net 46 | $p -q --no-download 47 | $p -Q --no-upload 48 | 49 | EOH 50 | exit $err; 51 | } # usage 52 | 53 | use Getopt::Long qw(:config bundling); 54 | my $opt_c = ""; 55 | my $opt_v = 1; 56 | my $opt_d = 1; 57 | my $opt_u = 1; 58 | my $opt_g = 1; 59 | my $opt_q = 0; 60 | my $opt_T = 1; 61 | GetOptions ( 62 | "help|h|?" => sub { usage (0); }, 63 | "V|version!" => sub { say $VERSION; exit 0; }, 64 | "v|verbose:2" => \$opt_v, 65 | "simple!" => sub { $opt_v = 0; }, 66 | 67 | "all!" => \my $opt_a, 68 | "g|geo!" => \$opt_g, 69 | "c|cc|country=s" => \$opt_c, 70 | "1|one-line!" => \my $opt_1, 71 | 72 | "l|list!" => \my $list, 73 | "p|ping!" => \my $ping, 74 | "url:s" => \my $url, 75 | "ip!" => \my $ip, 76 | 77 | "T|try:5" => \$opt_T, 78 | "s|server=i" => \my $server, 79 | "d|download!" => \$opt_d, 80 | "u|upload!" => \$opt_u, 81 | "q|quick|fast:20" => \$opt_q, 82 | "Q|realquick:10" => \$opt_q, 83 | 84 | "m|mini=s" => \my $mini, 85 | "source=s" => \my $source, # NYI 86 | ) or usage (1); 87 | 88 | use LWP::UserAgent; 89 | use XML::Simple; 90 | use HTML::TreeBuilder; 91 | use Time::HiRes qw( gettimeofday tv_interval ); 92 | use Math::Trig; 93 | use Data::Peek; 94 | use Socket qw( inet_ntoa ); 95 | 96 | my $ua = LWP::UserAgent->new ( 97 | max_redirect => 2, 98 | agent => "Opera/25.00 opera 25", 99 | parse_head => 0, 100 | cookie_jar => {}, 101 | ); 102 | 103 | binmode STDOUT, ":encoding(utf-8)"; 104 | 105 | # Speedtest.net defines Mbit/s and kbit/s using 1000 as multiplier, 106 | # https://support.speedtest.net/entries/21057567-What-do-mbps-and-kbps-mean- 107 | my $k = 1000; 108 | 109 | my $config = get_config (); 110 | my $client = $config->{"client"} or die "Config saw no client\n"; 111 | my $times = $config->{"times"} or die "Config saw no times\n"; 112 | my $downld = $config->{"download"} or die "Config saw no download\n"; 113 | my $upld = $config->{"upload"} or die "Config saw no upload\n"; 114 | $opt_v > 3 and DDumper { 115 | client => $client, 116 | times => $times, 117 | down => $downld, 118 | up => $upld, 119 | }; 120 | 121 | if ($url || $mini) { 122 | $opt_g = 0; 123 | $opt_c = ""; 124 | $server = ""; 125 | my $ping = 0.05; 126 | my $name = ""; 127 | my $sponsor = "CLI"; 128 | if ($mini) { 129 | my $t0 = [ gettimeofday ]; 130 | my $rsp = $ua->request (HTTP::Request->new (GET => $mini)); 131 | $ping = tv_interval ($t0); 132 | $rsp->is_success or die $rsp->status_line . "\n"; 133 | my $tree = HTML::TreeBuilder->new (); 134 | $tree->parse_content ($rsp->content) or die "Cannot parse\n"; 135 | my $ext = ""; 136 | for ($tree->look_down (_tag => "script")) { 137 | my $c = ($_->content)[0] or next; 138 | ref $c eq "ARRAY" && $c->[0] && 139 | $c->[0] =~ m/\b (?: upload_? | config ) Extension 140 | \s*: \s* "? ([^"\s]+) /xi or next; 141 | $ext = $1; 142 | last; 143 | } 144 | $ext or die "No ext found\n"; 145 | ($url = $mini) =~ s{/*$}{/speedtest/upload.$ext}; 146 | $sponsor = $_->as_text for $tree->look_down (_tag => "title"); 147 | $name ||= $_->as_text for $tree->look_down (_tag => "h1"); 148 | $name ||= "Speedtest mini"; 149 | } 150 | else { 151 | $name = "Local"; 152 | $url =~ m{/\w+\.\w+$} or $url =~ s{/?$}{/speedtest/upload.php}; 153 | my $t0 = [ gettimeofday ]; 154 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 155 | $ping = tv_interval ($t0); 156 | $rsp->is_success or die $rsp->status_line . "\n"; 157 | } 158 | (my $host = $url) =~ s{^\w+://([^/]+)(?:/.*)?}{$1}; 159 | $url = { 160 | cc => "", 161 | country => "", 162 | dist => "0.0", 163 | host => $host, 164 | id => 0, 165 | lat => "0.0000", 166 | lon => "0.0000", 167 | name => $name, 168 | ping => $ping * 1000, 169 | sponsor => $sponsor, 170 | url => $url, 171 | url2 => $url, 172 | }; 173 | } 174 | 175 | if ($server) { 176 | $opt_c = ""; 177 | $opt_a = 1; 178 | } 179 | else { 180 | if ($opt_c) { 181 | $opt_c = uc $opt_c; 182 | } 183 | elsif ($opt_g) { # Try GeoIP 184 | $opt_v > 5 and say STDERR "Testing Geo location"; 185 | my $url = "http://www.geoiptool.com"; 186 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 187 | if ($rsp->is_success) { 188 | my $tree = HTML::TreeBuilder->new (); 189 | if ($tree->parse_content ($rsp->content)) { 190 | foreach my $e ($tree->look_down (_tag => "div", class => "data-item")) { 191 | $opt_v > 2 and say STDERR $e->as_text; 192 | $e->as_text =~ m{Country code(?:\s*:)?\s*([A-Za-z]+)}i or next; 193 | $opt_c = uc $1; 194 | last; 195 | } 196 | } 197 | } 198 | } 199 | $opt_c ||= "IS"; # Iceland seems like a nice default :P 200 | } 201 | 202 | $opt_v and say STDERR "Testing for $client->{ip} : $client->{isp} ($opt_c)"; 203 | 204 | if ($list) { 205 | my %list = servers (); 206 | my @fld = qw( id sponsor name dist ); 207 | my $fmt = "%5d: %-30.30s %-15.15s %7.2f km\n"; 208 | if (defined $url) { 209 | push @fld, "url0"; 210 | $fmt .= " %s\n"; 211 | } 212 | printf $fmt, @{$list{$_}}{@fld} 213 | for sort { $list{$a}{dist} <=> $list{$b}{dist} } keys %list; 214 | exit 0; 215 | } 216 | 217 | if ($ping) { 218 | my @fld = qw( id sponsor name dist ping ); 219 | my $fmt = "%5d: %-30.30s %-15.15s %7.2f km %7.0f ms\n"; 220 | if (defined $url) { 221 | push @fld, "url0"; 222 | $fmt .= " %s\n"; 223 | } 224 | printf $fmt, @{$_}{@fld} for servers_by_ping (); 225 | exit 0; 226 | } 227 | 228 | # default action is to run on fastest server 229 | my @srvrs = $url ? ($url) : servers_by_ping (); 230 | my @hosts = grep { $_->{ping} < 1000 } @srvrs; 231 | @hosts > $opt_T and splice @hosts, $opt_T; 232 | foreach my $host (@hosts) { 233 | $host->{sponsor} =~ s/\s+$//; 234 | if ($opt_v) { 235 | my $s = ""; 236 | if ($ip) { 237 | (my $h = $host->{url}) =~ s{^\w+://([^/]+)(?:/.*)?$}{$1}; 238 | my @ad = gethostbyname ($h); 239 | $s = join " " => "", map { inet_ntoa ($_) } @ad[4 .. $#ad]; 240 | } 241 | @hosts > 1 and print STDERR "\n"; 242 | printf STDERR "Using %4d: %6.2f km %7.0f ms%s %s\n", 243 | $host->{id}, $host->{dist}, $host->{ping}, $s, $host->{sponsor}; 244 | } 245 | $opt_v > 3 and DDumper $host; 246 | (my $base = $host->{url}) =~ s{/[^/]+$}{}; 247 | 248 | my $dl = "-"; 249 | if ($opt_d) { 250 | $opt_v and print STDERR "Test download "; 251 | # http://ookla.extraip.net/speedtest/random350x350.jpg 252 | my @url = map { ("$base/random${_}x${_}.jpg") x 4 } 253 | 350, 500, 750, 1000, 1500, 2000, 2500, 3000, 3500, 4000; 254 | my @mnmx = (999999999.999, 0.000); 255 | my $size = 0; 256 | my $time = 0; 257 | $opt_q and splice @url, $opt_q; 258 | foreach my $url (@url) { 259 | my $req = HTTP::Request->new (GET => $url); 260 | my $t0 = [ gettimeofday ]; 261 | my $rsp = $ua->request ($req); 262 | my $elapsed = tv_interval ($t0); 263 | unless ($rsp->is_success) { 264 | warn "$url: ", $rsp->status_line, "\n"; 265 | next; 266 | } 267 | my $sz = length $rsp->content; 268 | $size += $sz; 269 | $time += $elapsed; 270 | my $speed = 8 * $sz / $elapsed / $k / $k; 271 | $speed < $mnmx[0] and $mnmx[0] = $speed; 272 | $speed > $mnmx[1] and $mnmx[1] = $speed; 273 | $opt_v and print STDERR "."; 274 | $opt_v > 2 and printf STDERR "%12.3f %s\n", $speed, $url; 275 | } 276 | $dl = sprintf "%8.3f Mbit/s", 8 * ($size / $time) / $k / $k; 277 | $opt_q && $opt_v and print " " x (40 - $opt_q); 278 | $opt_v || !$opt_1 and print "Download: $dl\n"; 279 | $opt_v > 1 and printf " Received %10.2f kb in %9.3f s. [%8.3f - %8.3f]\n", 280 | $size / 1024, $time, @mnmx; 281 | } 282 | 283 | my $ul = "-"; 284 | if ($opt_u) { 285 | $opt_v and print STDERR "Test upload "; 286 | my @data = (0 .. 9, "a" .. "Z", "a" .. "z"); # Random pure ASCII data 287 | my $data = join "" => map { $data[int rand $#data] } 0 .. 4192; 288 | $data = "content1=".($data x 1024); # Total length just over 4 Mb 289 | my @mnmx = (999999999.999, 0.000); 290 | my $size = 0; 291 | my $time = 0; 292 | my $url = $host->{url}; # .php, .asp, .aspx, .jsp 293 | # see $upld->{mintestsize} and $upld->{maxchunksize} ? 294 | my @size = map { $_ * 1000 } 295 | ((256) x 10, (512) x 10, (1024) x 10, (4192) x 10); 296 | $opt_q and splice @size, $opt_q; 297 | foreach my $sz (@size) { 298 | my $req = HTTP::Request->new (POST => $url); 299 | $req->content (substr $data, 0, $sz); 300 | my $t0 = [ gettimeofday ]; 301 | my $rsp = $ua->request ($req); 302 | my $elapsed = tv_interval ($t0); 303 | unless ($rsp->is_success) { 304 | warn "$url: ", $rsp->status_line, "\n"; 305 | next; 306 | } 307 | $size += $sz; 308 | $time += $elapsed; 309 | my $speed = 8 * $sz / $elapsed / $k / $k; 310 | $speed < $mnmx[0] and $mnmx[0] = $speed; 311 | $speed > $mnmx[1] and $mnmx[1] = $speed; 312 | $opt_v and print STDERR "."; 313 | $opt_v > 2 and printf STDERR "%12.3f %s (%7d)\n", $speed, $url, $sz; 314 | } 315 | $ul = sprintf "%8.3f Mbit/s", 8 * ($size / ($time || 1)) / $k / $k; 316 | $opt_q && $opt_v and print " " x (40 - $opt_q); 317 | $opt_v || !$opt_1 and print "Upload: $ul\n"; 318 | $opt_v > 1 and printf " Sent %10.2f kb in %9.3f s. [%8.3f - %8.3f]\n", 319 | $size / 1024, $time, @mnmx; 320 | } 321 | $opt_1 and print "DL: $dl, UL: $ul\n"; 322 | } 323 | 324 | ### ############################################################################ 325 | 326 | sub get_config 327 | { 328 | my $url = "http://www.speedtest.net/speedtest-config.php"; 329 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 330 | $rsp->is_success or die "Cannot get config: ", $rsp->status_line, "\n"; 331 | my $xml = XMLin ( $rsp->content, 332 | keeproot => 1, 333 | noattr => 0, 334 | keyattr => [ ], 335 | suppressempty => "", 336 | ); 337 | $opt_v > 5 and DDumper $xml->{settings}; 338 | return $xml->{settings}; 339 | } # get_config 340 | 341 | sub get_servers 342 | { 343 | # my $url = "http://www.speedtest.net/speedtest-servers.php"; 344 | my $url = "http://www.speedtest.net/speedtest-servers-static.php"; 345 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 346 | $rsp->is_success or die "Cannot get config: ", $rsp->status_line, "\n"; 347 | my $xml = XMLin ( $rsp->content, 348 | keeproot => 1, 349 | noattr => 0, 350 | keyattr => [ ], 351 | suppressempty => "", 352 | ); 353 | # 4601 => { 354 | # cc => 'NL', 355 | # country => 'Netherlands', 356 | # dist => '38.5028663935342602', # added later 357 | # id => 4601, 358 | # lat => '52.2167', 359 | # lon => '5.9667', 360 | # name => 'Apeldoorn', 361 | # sponsor => 'Solcon Internetdiensten N.V.', 362 | # url => 'http://speedtest.solcon.net/speedtest/upload.php', 363 | # url2 => 'http://ooklaspeedtest.solcon.net/speedtest/upload.php' 364 | # }, 365 | 366 | return map { $_->{id} => $_ } @{$xml->{settings}{servers}{server}}; 367 | } # get_servers 368 | 369 | sub distance 370 | { 371 | my ($lat_c, $lon_c, $lat_s, $lon_s) = @_; 372 | my $rad = 6371; # km 373 | 374 | # Convert angles from degrees to radians 375 | my $dlat = deg2rad ($lat_s - $lat_c); 376 | my $dlon = deg2rad ($lon_s - $lon_c); 377 | 378 | my $x = sin ($dlat / 2) * sin ($dlat / 2) + 379 | cos (deg2rad ($lat_c)) * cos (deg2rad ($lat_s)) * 380 | sin ($dlon / 2) * sin ($dlon / 2); 381 | 382 | return 6371 * 2 * atan2 (sqrt ($x), sqrt (1 - $x)); # km 383 | } # distance 384 | 385 | sub servers 386 | { 387 | my %list = get_servers (); 388 | if (my $iid = $config->{"server-config"}{ignoreids}) { 389 | $opt_v > 3 and warn "Removing servers $iid from server list\n"; 390 | delete @list{split m/\s*,\s*/ => $iid}; 391 | } 392 | $opt_a or delete @list{grep { $list{$_}{cc} ne $opt_c } keys %list}; 393 | %list or die "No servers in $opt_c found\n"; 394 | for (values %list) { 395 | $_->{dist} = distance ($client->{lat}, $client->{lon}, 396 | $_->{lat}, $_->{lon}); 397 | ($_->{url0} = $_->{url}) =~ s{/speedtest/upload.*}{}; 398 | $opt_v > 7 and DDumper $_; 399 | } 400 | return %list; 401 | } # servers 402 | 403 | sub servers_by_ping 404 | { 405 | my %list = servers; 406 | $opt_v > 1 and say STDERR "Finding fastest host out of @{[scalar keys %list]} hosts for $opt_c ..."; 407 | my $pa = LWP::UserAgent->new ( 408 | max_redirect => 2, 409 | agent => "Opera/25.00 opera 25", 410 | parse_head => 0, 411 | cookie_jar => {}, 412 | timeout => 15, 413 | ); 414 | foreach my $h (values %list) { 415 | my $t = 0; 416 | if ($server and $h->{id} != $server) { 417 | $h->{ping} = 40000; 418 | next; 419 | } 420 | $opt_v > 5 and printf STDERR "? %4d %-20.20s %s\n", 421 | $h->{id}, $h->{sponsor}, $h->{url}; 422 | my $req = HTTP::Request->new (GET => "$h->{url}/latency.txt"); 423 | for (0 .. 3) { 424 | my $t0 = [ gettimeofday ]; 425 | my $rsp = $pa->request ($req); 426 | my $elapsed = tv_interval ($t0); 427 | $opt_v > 8 and printf STDERR "%4d %9.2f\n", $_, $elapsed; 428 | if ($elapsed >= 15) { 429 | $t = 40; 430 | last; 431 | } 432 | $t += ($rsp->is_success ? $elapsed : 1000); 433 | } 434 | $h->{ping} = $t * 1000; # report in ms 435 | } 436 | return sort { $a->{ping} <=> $b->{ping} 437 | || $a->{dist} <=> $b->{dist} } values %list; 438 | } # servers_by_ping 439 | -------------------------------------------------------------------------------- /doc/speedtest.md: -------------------------------------------------------------------------------- 1 | # NAME 2 | 3 | App::SpeedTest - Command-line interface to speedtest.net 4 | 5 | # SYNOPSIS 6 | 7 | $ speedtest [ --no-geo | --country=NL ] [ --list | --ping ] [ options ] 8 | 9 | $ speedtest --list 10 | $ speedtest --ping --country=BE 11 | $ speedtest 12 | $ speedtest -s 4358 13 | $ speedtest --url=http://ookla.extraip.net 14 | $ speedtest -q --no-download 15 | $ speedtest -Q --no-upload 16 | 17 | # DESCRIPTION 18 | 19 | The provided perl script is a command-line interface to the 20 | [speedtest.net](http://www.speedtest.net/) infrastructure so that 21 | flash is not required 22 | 23 | It was written to feature the functionality that speedtest.net offers 24 | without the overhead of flash or java and the need of a browser. 25 | 26 | # Raison-d'être 27 | 28 | The tool is there to give you a quick indication of the achievable 29 | throughput of your current network. That can drop dramatically if 30 | you are behind (several) firewalls or badly configured networks (or 31 | network parts like switches, hubs and routers). 32 | 33 | It was inspired by [speedtest-cli](https://github.com/sivel/speedtest-cli), 34 | a project written in python. But I neither like python, nor did I like the 35 | default behavior of that script. I also think it does not take the right 36 | decisions in choosing the server based on distance instead of speed. That 37 | **does** matter if one has fiber lines. I prefer speed over distance. 38 | 39 | # Command-line Arguments 40 | 41 | 42 | - -? | --help 43 | 44 | 45 | 46 | Show all available options and then exit. 47 | 48 | - -V | --version 49 | 50 | 51 | 52 | Show program version and exit. 53 | 54 | - --man 55 | 56 | 57 | Show the builtin manual using `pod2man` and `nroff`. 58 | 59 | - --info 60 | 61 | 62 | Show the builtin manual using `pod2text`. 63 | 64 | - -v\[#\] | --verbose\[=#\] 65 | 66 | 67 | 68 | Set verbose level. Default value is 1. A plain -v without value will set 69 | the level to 2. 70 | 71 | - --simple 72 | 73 | 74 | An alias for `-v0` 75 | 76 | - --all 77 | 78 | 79 | No (default) filtering on available servers. Useful when finding servers 80 | outside of the country of your own location. 81 | 82 | - -g | --geo 83 | 84 | 85 | 86 | Use GEO-IP service to find the country your ISP is located. The default 87 | is true. If disable (`--no-geo`), the server to use will be based on 88 | distance instead of on latency. 89 | 90 | - -cXX | --cc=XX | --country=XX 91 | 92 | 93 | 94 | 95 | Pass the ISO country code to select the servers 96 | 97 | $ speedtest -c NL ... 98 | $ speedtest --cc=B ... 99 | $ speedtest --country=D ... 100 | 101 | - --list-cc 102 | 103 | 104 | Fetch the server list and then show the list of countries the servers are 105 | located with their country code and server count 106 | 107 | $ speedtest --list-cc 108 | AD Andorra 1 109 | AE United Arab Emirates 4 110 | : 111 | ZW Zimbabwe 6 112 | 113 | You can then use that code to list the servers in the chosen country, as 114 | described below. 115 | 116 | - -l | --list 117 | 118 | 119 | 120 | This option will show all servers in the selection with the distance in 121 | kilometers to the server. 122 | 123 | $ speedtest --list --country=IS 124 | 1: 10661 - Tengir hf Akureyri 1980.02 km 125 | 2: 21605 - Premis ehf Reykjavík 2039.16 km 126 | 3: 3684 - Nova Reykjavik 2039.16 km 127 | 4: 6471 - Gagnaveita Reykjavikur Reykjavik 2039.16 km 128 | 5: 10650 - Nova VIP Reykjavik 2039.16 km 129 | 6: 16148 - Hringidan Reykjavik 2039.16 km 130 | 7: 4818 - Siminn Reykjavik 2039.16 km 131 | 8: 17455 - Hringdu Reykjavík 2039.16 km 132 | 9: 4141 - Vodafone Reykjavík 2039.16 km 133 | 10: 3644 - Snerpa Isafjordur 2192.27 km 134 | 135 | - -p | --ping | --ping=40 136 | 137 | 138 | 139 | Show a list of servers in the selection with their latency in ms. 140 | Be very patient if running this with ["--all"](#all). 141 | 142 | $ speedtest --ping --cc=BE 143 | 1: 4320 - EDPnet Sint-Niklaas 148.06 km 52 ms 144 | 2: 12627 - Proximus Brussels 173.04 km 55 ms 145 | 3: 10986 - Proximus Schaarbeek 170.54 km 55 ms 146 | 4: 15212 - Telenet BVBA/SPRL Mechelen 133.89 km 57 ms 147 | 5: 29238 - Arcadiz DIEGEM 166.33 km 58 ms 148 | 6: 5151 - Combell Brussels 173.04 km 59 ms 149 | 7: 26887 - Arxus NV Brussels 173.04 km 64 ms 150 | 8: 4812 - Universite Catholiq… Louvain-La-Neuv 186.87 km 70 ms 151 | 9: 2848 - Cu.be Solutions Diegem 166.33 km 75 ms 152 | 10: 12306 - VOO Liège 186.26 km 80 ms 153 | 11: 24261 - Une Nouvelle Ville… Charleroi 217.48 km 147 ms 154 | 12: 30594 - Orange Belgium Evere 169.29 km 150 ms 155 | 156 | If a server does not respond, a very high latency is used as default. 157 | 158 | This option only shows the 40 nearest servers. The number can be changed 159 | as optional argument. 160 | 161 | $ speedtest --cc=BE --ping=4 162 | 1: 4320 - EDPnet Sint-Niklaas 148.06 km 53 ms 163 | 2: 29238 - Arcadiz DIEGEM 166.33 km 57 ms 164 | 3: 15212 - Telenet BVBA/SPRL Mechelen 133.89 km 62 ms 165 | 4: 2848 - Cu.be Solutions Diegem 166.33 km 76 ms 166 | 167 | - -1 | --one-line 168 | 169 | 170 | 171 | Generate a very short report easy to paste in e.g. IRC channels. 172 | 173 | $ speedtest -1Qv0 174 | DL: 40.721 Mbit/s, UL: 30.307 Mbit/s 175 | 176 | - -B | --bytes 177 | 178 | 179 | 180 | Report throughput in Mbyte/s instead of Mbit/s 181 | 182 | - -C | --csv 183 | 184 | 185 | 186 | Generate the measurements in CSV format. The data can be collected in 187 | a file (by a cron job) to be able to follow internet speed over time. 188 | 189 | The reported fields are 190 | 191 | - A timestam (the time the tests are finished) 192 | - The server ID 193 | - The latency in ms 194 | - The number of tests executed in this measurement 195 | - The direction of the test (D = Down, U = Up) 196 | - The measure avarage speed in Mbit/s 197 | - The minimum speed measured in one of the test in Mbit/s 198 | - The maximum speed measured in one of the test in Mbit/s 199 | 200 | $ speedtest -Cs4358 201 | "2015-01-24 17:15:09",4358,63.97,40,D,93.45,30.39,136.93 202 | "2015-01-24 17:15:14",4358,63.97,40,U,92.67,31.10,143.06 203 | 204 | - -U | --skip-undef 205 | 206 | 207 | 208 | Skip reporting measurements that have no speed recordings at all. 209 | The default is to report these as `0.00` .. `999999999.999`. 210 | 211 | - -P | --prtg 212 | 213 | 214 | 215 | Generate the measurements in XML suited for PRTG 216 | 217 | $ speedtest -P 218 | 219 | 220 | Testing from My ISP (10.20.30.40) 221 | 222 | Ping 223 | ms 224 | 1 225 | 56.40 226 | 227 | 228 | Download 229 | Mbit/s 230 | 1 231 | 38.34 232 | 233 | 234 | Upload 235 | Mbit/s 236 | 1 237 | 35.89 238 | 239 | 240 | 241 | - --url\[=XXX\] 242 | 243 | 244 | With no value, show server url in list 245 | 246 | With value, use specific server url: do not scan available servers 247 | 248 | - --ip 249 | 250 | 251 | Show IP for server 252 | 253 | - -T\[#\] | --try\[=#\] 254 | 255 | 256 | 257 | Use the top # (based on lowest latency or shortest distance) from the list 258 | to do all required tests. 259 | 260 | $ speedtest -T3 -c NL -Q2 261 | Testing for 80.x.y.z : XS4ALL Internet BV (NL) 262 | 263 | Using 13218: 26.52 km 25 ms XS4ALL Internet BV 264 | Test download .. Download 31.807 Mbit/s 265 | Test upload .. Upload 86.587 Mbit/s 266 | 267 | Using 15850: 26.09 km 25 ms QTS Data Centers 268 | Test download .. Download 80.763 Mbit/s 269 | Test upload .. Upload 77.122 Mbit/s 270 | 271 | Using 11365: 26.09 km 27 ms Vancis 272 | Test download .. Download 106.022 Mbit/s 273 | Test upload .. Upload 82.891 Mbit/s 274 | 275 | Rank 01: Server: 11365 26.09 km 27 ms, DL: 106.022 UL: 82.891 276 | Rank 02: Server: 15850 26.09 km 25 ms, DL: 80.763 UL: 77.122 277 | Rank 03: Server: 13218 26.52 km 25 ms, DL: 31.807 UL: 86.587 278 | 279 | $ speedtest -1v0 -T5 280 | DL: 200.014 Mbit/s, UL: 159.347 Mbit/s, SRV: 13218 281 | DL: 203.599 Mbit/s, UL: 166.247 Mbit/s, SRV: 15850 282 | DL: 207.249 Mbit/s, UL: 134.957 Mbit/s, SRV: 11365 283 | DL: 195.490 Mbit/s, UL: 172.109 Mbit/s, SRV: 5972 284 | DL: 179.413 Mbit/s, UL: 160.309 Mbit/s, SRV: 2042 285 | 286 | Rank 01: Server: 15850 26.09 km 30 ms, DL: 203.599 UL: 166.247 287 | Rank 02: Server: 5972 26.09 km 32 ms, DL: 195.490 UL: 172.109 288 | Rank 03: Server: 13218 26.52 km 23 ms, DL: 200.014 UL: 159.347 289 | Rank 04: Server: 11365 26.09 km 31 ms, DL: 207.249 UL: 134.957 290 | Rank 05: Server: 2042 51.41 km 33 ms, DL: 179.413 UL: 160.309 291 | 292 | - -s# | --server=# | --server=filename 293 | 294 | 295 | 296 | Specify the ID of the server to test against. This ID can be taken from the 297 | output of ["--list"](#list) or ["--ping"](#ping). Using this option prevents fetching the 298 | complete server list and calculation of distances. It also enables you to 299 | always test against the same server. 300 | 301 | $ speedtest -1s4358 302 | Testing for 80.x.y.z : XS4ALL Internet BV () 303 | Using 4358: 52.33 km 64 ms KPN 304 | Test download ........................................Download: 92.633 Mbit/s 305 | Test upload ........................................Upload: 92.552 Mbit/s 306 | DL: 92.633 Mbit/s, UL: 92.552 Mbit/s 307 | 308 | This argument may be repeated to test against multile servers, more or less 309 | like specifying your own top x (as with `-T`). 310 | 311 | $ speedtest -s 22400 -s 1208 -s 13218 312 | Testing for 185.x.y.z : Freedom Internet BV () 313 | 314 | Using 13218: 80.15 km 32 ms XS4ALL Internet BV 315 | Test download ........................................Download 66.833 Mbit/s 316 | Test upload ........................................Upload 173.317 Mbit/s 317 | 318 | Using 1208: 51.19 km 37 ms Qweb | Full-Service Hosting 319 | Test download ........................................Download 52.077 Mbit/s 320 | Test upload ........................................Upload 195.833 Mbit/s 321 | 322 | Using 22400: 80.15 km 46 ms Usenet.Farm 323 | Test download ........................................Download 96.341 Mbit/s 324 | Test upload ........................................Upload 203.306 Mbit/s 325 | 326 | Rank 01: Server: 22400 80.15 km 46 ms, DL: 96.341 UL: 203.306 327 | Rank 02: Server: 1208 51.19 km 37 ms, DL: 52.077 UL: 195.833 328 | Rank 03: Server: 13218 80.15 km 32 ms, DL: 66.833 UL: 173.317 329 | 330 | If you pass a filename, it is expected to reflect a server-like structure as 331 | received from the speedtest server-list, possibly completed with upload- and 332 | download URL's. You can only pass one filename not consisting of all digits. 333 | If you do, all remaining `-s` arguments are ignored. 334 | 335 | { cc => "NL", 336 | country => "Netherlands", 337 | host => "unlisted.host.amsterdam:8080", 338 | id => 9999, 339 | lat => "52.37316", 340 | lon => "4.89122", 341 | name => "Amsterdam", 342 | ping => 20.0, 343 | sponsor => "Dam tot Damloop", 344 | url => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 345 | url2 => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 346 | 347 | dl_list => [ 348 | "http://unlisted.host.amsterdam/files/128.bin", 349 | "http://unlisted.host.amsterdam/files/256.bin", 350 | # 40 URL's pointing to files in increasing size 351 | "http://unlisted.host.amsterdam/files/2G.bin", 352 | ], 353 | ul_list => [ 354 | # 40 URL's 355 | ], 356 | } 357 | 358 | - -t# | --timeout=# 359 | 360 | 361 | 362 | Specify the maximum timeout in seconds. 363 | 364 | - -d | --download 365 | 366 | 367 | 368 | Run the download tests. This is default unless ["--upload"](#upload) is passed. 369 | 370 | - -u | --upload 371 | 372 | 373 | 374 | Run the upload tests. This is default unless ["--download"](#download) is passed. 375 | 376 | - -q\[#\] | --quick\[=#\] | --fast\[=#\] 377 | 378 | 379 | 380 | 381 | Don't run the full test. The default test runs 40 tests, sorting on 382 | increasing test size (and thus test duration). Long(er) tests may take 383 | too long on slow connections without adding value. The default value 384 | for `-q` is 20 but any value between 1 and 40 is allowed. 385 | 386 | - -Q\[#\] | --realquick\[=#\] 387 | 388 | 389 | 390 | Don't run the full test. The default test runs 40 tests, sorting on 391 | increasing test size (and thus test duration). Long(er) tests may take 392 | too long on slow connections without adding value. The default value 393 | for `-Q` is 10 but any value between 1 and 40 is allowed. 394 | 395 | - -mXX | --mini=XX 396 | 397 | 398 | 399 | Run the speedtest on a speedtest mini server. 400 | 401 | - --source=XX 402 | 403 | NYI - mentioned for speedtest-cli compatibility 404 | 405 | # EXAMPLES 406 | 407 | See ["SYNOPSIS"](#synopsis) and [Command-line arguments](#clia) 408 | 409 | # DIAGNOSTICS 410 | 411 | ... 412 | 413 | # BUGS and CAVEATS 414 | 415 | Due to language implementation, it may report speeds that are not 416 | consistent with the speeds reported by the web interface or other 417 | speed-test tools. Likewise for reported latencies, which are not 418 | to be compared to those reported by tools like ping. 419 | 420 | # TODO 421 | 422 | - Improve documentation 423 | 424 | What did I miss? 425 | 426 | - Enable alternative XML parsers 427 | 428 | XML::Simple is not the recommended XML parser, but it sufficed on 429 | startup. All other API's are more complex. 430 | 431 | # PORTABILITY 432 | 433 | As Perl has been ported to a plethora of operating systems, this CLI 434 | will work fine on all systems that fulfill the requirement as listed 435 | in Makefile.PL (or the various META files). 436 | 437 | The script has been tested on Linux, HP-UX, AIX, and Windows 7. 438 | 439 | Debian wheezy will run with just two additional packages: 440 | 441 | # apt-get install libxml-simple-perl libdata-peek-perl 442 | 443 | # SEE ALSO 444 | 445 | As an alternative to [speedtest.net](http://www.speedtest.net/), you 446 | could consider [http://compari.tech/speed](http://compari.tech/speed). 447 | 448 | The [speedtest-cli](https://github.com/sivel/speedtest-cli) project 449 | that inspired me to improve a broken CLI written in python into our 450 | beloved language Perl. 451 | 452 | # CONTRIBUTING 453 | 454 | ## General 455 | 456 | I am always open to improvements and suggestions. Use issues at 457 | [github issues](https://github.com/Tux/speedtest/issues). 458 | 459 | ## Style 460 | 461 | I will never accept pull request that do not strictly conform to my 462 | style, however you might hate it. You can read the reasoning behind 463 | my preferences [here](https://tux.nl/style.html). 464 | 465 | I really don't care about mixed spaces and tabs in (leading) whitespace 466 | 467 | # WARRANTY 468 | 469 | This tool is by no means a guarantee to show the correct speeds. It 470 | is only to be used as an indication of the throughput of your internet 471 | connection. The values shown cannot be used in a legal debate. 472 | 473 | # AUTHOR 474 | 475 | H.Merijn Brand `` wrote this for his own 476 | personal use, but was asked to make it publicly available as application. 477 | 478 | # COPYRIGHT AND LICENSE 479 | 480 | Copyright (C) 2014-2025 H.Merijn Brand 481 | 482 | This software is free; you can redistribute it and/or modify 483 | it under the same terms as Perl itself. 484 | -------------------------------------------------------------------------------- /doc/speedtest.man: -------------------------------------------------------------------------------- 1 | App::SpeedTest(3) User Contributed Perl Documentation App::SpeedTest(3) 2 | 3 | NAME 4 | App::SpeedTest - Command-line interface to speedtest.net 5 | 6 | SYNOPSIS 7 | $ speedtest [ --no-geo | --country=NL ] [ --list | --ping ] [ options ] 8 | 9 | $ speedtest --list 10 | $ speedtest --ping --country=BE 11 | $ speedtest 12 | $ speedtest -s 4358 13 | $ speedtest --url=http://ookla.extraip.net 14 | $ speedtest -q --no-download 15 | $ speedtest -Q --no-upload 16 | 17 | DESCRIPTION 18 | The provided perl script is a command-line interface to the 19 | speedtest.net infrastructure so that flash 20 | is not required 21 | 22 | It was written to feature the functionality that speedtest.net offers 23 | without the overhead of flash or java and the need of a browser. 24 | 25 | Raison-d'être 26 | The tool is there to give you a quick indication of the achievable 27 | throughput of your current network. That can drop dramatically if you 28 | are behind (several) firewalls or badly configured networks (or network 29 | parts like switches, hubs and routers). 30 | 31 | It was inspired by speedtest-cli , a project written in python. But I neither like python, nor did I 33 | like the default behavior of that script. I also think it does not take 34 | the right decisions in choosing the server based on distance instead of 35 | speed. That does matter if one has fiber lines. I prefer speed over 36 | distance. 37 | 38 | Command-line Arguments 39 | -? | --help 40 | Show all available options and then exit. 41 | 42 | -V | --version 43 | Show program version and exit. 44 | 45 | --man 46 | Show the builtin manual using "pod2man" and "nroff". 47 | 48 | --info 49 | Show the builtin manual using "pod2text". 50 | 51 | -v[#] | --verbose[=#] 52 | Set verbose level. Default value is 1. A plain -v without value will 53 | set the level to 2. 54 | 55 | --simple 56 | An alias for "-v0" 57 | 58 | --all 59 | No (default) filtering on available servers. Useful when finding 60 | servers outside of the country of your own location. 61 | 62 | -g | --geo 63 | Use GEO-IP service to find the country your ISP is located. The 64 | default is true. If disable ("--no-geo"), the server to use will be 65 | based on distance instead of on latency. 66 | 67 | -cXX | --cc=XX | --country=XX 68 | Pass the ISO country code to select the servers 69 | 70 | $ speedtest -c NL ... 71 | $ speedtest --cc=B ... 72 | $ speedtest --country=D ... 73 | 74 | --list-cc 75 | Fetch the server list and then show the list of countries the servers 76 | are located with their country code and server count 77 | 78 | $ speedtest --list-cc 79 | AD Andorra 1 80 | AE United Arab Emirates 4 81 | : 82 | ZW Zimbabwe 6 83 | 84 | You can then use that code to list the servers in the chosen country, 85 | as described below. 86 | 87 | -l | --list 88 | This option will show all servers in the selection with the distance 89 | in kilometers to the server. 90 | 91 | $ speedtest --list --country=IS 92 | 1: 10661 - Tengir hf Akureyri 1980.02 km 93 | 2: 21605 - Premis ehf Reykjav?k 2039.16 km 94 | 3: 3684 - Nova Reykjavik 2039.16 km 95 | 4: 6471 - Gagnaveita Reykjavikur Reykjavik 2039.16 km 96 | 5: 10650 - Nova VIP Reykjavik 2039.16 km 97 | 6: 16148 - Hringidan Reykjavik 2039.16 km 98 | 7: 4818 - Siminn Reykjavik 2039.16 km 99 | 8: 17455 - Hringdu Reykjav?k 2039.16 km 100 | 9: 4141 - Vodafone Reykjav?k 2039.16 km 101 | 10: 3644 - Snerpa Isafjordur 2192.27 km 102 | 103 | -p | --ping | --ping=40 104 | Show a list of servers in the selection with their latency in ms. Be 105 | very patient if running this with "--all". 106 | 107 | $ speedtest --ping --cc=BE 108 | 1: 4320 - EDPnet Sint-Niklaas 148.06 km 52 ms 109 | 2: 12627 - Proximus Brussels 173.04 km 55 ms 110 | 3: 10986 - Proximus Schaarbeek 170.54 km 55 ms 111 | 4: 15212 - Telenet BVBA/SPRL Mechelen 133.89 km 57 ms 112 | 5: 29238 - Arcadiz DIEGEM 166.33 km 58 ms 113 | 6: 5151 - Combell Brussels 173.04 km 59 ms 114 | 7: 26887 - Arxus NV Brussels 173.04 km 64 ms 115 | 8: 4812 - Universite Catholiq? Louvain-La-Neuv 186.87 km 70 ms 116 | 9: 2848 - Cu.be Solutions Diegem 166.33 km 75 ms 117 | 10: 12306 - VOO Liège 186.26 km 80 ms 118 | 11: 24261 - Une Nouvelle Ville? Charleroi 217.48 km 147 ms 119 | 12: 30594 - Orange Belgium Evere 169.29 km 150 ms 120 | 121 | If a server does not respond, a very high latency is used as default. 122 | 123 | This option only shows the 40 nearest servers. The number can be 124 | changed as optional argument. 125 | 126 | $ speedtest --cc=BE --ping=4 127 | 1: 4320 - EDPnet Sint-Niklaas 148.06 km 53 ms 128 | 2: 29238 - Arcadiz DIEGEM 166.33 km 57 ms 129 | 3: 15212 - Telenet BVBA/SPRL Mechelen 133.89 km 62 ms 130 | 4: 2848 - Cu.be Solutions Diegem 166.33 km 76 ms 131 | 132 | -1 | --one-line 133 | Generate a very short report easy to paste in e.g. IRC channels. 134 | 135 | $ speedtest -1Qv0 136 | DL: 40.721 Mbit/s, UL: 30.307 Mbit/s 137 | 138 | -B | --bytes 139 | Report throughput in Mbyte/s instead of Mbit/s 140 | 141 | -C | --csv 142 | Generate the measurements in CSV format. The data can be collected in 143 | a file (by a cron job) to be able to follow internet speed over time. 144 | 145 | The reported fields are 146 | 147 | - A timestam (the time the tests are finished) 148 | - The server ID 149 | - The latency in ms 150 | - The number of tests executed in this measurement 151 | - The direction of the test (D = Down, U = Up) 152 | - The measure avarage speed in Mbit/s 153 | - The minimum speed measured in one of the test in Mbit/s 154 | - The maximum speed measured in one of the test in Mbit/s 155 | 156 | $ speedtest -Cs4358 157 | "2015-01-24 17:15:09",4358,63.97,40,D,93.45,30.39,136.93 158 | "2015-01-24 17:15:14",4358,63.97,40,U,92.67,31.10,143.06 159 | 160 | -U | --skip-undef 161 | Skip reporting measurements that have no speed recordings at all. 162 | The default is to report these as 0.00 .. 999999999.999. 163 | 164 | -P | --prtg 165 | Generate the measurements in XML suited for PRTG 166 | 167 | $ speedtest -P 168 | 169 | 170 | Testing from My ISP (10.20.30.40) 171 | 172 | Ping 173 | ms 174 | 1 175 | 56.40 176 | 177 | 178 | Download 179 | Mbit/s 180 | 1 181 | 38.34 182 | 183 | 184 | Upload 185 | Mbit/s 186 | 1 187 | 35.89 188 | 189 | 190 | 191 | --url[=XXX] 192 | With no value, show server url in list 193 | 194 | With value, use specific server url: do not scan available servers 195 | 196 | --ip 197 | Show IP for server 198 | 199 | -T[#] | --try[=#] 200 | Use the top # (based on lowest latency or shortest distance) from the 201 | list to do all required tests. 202 | 203 | $ speedtest -T3 -c NL -Q2 204 | Testing for 80.x.y.z : XS4ALL Internet BV (NL) 205 | 206 | Using 13218: 26.52 km 25 ms XS4ALL Internet BV 207 | Test download .. Download 31.807 Mbit/s 208 | Test upload .. Upload 86.587 Mbit/s 209 | 210 | Using 15850: 26.09 km 25 ms QTS Data Centers 211 | Test download .. Download 80.763 Mbit/s 212 | Test upload .. Upload 77.122 Mbit/s 213 | 214 | Using 11365: 26.09 km 27 ms Vancis 215 | Test download .. Download 106.022 Mbit/s 216 | Test upload .. Upload 82.891 Mbit/s 217 | 218 | Rank 01: Server: 11365 26.09 km 27 ms, DL: 106.022 UL: 82.891 219 | Rank 02: Server: 15850 26.09 km 25 ms, DL: 80.763 UL: 77.122 220 | Rank 03: Server: 13218 26.52 km 25 ms, DL: 31.807 UL: 86.587 221 | 222 | $ speedtest -1v0 -T5 223 | DL: 200.014 Mbit/s, UL: 159.347 Mbit/s, SRV: 13218 224 | DL: 203.599 Mbit/s, UL: 166.247 Mbit/s, SRV: 15850 225 | DL: 207.249 Mbit/s, UL: 134.957 Mbit/s, SRV: 11365 226 | DL: 195.490 Mbit/s, UL: 172.109 Mbit/s, SRV: 5972 227 | DL: 179.413 Mbit/s, UL: 160.309 Mbit/s, SRV: 2042 228 | 229 | Rank 01: Server: 15850 26.09 km 30 ms, DL: 203.599 UL: 166.247 230 | Rank 02: Server: 5972 26.09 km 32 ms, DL: 195.490 UL: 172.109 231 | Rank 03: Server: 13218 26.52 km 23 ms, DL: 200.014 UL: 159.347 232 | Rank 04: Server: 11365 26.09 km 31 ms, DL: 207.249 UL: 134.957 233 | Rank 05: Server: 2042 51.41 km 33 ms, DL: 179.413 UL: 160.309 234 | 235 | -s# | --server=# | --server=filename 236 | Specify the ID of the server to test against. This ID can be taken 237 | from the output of "--list" or "--ping". Using this option prevents 238 | fetching the complete server list and calculation of distances. It 239 | also enables you to always test against the same server. 240 | 241 | $ speedtest -1s4358 242 | Testing for 80.x.y.z : XS4ALL Internet BV () 243 | Using 4358: 52.33 km 64 ms KPN 244 | Test download ........................................Download: 92.633 Mbit/s 245 | Test upload ........................................Upload: 92.552 Mbit/s 246 | DL: 92.633 Mbit/s, UL: 92.552 Mbit/s 247 | 248 | This argument may be repeated to test against multile servers, more 249 | or less like specifying your own top x (as with "-T"). 250 | 251 | $ speedtest -s 22400 -s 1208 -s 13218 252 | Testing for 185.x.y.z : Freedom Internet BV () 253 | 254 | Using 13218: 80.15 km 32 ms XS4ALL Internet BV 255 | Test download ........................................Download 66.833 Mbit/s 256 | Test upload ........................................Upload 173.317 Mbit/s 257 | 258 | Using 1208: 51.19 km 37 ms Qweb | Full-Service Hosting 259 | Test download ........................................Download 52.077 Mbit/s 260 | Test upload ........................................Upload 195.833 Mbit/s 261 | 262 | Using 22400: 80.15 km 46 ms Usenet.Farm 263 | Test download ........................................Download 96.341 Mbit/s 264 | Test upload ........................................Upload 203.306 Mbit/s 265 | 266 | Rank 01: Server: 22400 80.15 km 46 ms, DL: 96.341 UL: 203.306 267 | Rank 02: Server: 1208 51.19 km 37 ms, DL: 52.077 UL: 195.833 268 | Rank 03: Server: 13218 80.15 km 32 ms, DL: 66.833 UL: 173.317 269 | 270 | If you pass a filename, it is expected to reflect a server-like 271 | structure as received from the speedtest server-list, possibly 272 | completed with upload- and download URL's. You can only pass one 273 | filename not consisting of all digits. If you do, all remaining "-s" 274 | arguments are ignored. 275 | 276 | { cc => "NL", 277 | country => "Netherlands", 278 | host => "unlisted.host.amsterdam:8080", 279 | id => 9999, 280 | lat => "52.37316", 281 | lon => "4.89122", 282 | name => "Amsterdam", 283 | ping => 20.0, 284 | sponsor => "Dam tot Damloop", 285 | url => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 286 | url2 => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 287 | 288 | dl_list => [ 289 | "http://unlisted.host.amsterdam/files/128.bin", 290 | "http://unlisted.host.amsterdam/files/256.bin", 291 | # 40 URL's pointing to files in increasing size 292 | "http://unlisted.host.amsterdam/files/2G.bin", 293 | ], 294 | ul_list => [ 295 | # 40 URL's 296 | ], 297 | } 298 | 299 | -t# | --timeout=# 300 | Specify the maximum timeout in seconds. 301 | 302 | -d | --download 303 | Run the download tests. This is default unless "--upload" is passed. 304 | 305 | -u | --upload 306 | Run the upload tests. This is default unless "--download" is passed. 307 | 308 | -q[#] | --quick[=#] | --fast[=#] 309 | Don't run the full test. The default test runs 40 tests, sorting on 310 | increasing test size (and thus test duration). Long(er) tests may 311 | take too long on slow connections without adding value. The default 312 | value for "-q" is 20 but any value between 1 and 40 is allowed. 313 | 314 | -Q[#] | --realquick[=#] 315 | Don't run the full test. The default test runs 40 tests, sorting on 316 | increasing test size (and thus test duration). Long(er) tests may 317 | take too long on slow connections without adding value. The default 318 | value for "-Q" is 10 but any value between 1 and 40 is allowed. 319 | 320 | -mXX | --mini=XX 321 | Run the speedtest on a speedtest mini server. 322 | 323 | --source=XX 324 | NYI - mentioned for speedtest-cli compatibility 325 | 326 | EXAMPLES 327 | See "SYNOPSIS" and Command-line arguments 328 | 329 | DIAGNOSTICS 330 | ... 331 | 332 | BUGS and CAVEATS 333 | Due to language implementation, it may report speeds that are not 334 | consistent with the speeds reported by the web interface or other 335 | speed-test tools. Likewise for reported latencies, which are not to be 336 | compared to those reported by tools like ping. 337 | 338 | TODO 339 | Improve documentation 340 | What did I miss? 341 | 342 | Enable alternative XML parsers 343 | XML::Simple is not the recommended XML parser, but it sufficed on 344 | startup. All other API's are more complex. 345 | 346 | PORTABILITY 347 | As Perl has been ported to a plethora of operating systems, this CLI 348 | will work fine on all systems that fulfill the requirement as listed in 349 | Makefile.PL (or the various META files). 350 | 351 | The script has been tested on Linux, HP-UX, AIX, and Windows 7. 352 | 353 | Debian wheezy will run with just two additional packages: 354 | 355 | # apt-get install libxml-simple-perl libdata-peek-perl 356 | 357 | SEE ALSO 358 | As an alternative to speedtest.net , you 359 | could consider . 360 | 361 | The speedtest-cli project that 362 | inspired me to improve a broken CLI written in python into our beloved 363 | language Perl. 364 | 365 | CONTRIBUTING 366 | General 367 | I am always open to improvements and suggestions. Use issues at github 368 | issues . 369 | 370 | Style 371 | I will never accept pull request that do not strictly conform to my 372 | style, however you might hate it. You can read the reasoning behind my 373 | preferences here . 374 | 375 | I really don't care about mixed spaces and tabs in (leading) whitespace 376 | 377 | WARRANTY 378 | This tool is by no means a guarantee to show the correct speeds. It is 379 | only to be used as an indication of the throughput of your internet 380 | connection. The values shown cannot be used in a legal debate. 381 | 382 | AUTHOR 383 | H.Merijn Brand wrote this for his own personal 384 | use, but was asked to make it publicly available as application. 385 | 386 | COPYRIGHT AND LICENSE 387 | Copyright (C) 2014-2025 H.Merijn Brand 388 | 389 | This software is free; you can redistribute it and/or modify it under 390 | the same terms as Perl itself. 391 | 392 | perl v5.40.1 2025-03-14 App::SpeedTest(3) 393 | -------------------------------------------------------------------------------- /doc/speedtest.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | App::SpeedTest - Command-line interface to speedtest.net 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 36 | 37 |

NAME

38 | 39 |

App::SpeedTest - Command-line interface to speedtest.net

40 | 41 |

SYNOPSIS

42 | 43 | 
$ speedtest [ --no-geo | --country=NL ] [ --list | --ping ] [ options ]
 44 | 
 45 | $ speedtest --list
 46 | $ speedtest --ping --country=BE
 47 | $ speedtest
 48 | $ speedtest -s 4358
 49 | $ speedtest --url=http://ookla.extraip.net
 50 | $ speedtest -q --no-download
 51 | $ speedtest -Q --no-upload
52 | 53 |

DESCRIPTION

54 | 55 |

The provided perl script is a command-line interface to the speedtest.net infrastructure so that flash is not required

56 | 57 |

It was written to feature the functionality that speedtest.net offers without the overhead of flash or java and the need of a browser.

58 | 59 |

Raison-d'être

60 | 61 |

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).

62 | 63 |

It was inspired by 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 does matter if one has fiber lines. I prefer speed over distance.

64 | 65 |

Command-line Arguments

66 | 67 |
68 | 69 |
-? | --help
70 |
71 | 72 |

Show all available options and then exit.

73 | 74 |
75 |
-V | --version
76 |
77 | 78 |

Show program version and exit.

79 | 80 |
81 |
--man
82 |
83 | 84 |

Show the builtin manual using pod2man and nroff.

85 | 86 |
87 |
--info
88 |
89 | 90 |

Show the builtin manual using pod2text.

91 | 92 |
93 |
-v[#] | --verbose[=#]
94 |
95 | 96 |

Set verbose level. Default value is 1. A plain -v without value will set the level to 2.

97 | 98 |
99 |
--simple
100 |
101 | 102 |

An alias for -v0

103 | 104 |
105 |
--all
106 |
107 | 108 |

No (default) filtering on available servers. Useful when finding servers outside of the country of your own location.

109 | 110 |
111 |
-g | --geo
112 |
113 | 114 |

Use GEO-IP service to find the country your ISP is located. The default is true. If disable (--no-geo), the server to use will be based on distance instead of on latency.

115 | 116 |
117 |
-cXX | --cc=XX | --country=XX
118 |
119 | 120 |

Pass the ISO country code to select the servers

121 | 122 | 
$ speedtest -c NL ...
123 | $ speedtest --cc=B ...
124 | $ speedtest --country=D ...
125 | 126 |
127 |
--list-cc
128 |
129 | 130 |

Fetch the server list and then show the list of countries the servers are located with their country code and server count

131 | 132 | 
$ speedtest --list-cc
133 | AD Andorra                             1
134 | AE United Arab Emirates                4
135 | :
136 | ZW Zimbabwe                            6
137 | 138 |

You can then use that code to list the servers in the chosen country, as described below.

139 | 140 |
141 |
-l | --list
142 |
143 | 144 |

This option will show all servers in the selection with the distance in kilometers to the server.

145 | 146 | 
$ speedtest --list --country=IS
147 |   1: 10661 - Tengir hf              Akureyri    1980.02 km
148 |   2: 21605 - Premis ehf             Reykjavík   2039.16 km
149 |   3:  3684 - Nova                   Reykjavik   2039.16 km
150 |   4:  6471 - Gagnaveita Reykjavikur Reykjavik   2039.16 km
151 |   5: 10650 - Nova VIP               Reykjavik   2039.16 km
152 |   6: 16148 - Hringidan              Reykjavik   2039.16 km
153 |   7:  4818 - Siminn                 Reykjavik   2039.16 km
154 |   8: 17455 - Hringdu                Reykjavík   2039.16 km
155 |   9:  4141 - Vodafone               Reykjavík   2039.16 km
156 |  10:  3644 - Snerpa                 Isafjordur  2192.27 km
157 | 158 |
159 |
-p | --ping | --ping=40
160 |
161 | 162 |

Show a list of servers in the selection with their latency in ms. Be very patient if running this with "--all".

163 | 164 | 
$ speedtest --ping --cc=BE
165 |   1:  4320 - EDPnet               Sint-Niklaas     148.06 km      52 ms
166 |   2: 12627 - Proximus             Brussels         173.04 km      55 ms
167 |   3: 10986 - Proximus             Schaarbeek       170.54 km      55 ms
168 |   4: 15212 - Telenet BVBA/SPRL    Mechelen         133.89 km      57 ms
169 |   5: 29238 - Arcadiz              DIEGEM           166.33 km      58 ms
170 |   6:  5151 - Combell              Brussels         173.04 km      59 ms
171 |   7: 26887 - Arxus NV             Brussels         173.04 km      64 ms
172 |   8:  4812 - Universite Catholiq… Louvain-La-Neuv  186.87 km      70 ms
173 |   9:  2848 - Cu.be Solutions      Diegem           166.33 km      75 ms
174 |  10: 12306 - VOO                  Liège            186.26 km      80 ms
175 |  11: 24261 - Une Nouvelle Ville…  Charleroi        217.48 km     147 ms
176 |  12: 30594 - Orange Belgium       Evere            169.29 km     150 ms
177 | 178 |

If a server does not respond, a very high latency is used as default.

179 | 180 |

This option only shows the 40 nearest servers. The number can be changed as optional argument.

181 | 182 | 
$ speedtest --cc=BE --ping=4
183 |   1:  4320 - EDPnet               Sint-Niklaas     148.06 km      53 ms
184 |   2: 29238 - Arcadiz              DIEGEM           166.33 km      57 ms
185 |   3: 15212 - Telenet BVBA/SPRL    Mechelen         133.89 km      62 ms
186 |   4:  2848 - Cu.be Solutions      Diegem           166.33 km      76 ms
187 | 188 |
189 |
-1 | --one-line
190 |
191 | 192 |

Generate a very short report easy to paste in e.g. IRC channels.

193 | 194 | 
$ speedtest -1Qv0
195 | DL:   40.721 Mbit/s, UL:   30.307 Mbit/s
196 | 197 |
198 |
-B | --bytes
199 |
200 | 201 |

Report throughput in Mbyte/s instead of Mbit/s

202 | 203 |
204 |
-C | --csv
205 |
206 | 207 |

Generate the measurements in CSV format. The data can be collected in a file (by a cron job) to be able to follow internet speed over time.

208 | 209 |

The reported fields are

210 | 211 | 
- A timestam (the time the tests are finished)
212 | - The server ID
213 | - The latency in ms
214 | - The number of tests executed in this measurement
215 | - The direction of the test (D = Down, U = Up)
216 | - The measure avarage speed in Mbit/s
217 | - The minimum speed measured in one of the test in Mbit/s
218 | - The maximum speed measured in one of the test in Mbit/s
219 | 
220 | $ speedtest -Cs4358
221 | "2015-01-24 17:15:09",4358,63.97,40,D,93.45,30.39,136.93
222 | "2015-01-24 17:15:14",4358,63.97,40,U,92.67,31.10,143.06
223 | 224 |
225 |
-U | --skip-undef
226 |
227 | 228 |

Skip reporting measurements that have no speed recordings at all. The default is to report these as 0.00 .. 999999999.999.

229 | 230 |
231 |
-P | --prtg
232 |
233 | 234 |

Generate the measurements in XML suited for PRTG

235 | 236 | 
$ speedtest -P
237 | <?xml version="1.0" encoding="UTF-8" ?>
238 | <prtg>
239 |   <text>Testing from My ISP (10.20.30.40)</text>
240 |   <result>
241 |     <channel>Ping</channel>
242 |     <customUnit>ms</customUnit>
243 |     <float>1</float>
244 |     <value>56.40</value>
245 |     </result>
246 |   <result>
247 |     <channel>Download</channel>
248 |     <customUnit>Mbit/s</customUnit>
249 |     <float>1</float>
250 |     <value>38.34</value>
251 |     </result>
252 |   <result>
253 |     <channel>Upload</channel>
254 |     <customUnit>Mbit/s</customUnit>
255 |     <float>1</float>
256 |     <value>35.89</value>
257 |     </result>
258 |   </prtg>
259 | 260 |
261 |
--url[=XXX]
262 |
263 | 264 |

With no value, show server url in list

265 | 266 |

With value, use specific server url: do not scan available servers

267 | 268 |
269 |
--ip
270 |
271 | 272 |

Show IP for server

273 | 274 |
275 |
-T[#] | --try[=#]
276 |
277 | 278 |

Use the top # (based on lowest latency or shortest distance) from the list to do all required tests.

279 | 280 | 
$ speedtest -T3 -c NL -Q2
281 | Testing for 80.x.y.z : XS4ALL Internet BV (NL)
282 | 
283 | Using 13218:  26.52 km      25 ms XS4ALL Internet BV
284 | Test download ..                                      Download     31.807 Mbit/s
285 | Test upload   ..                                      Upload       86.587 Mbit/s
286 | 
287 | Using 15850:  26.09 km      25 ms QTS Data Centers
288 | Test download ..                                      Download     80.763 Mbit/s
289 | Test upload   ..                                      Upload       77.122 Mbit/s
290 | 
291 | Using 11365:  26.09 km      27 ms Vancis
292 | Test download ..                                      Download    106.022 Mbit/s
293 | Test upload   ..                                      Upload       82.891 Mbit/s
294 | 
295 | Rank 01: Server:  11365   26.09 km      27 ms,  DL:  106.022 UL:   82.891
296 | Rank 02: Server:  15850   26.09 km      25 ms,  DL:   80.763 UL:   77.122
297 | Rank 03: Server:  13218   26.52 km      25 ms,  DL:   31.807 UL:   86.587
298 | 
299 | $ speedtest -1v0 -T5
300 | DL:  200.014 Mbit/s, UL:  159.347 Mbit/s, SRV: 13218
301 | DL:  203.599 Mbit/s, UL:  166.247 Mbit/s, SRV: 15850
302 | DL:  207.249 Mbit/s, UL:  134.957 Mbit/s, SRV: 11365
303 | DL:  195.490 Mbit/s, UL:  172.109 Mbit/s, SRV: 5972
304 | DL:  179.413 Mbit/s, UL:  160.309 Mbit/s, SRV: 2042
305 | 
306 | Rank 01: Server:  15850   26.09 km      30 ms,  DL:  203.599 UL:  166.247
307 | Rank 02: Server:   5972   26.09 km      32 ms,  DL:  195.490 UL:  172.109
308 | Rank 03: Server:  13218   26.52 km      23 ms,  DL:  200.014 UL:  159.347
309 | Rank 04: Server:  11365   26.09 km      31 ms,  DL:  207.249 UL:  134.957
310 | Rank 05: Server:   2042   51.41 km      33 ms,  DL:  179.413 UL:  160.309
311 | 312 |
313 |
-s# | --server=# | --server=filename
314 |
315 | 316 |

Specify the ID of the server to test against. This ID can be taken from the output of "--list" or "--ping". Using this option prevents fetching the complete server list and calculation of distances. It also enables you to always test against the same server.

317 | 318 | 
$ speedtest -1s4358
319 | Testing for 80.x.y.z : XS4ALL Internet BV ()
320 | Using 4358:  52.33 km      64 ms KPN
321 | Test download ........................................Download:   92.633 Mbit/s
322 | Test upload   ........................................Upload:     92.552 Mbit/s
323 | DL:   92.633 Mbit/s, UL:   92.552 Mbit/s
324 | 325 |

This argument may be repeated to test against multile servers, more or less like specifying your own top x (as with -T).

326 | 327 | 
$ speedtest -s 22400 -s 1208 -s 13218
328 | Testing for 185.x.y.z : Freedom Internet BV ()
329 | 
330 | Using 13218:  80.15 km      32 ms XS4ALL Internet BV
331 | Test download ........................................Download    66.833 Mbit/s
332 | Test upload   ........................................Upload     173.317 Mbit/s
333 | 
334 | Using  1208:  51.19 km      37 ms Qweb | Full-Service Hosting
335 | Test download ........................................Download    52.077 Mbit/s
336 | Test upload   ........................................Upload     195.833 Mbit/s
337 | 
338 | Using 22400:  80.15 km      46 ms Usenet.Farm
339 | Test download ........................................Download    96.341 Mbit/s
340 | Test upload   ........................................Upload     203.306 Mbit/s
341 | 
342 | Rank 01: Server:  22400   80.15 km      46 ms,  DL:   96.341 UL:  203.306
343 | Rank 02: Server:   1208   51.19 km      37 ms,  DL:   52.077 UL:  195.833
344 | Rank 03: Server:  13218   80.15 km      32 ms,  DL:   66.833 UL:  173.317
345 | 346 |

If you pass a filename, it is expected to reflect a server-like structure as received from the speedtest server-list, possibly completed with upload- and download URL's. You can only pass one filename not consisting of all digits. If you do, all remaining -s arguments are ignored.

347 | 348 | 
{   cc      => "NL",
349 |     country => "Netherlands",
350 |     host    => "unlisted.host.amsterdam:8080",
351 |     id      => 9999,
352 |     lat     => "52.37316",
353 |     lon     => "4.89122",
354 |     name    => "Amsterdam",
355 |     ping    => 20.0,
356 |     sponsor => "Dam tot Damloop",
357 |     url     => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php",
358 |     url2    => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php",
359 | 
360 |     dl_list => [
361 |         "http://unlisted.host.amsterdam/files/128.bin",
362 |         "http://unlisted.host.amsterdam/files/256.bin",
363 |         # 40 URL's pointing to files in increasing size
364 |         "http://unlisted.host.amsterdam/files/2G.bin",
365 |         ],
366 |     ul_list => [
367 |         # 40 URL's
368 |         ],
369 |     }
370 | 371 |
372 |
-t# | --timeout=#
373 |
374 | 375 |

Specify the maximum timeout in seconds.

376 | 377 |
378 |
-d | --download
379 |
380 | 381 |

Run the download tests. This is default unless "--upload" is passed.

382 | 383 |
384 |
-u | --upload
385 |
386 | 387 |

Run the upload tests. This is default unless "--download" is passed.

388 | 389 |
390 |
-q[#] | --quick[=#] | --fast[=#]
391 |
392 | 393 |

Don't run the full test. The default test runs 40 tests, sorting on increasing test size (and thus test duration). Long(er) tests may take too long on slow connections without adding value. The default value for -q is 20 but any value between 1 and 40 is allowed.

394 | 395 |
396 |
-Q[#] | --realquick[=#]
397 |
398 | 399 |

Don't run the full test. The default test runs 40 tests, sorting on increasing test size (and thus test duration). Long(er) tests may take too long on slow connections without adding value. The default value for -Q is 10 but any value between 1 and 40 is allowed.

400 | 401 |
402 |
-mXX | --mini=XX
403 |
404 | 405 |

Run the speedtest on a speedtest mini server.

406 | 407 |
408 |
--source=XX
409 |
410 | 411 |

NYI - mentioned for speedtest-cli compatibility

412 | 413 |
414 |
415 | 416 |

EXAMPLES

417 | 418 |

See "SYNOPSIS" and Command-line arguments

419 | 420 |

DIAGNOSTICS

421 | 422 |

...

423 | 424 |

BUGS and CAVEATS

425 | 426 |

Due to language implementation, it may report speeds that are not consistent with the speeds reported by the web interface or other speed-test tools. Likewise for reported latencies, which are not to be compared to those reported by tools like ping.

427 | 428 |

TODO

429 | 430 |
431 | 432 |
Improve documentation
433 |
434 | 435 |

What did I miss?

436 | 437 |
438 |
Enable alternative XML parsers
439 |
440 | 441 |

XML::Simple is not the recommended XML parser, but it sufficed on startup. All other API's are more complex.

442 | 443 |
444 |
445 | 446 |

PORTABILITY

447 | 448 |

As Perl has been ported to a plethora of operating systems, this CLI will work fine on all systems that fulfill the requirement as listed in Makefile.PL (or the various META files).

449 | 450 |

The script has been tested on Linux, HP-UX, AIX, and Windows 7.

451 | 452 |

Debian wheezy will run with just two additional packages:

453 | 454 | 
# apt-get install libxml-simple-perl libdata-peek-perl
455 | 456 |

SEE ALSO

457 | 458 |

As an alternative to speedtest.net, you could consider http://compari.tech/speed.

459 | 460 |

The speedtest-cli project that inspired me to improve a broken CLI written in python into our beloved language Perl.

461 | 462 |

CONTRIBUTING

463 | 464 |

General

465 | 466 |

I am always open to improvements and suggestions. Use issues at github issues.

467 | 468 |

Style

469 | 470 |

I will never accept pull request that do not strictly conform to my style, however you might hate it. You can read the reasoning behind my preferences here.

471 | 472 |

I really don't care about mixed spaces and tabs in (leading) whitespace

473 | 474 |

WARRANTY

475 | 476 |

This tool is by no means a guarantee to show the correct speeds. It is only to be used as an indication of the throughput of your internet connection. The values shown cannot be used in a legal debate.

477 | 478 |

AUTHOR

479 | 480 |

H.Merijn Brand <linux@tux.freedom.nl> wrote this for his own personal use, but was asked to make it publicly available as application.

481 | 482 |

COPYRIGHT AND LICENSE

483 | 484 |

Copyright (C) 2014-2025 H.Merijn Brand

485 | 486 |

This software is free; you can redistribute it and/or modify it under the same terms as Perl itself.

487 | 488 | 489 | 490 | 491 | 492 | -------------------------------------------------------------------------------- /doc/speedtest.3: -------------------------------------------------------------------------------- 1 | .\" -*- mode: troff; coding: utf-8 -*- 2 | .\" Automatically generated by Pod::Man v6.0.2 (Pod::Simple 3.45) 3 | .\" 4 | .\" Standard preamble: 5 | .\" ======================================================================== 6 | .de Sp \" Vertical space (when we can't use .PP) 7 | .if t .sp .5v 8 | .if n .sp 9 | .. 10 | .de Vb \" Begin verbatim text 11 | .ft CW 12 | .nf 13 | .ne \\$1 14 | .. 15 | .de Ve \" End verbatim text 16 | .ft R 17 | .fi 18 | .. 19 | .\" \*(C` and \*(C' are quotes in nroff, nothing in troff, for use with C<>. 20 | .ie n \{\ 21 | . ds C` "" 22 | . ds C' "" 23 | 'br\} 24 | .el\{\ 25 | . ds C` 26 | . ds C' 27 | 'br\} 28 | .\" 29 | .\" Escape single quotes in literal strings from groff's Unicode transform. 30 | .ie \n(.g .ds Aq \(aq 31 | .el .ds Aq ' 32 | .\" 33 | .\" If the F register is >0, we'll generate index entries on stderr for 34 | .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index 35 | .\" entries marked with X<> in POD. Of course, you'll have to process the 36 | .\" output yourself in some meaningful fashion. 37 | .\" 38 | .\" Avoid warning from groff about undefined register 'F'. 39 | .de IX 40 | .. 41 | .nr rF 0 42 | .if \n(.g .if rF .nr rF 1 43 | .if (\n(rF:(\n(.g==0)) \{\ 44 | . if \nF \{\ 45 | . de IX 46 | . tm Index:\\$1\t\\n%\t"\\$2" 47 | .. 48 | . if !\nF==2 \{\ 49 | . nr % 0 50 | . nr F 2 51 | . \} 52 | . \} 53 | .\} 54 | .rr rF 55 | .\" 56 | .\" Required to disable full justification in groff 1.23.0. 57 | .if n .ds AD l 58 | .\" ======================================================================== 59 | .\" 60 | .IX Title "App::SpeedTest 3" 61 | .TH App::SpeedTest 3 2025-03-14 "perl v5.40.1" "User Contributed Perl Documentation" 62 | .\" For nroff, turn off justification. Always turn off hyphenation; it makes 63 | .\" way too many mistakes in technical documents. 64 | .if n .ad l 65 | .nh 66 | .SH NAME 67 | App::SpeedTest \- Command\-line interface to speedtest.net 68 | .SH SYNOPSIS 69 | .IX Header "SYNOPSIS" 70 | .Vb 1 71 | \& $ speedtest [ \-\-no\-geo | \-\-country=NL ] [ \-\-list | \-\-ping ] [ options ] 72 | \& 73 | \& $ speedtest \-\-list 74 | \& $ speedtest \-\-ping \-\-country=BE 75 | \& $ speedtest 76 | \& $ speedtest \-s 4358 77 | \& $ speedtest \-\-url=http://ookla.extraip.net 78 | \& $ speedtest \-q \-\-no\-download 79 | \& $ speedtest \-Q \-\-no\-upload 80 | .Ve 81 | .SH DESCRIPTION 82 | .IX Header "DESCRIPTION" 83 | The provided perl script is a command\-line interface to the 84 | speedtest.net infrastructure so that 85 | flash is not required 86 | .PP 87 | It was written to feature the functionality that speedtest.net offers 88 | without the overhead of flash or java and the need of a browser. 89 | .SH Raison\-d\*(Aqêtre 90 | .IX Header "Raison-d'être" 91 | The tool is there to give you a quick indication of the achievable 92 | throughput of your current network. That can drop dramatically if 93 | you are behind (several) firewalls or badly configured networks (or 94 | network parts like switches, hubs and routers). 95 | .PP 96 | It was inspired by speedtest\-cli , 97 | a project written in python. But I neither like python, nor did I like the 98 | default behavior of that script. I also think it does not take the right 99 | decisions in choosing the server based on distance instead of speed. That 100 | \&\fBdoes\fR matter if one has fiber lines. I prefer speed over distance. 101 | .SH "Command\-line Arguments" 102 | .IX Xref "CLIA" 103 | .IX Header "Command-line Arguments" 104 | .IP "\-? | \-\-help" 2 105 | .IX Xref "-? --help" 106 | .IX Item "-? | --help" 107 | Show all available options and then exit. 108 | .IP "\-V | \-\-version" 2 109 | .IX Xref "-V --version" 110 | .IX Item "-V | --version" 111 | Show program version and exit. 112 | .IP \-\-man 2 113 | .IX Xref "--man" 114 | .IX Item "--man" 115 | Show the builtin manual using \f(CW\*(C`pod2man\*(C'\fR and \f(CW\*(C`nroff\*(C'\fR. 116 | .IP \-\-info 2 117 | .IX Xref "--info" 118 | .IX Item "--info" 119 | Show the builtin manual using \f(CW\*(C`pod2text\*(C'\fR. 120 | .IP "\-v[#] | \-\-verbose[=#]" 2 121 | .IX Xref "-v --version" 122 | .IX Item "-v[#] | --verbose[=#]" 123 | Set verbose level. Default value is 1. A plain \-v without value will set 124 | the level to 2. 125 | .IP \-\-simple 2 126 | .IX Xref "--simple" 127 | .IX Item "--simple" 128 | An alias for \f(CW\*(C`\-v0\*(C'\fR 129 | .IP \-\-all 2 130 | .IX Xref "--all" 131 | .IX Item "--all" 132 | No (default) filtering on available servers. Useful when finding servers 133 | outside of the country of your own location. 134 | .IP "\-g | \-\-geo" 2 135 | .IX Xref "-g --geo" 136 | .IX Item "-g | --geo" 137 | Use GEO\-IP service to find the country your ISP is located. The default 138 | is true. If disable (\f(CW\*(C`\-\-no\-geo\*(C'\fR), the server to use will be based on 139 | distance instead of on latency. 140 | .IP "\-cXX | \-\-cc=XX | \-\-country=XX" 2 141 | .IX Xref "-c --cc --country" 142 | .IX Item "-cXX | --cc=XX | --country=XX" 143 | Pass the ISO country code to select the servers 144 | .Sp 145 | .Vb 3 146 | \& $ speedtest \-c NL ... 147 | \& $ speedtest \-\-cc=B ... 148 | \& $ speedtest \-\-country=D ... 149 | .Ve 150 | .IP \-\-list\-cc 2 151 | .IX Xref "--list-cc" 152 | .IX Item "--list-cc" 153 | Fetch the server list and then show the list of countries the servers are 154 | located with their country code and server count 155 | .Sp 156 | .Vb 5 157 | \& $ speedtest \-\-list\-cc 158 | \& AD Andorra 1 159 | \& AE United Arab Emirates 4 160 | \& : 161 | \& ZW Zimbabwe 6 162 | .Ve 163 | .Sp 164 | You can then use that code to list the servers in the chosen country, as 165 | described below. 166 | .IP "\-l | \-\-list" 2 167 | .IX Xref "-l --list" 168 | .IX Item "-l | --list" 169 | This option will show all servers in the selection with the distance in 170 | kilometers to the server. 171 | .Sp 172 | .Vb 11 173 | \& $ speedtest \-\-list \-\-country=IS 174 | \& 1: 10661 \- Tengir hf Akureyri 1980.02 km 175 | \& 2: 21605 \- Premis ehf Reykjavík 2039.16 km 176 | \& 3: 3684 \- Nova Reykjavik 2039.16 km 177 | \& 4: 6471 \- Gagnaveita Reykjavikur Reykjavik 2039.16 km 178 | \& 5: 10650 \- Nova VIP Reykjavik 2039.16 km 179 | \& 6: 16148 \- Hringidan Reykjavik 2039.16 km 180 | \& 7: 4818 \- Siminn Reykjavik 2039.16 km 181 | \& 8: 17455 \- Hringdu Reykjavík 2039.16 km 182 | \& 9: 4141 \- Vodafone Reykjavík 2039.16 km 183 | \& 10: 3644 \- Snerpa Isafjordur 2192.27 km 184 | .Ve 185 | .IP "\-p | \-\-ping | \-\-ping=40" 2 186 | .IX Xref "-p --ping" 187 | .IX Item "-p | --ping | --ping=40" 188 | Show a list of servers in the selection with their latency in ms. 189 | Be very patient if running this with "\-\-all". 190 | .Sp 191 | .Vb 10 192 | \& $ speedtest \-\-ping \-\-cc=BE 193 | \& 1: 4320 \- EDPnet Sint\-Niklaas 148.06 km 52 ms 194 | \& 2: 12627 \- Proximus Brussels 173.04 km 55 ms 195 | \& 3: 10986 \- Proximus Schaarbeek 170.54 km 55 ms 196 | \& 4: 15212 \- Telenet BVBA/SPRL Mechelen 133.89 km 57 ms 197 | \& 5: 29238 \- Arcadiz DIEGEM 166.33 km 58 ms 198 | \& 6: 5151 \- Combell Brussels 173.04 km 59 ms 199 | \& 7: 26887 \- Arxus NV Brussels 173.04 km 64 ms 200 | \& 8: 4812 \- Universite Catholiq… Louvain\-La\-Neuv 186.87 km 70 ms 201 | \& 9: 2848 \- Cu.be Solutions Diegem 166.33 km 75 ms 202 | \& 10: 12306 \- VOO Liège 186.26 km 80 ms 203 | \& 11: 24261 \- Une Nouvelle Ville… Charleroi 217.48 km 147 ms 204 | \& 12: 30594 \- Orange Belgium Evere 169.29 km 150 ms 205 | .Ve 206 | .Sp 207 | If a server does not respond, a very high latency is used as default. 208 | .Sp 209 | This option only shows the 40 nearest servers. The number can be changed 210 | as optional argument. 211 | .Sp 212 | .Vb 5 213 | \& $ speedtest \-\-cc=BE \-\-ping=4 214 | \& 1: 4320 \- EDPnet Sint\-Niklaas 148.06 km 53 ms 215 | \& 2: 29238 \- Arcadiz DIEGEM 166.33 km 57 ms 216 | \& 3: 15212 \- Telenet BVBA/SPRL Mechelen 133.89 km 62 ms 217 | \& 4: 2848 \- Cu.be Solutions Diegem 166.33 km 76 ms 218 | .Ve 219 | .IP "\-1 | \-\-one\-line" 2 220 | .IX Xref "-1 --ono-line" 221 | .IX Item "-1 | --one-line" 222 | Generate a very short report easy to paste in e.g. IRC channels. 223 | .Sp 224 | .Vb 2 225 | \& $ speedtest \-1Qv0 226 | \& DL: 40.721 Mbit/s, UL: 30.307 Mbit/s 227 | .Ve 228 | .IP "\-B | \-\-bytes" 2 229 | .IX Xref "-B --bytes" 230 | .IX Item "-B | --bytes" 231 | Report throughput in Mbyte/s instead of Mbit/s 232 | .IP "\-C | \-\-csv" 2 233 | .IX Xref "-C --csv" 234 | .IX Item "-C | --csv" 235 | Generate the measurements in CSV format. The data can be collected in 236 | a file (by a cron job) to be able to follow internet speed over time. 237 | .Sp 238 | The reported fields are 239 | .Sp 240 | .Vb 8 241 | \& \- A timestam (the time the tests are finished) 242 | \& \- The server ID 243 | \& \- The latency in ms 244 | \& \- The number of tests executed in this measurement 245 | \& \- The direction of the test (D = Down, U = Up) 246 | \& \- The measure avarage speed in Mbit/s 247 | \& \- The minimum speed measured in one of the test in Mbit/s 248 | \& \- The maximum speed measured in one of the test in Mbit/s 249 | \& 250 | \& $ speedtest \-Cs4358 251 | \& "2015\-01\-24 17:15:09",4358,63.97,40,D,93.45,30.39,136.93 252 | \& "2015\-01\-24 17:15:14",4358,63.97,40,U,92.67,31.10,143.06 253 | .Ve 254 | .IP "\-U | \-\-skip\-undef" 2 255 | .IX Xref "-U --skip-undef" 256 | .IX Item "-U | --skip-undef" 257 | Skip reporting measurements that have no speed recordings at all. 258 | The default is to report these as \f(CW0.00\fR .. \f(CW999999999.999\fR. 259 | .IP "\-P | \-\-prtg" 2 260 | .IX Xref "-P --prtg" 261 | .IX Item "-P | --prtg" 262 | Generate the measurements in XML suited for PRTG 263 | .Sp 264 | .Vb 10 265 | \& $ speedtest \-P 266 | \& 267 | \& 268 | \& Testing from My ISP (10.20.30.40) 269 | \& 270 | \& Ping 271 | \& ms 272 | \& 1 273 | \& 56.40 274 | \& 275 | \& 276 | \& Download 277 | \& Mbit/s 278 | \& 1 279 | \& 38.34 280 | \& 281 | \& 282 | \& Upload 283 | \& Mbit/s 284 | \& 1 285 | \& 35.89 286 | \& 287 | \& 288 | .Ve 289 | .IP \-\-url[=XXX] 2 290 | .IX Xref "--url" 291 | .IX Item "--url[=XXX]" 292 | With no value, show server url in list 293 | .Sp 294 | With value, use specific server url: do not scan available servers 295 | .IP \-\-ip 2 296 | .IX Xref "--ip" 297 | .IX Item "--ip" 298 | Show IP for server 299 | .IP "\-T[#] | \-\-try[=#]" 2 300 | .IX Xref "-T --try" 301 | .IX Item "-T[#] | --try[=#]" 302 | Use the top # (based on lowest latency or shortest distance) from the list 303 | to do all required tests. 304 | .Sp 305 | .Vb 2 306 | \& $ speedtest \-T3 \-c NL \-Q2 307 | \& Testing for 80.x.y.z : XS4ALL Internet BV (NL) 308 | \& 309 | \& Using 13218: 26.52 km 25 ms XS4ALL Internet BV 310 | \& Test download .. Download 31.807 Mbit/s 311 | \& Test upload .. Upload 86.587 Mbit/s 312 | \& 313 | \& Using 15850: 26.09 km 25 ms QTS Data Centers 314 | \& Test download .. Download 80.763 Mbit/s 315 | \& Test upload .. Upload 77.122 Mbit/s 316 | \& 317 | \& Using 11365: 26.09 km 27 ms Vancis 318 | \& Test download .. Download 106.022 Mbit/s 319 | \& Test upload .. Upload 82.891 Mbit/s 320 | \& 321 | \& Rank 01: Server: 11365 26.09 km 27 ms, DL: 106.022 UL: 82.891 322 | \& Rank 02: Server: 15850 26.09 km 25 ms, DL: 80.763 UL: 77.122 323 | \& Rank 03: Server: 13218 26.52 km 25 ms, DL: 31.807 UL: 86.587 324 | \& 325 | \& $ speedtest \-1v0 \-T5 326 | \& DL: 200.014 Mbit/s, UL: 159.347 Mbit/s, SRV: 13218 327 | \& DL: 203.599 Mbit/s, UL: 166.247 Mbit/s, SRV: 15850 328 | \& DL: 207.249 Mbit/s, UL: 134.957 Mbit/s, SRV: 11365 329 | \& DL: 195.490 Mbit/s, UL: 172.109 Mbit/s, SRV: 5972 330 | \& DL: 179.413 Mbit/s, UL: 160.309 Mbit/s, SRV: 2042 331 | \& 332 | \& Rank 01: Server: 15850 26.09 km 30 ms, DL: 203.599 UL: 166.247 333 | \& Rank 02: Server: 5972 26.09 km 32 ms, DL: 195.490 UL: 172.109 334 | \& Rank 03: Server: 13218 26.52 km 23 ms, DL: 200.014 UL: 159.347 335 | \& Rank 04: Server: 11365 26.09 km 31 ms, DL: 207.249 UL: 134.957 336 | \& Rank 05: Server: 2042 51.41 km 33 ms, DL: 179.413 UL: 160.309 337 | .Ve 338 | .IP "\-s# | \-\-server=# | \-\-server=filename" 2 339 | .IX Xref "-s --server" 340 | .IX Item "-s# | --server=# | --server=filename" 341 | Specify the ID of the server to test against. This ID can be taken from the 342 | output of "\-\-list" or "\-\-ping". Using this option prevents fetching the 343 | complete server list and calculation of distances. It also enables you to 344 | always test against the same server. 345 | .Sp 346 | .Vb 6 347 | \& $ speedtest \-1s4358 348 | \& Testing for 80.x.y.z : XS4ALL Internet BV () 349 | \& Using 4358: 52.33 km 64 ms KPN 350 | \& Test download ........................................Download: 92.633 Mbit/s 351 | \& Test upload ........................................Upload: 92.552 Mbit/s 352 | \& DL: 92.633 Mbit/s, UL: 92.552 Mbit/s 353 | .Ve 354 | .Sp 355 | This argument may be repeated to test against multile servers, more or less 356 | like specifying your own top x (as with \f(CW\*(C`\-T\*(C'\fR). 357 | .Sp 358 | .Vb 2 359 | \& $ speedtest \-s 22400 \-s 1208 \-s 13218 360 | \& Testing for 185.x.y.z : Freedom Internet BV () 361 | \& 362 | \& Using 13218: 80.15 km 32 ms XS4ALL Internet BV 363 | \& Test download ........................................Download 66.833 Mbit/s 364 | \& Test upload ........................................Upload 173.317 Mbit/s 365 | \& 366 | \& Using 1208: 51.19 km 37 ms Qweb | Full\-Service Hosting 367 | \& Test download ........................................Download 52.077 Mbit/s 368 | \& Test upload ........................................Upload 195.833 Mbit/s 369 | \& 370 | \& Using 22400: 80.15 km 46 ms Usenet.Farm 371 | \& Test download ........................................Download 96.341 Mbit/s 372 | \& Test upload ........................................Upload 203.306 Mbit/s 373 | \& 374 | \& Rank 01: Server: 22400 80.15 km 46 ms, DL: 96.341 UL: 203.306 375 | \& Rank 02: Server: 1208 51.19 km 37 ms, DL: 52.077 UL: 195.833 376 | \& Rank 03: Server: 13218 80.15 km 32 ms, DL: 66.833 UL: 173.317 377 | .Ve 378 | .Sp 379 | If you pass a filename, it is expected to reflect a server\-like structure as 380 | received from the speedtest server\-list, possibly completed with upload\- and 381 | download URL\*(Aqs. You can only pass one filename not consisting of all digits. 382 | If you do, all remaining \f(CW\*(C`\-s\*(C'\fR arguments are ignored. 383 | .Sp 384 | .Vb 11 385 | \& { cc => "NL", 386 | \& country => "Netherlands", 387 | \& host => "unlisted.host.amsterdam:8080", 388 | \& id => 9999, 389 | \& lat => "52.37316", 390 | \& lon => "4.89122", 391 | \& name => "Amsterdam", 392 | \& ping => 20.0, 393 | \& sponsor => "Dam tot Damloop", 394 | \& url => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 395 | \& url2 => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 396 | \& 397 | \& dl_list => [ 398 | \& "http://unlisted.host.amsterdam/files/128.bin", 399 | \& "http://unlisted.host.amsterdam/files/256.bin", 400 | \& # 40 URL\*(Aqs pointing to files in increasing size 401 | \& "http://unlisted.host.amsterdam/files/2G.bin", 402 | \& ], 403 | \& ul_list => [ 404 | \& # 40 URL\*(Aqs 405 | \& ], 406 | \& } 407 | .Ve 408 | .IP "\-t# | \-\-timeout=#" 2 409 | .IX Xref "-t --timeout" 410 | .IX Item "-t# | --timeout=#" 411 | Specify the maximum timeout in seconds. 412 | .IP "\-d | \-\-download" 2 413 | .IX Xref "-d --download" 414 | .IX Item "-d | --download" 415 | Run the download tests. This is default unless "\-\-upload" is passed. 416 | .IP "\-u | \-\-upload" 2 417 | .IX Xref "-u --upload" 418 | .IX Item "-u | --upload" 419 | Run the upload tests. This is default unless "\-\-download" is passed. 420 | .IP "\-q[#] | \-\-quick[=#] | \-\-fast[=#]" 2 421 | .IX Xref "-q --quick --fast" 422 | .IX Item "-q[#] | --quick[=#] | --fast[=#]" 423 | Don\*(Aqt run the full test. The default test runs 40 tests, sorting on 424 | increasing test size (and thus test duration). Long(er) tests may take 425 | too long on slow connections without adding value. The default value 426 | for \f(CW\*(C`\-q\*(C'\fR is 20 but any value between 1 and 40 is allowed. 427 | .IP "\-Q[#] | \-\-realquick[=#]" 2 428 | .IX Xref "-Q --realquick" 429 | .IX Item "-Q[#] | --realquick[=#]" 430 | Don\*(Aqt run the full test. The default test runs 40 tests, sorting on 431 | increasing test size (and thus test duration). Long(er) tests may take 432 | too long on slow connections without adding value. The default value 433 | for \f(CW\*(C`\-Q\*(C'\fR is 10 but any value between 1 and 40 is allowed. 434 | .IP "\-mXX | \-\-mini=XX" 2 435 | .IX Xref "-m --mini" 436 | .IX Item "-mXX | --mini=XX" 437 | Run the speedtest on a speedtest mini server. 438 | .IP \-\-source=XX 2 439 | .IX Item "--source=XX" 440 | NYI \- mentioned for speedtest\-cli compatibility 441 | .SH EXAMPLES 442 | .IX Header "EXAMPLES" 443 | See "SYNOPSIS" and Command\-line arguments 444 | .SH DIAGNOSTICS 445 | .IX Header "DIAGNOSTICS" 446 | \&... 447 | .SH "BUGS and CAVEATS" 448 | .IX Header "BUGS and CAVEATS" 449 | Due to language implementation, it may report speeds that are not 450 | consistent with the speeds reported by the web interface or other 451 | speed\-test tools. Likewise for reported latencies, which are not 452 | to be compared to those reported by tools like ping. 453 | .SH TODO 454 | .IX Header "TODO" 455 | .IP "Improve documentation" 2 456 | .IX Item "Improve documentation" 457 | What did I miss? 458 | .IP "Enable alternative XML parsers" 2 459 | .IX Item "Enable alternative XML parsers" 460 | XML::Simple is not the recommended XML parser, but it sufficed on 461 | startup. All other API\*(Aqs are more complex. 462 | .SH PORTABILITY 463 | .IX Header "PORTABILITY" 464 | As Perl has been ported to a plethora of operating systems, this CLI 465 | will work fine on all systems that fulfill the requirement as listed 466 | in Makefile.PL (or the various META files). 467 | .PP 468 | The script has been tested on Linux, HP\-UX, AIX, and Windows 7. 469 | .PP 470 | Debian wheezy will run with just two additional packages: 471 | .PP 472 | .Vb 1 473 | \& # apt\-get install libxml\-simple\-perl libdata\-peek\-perl 474 | .Ve 475 | .SH "SEE ALSO" 476 | .IX Header "SEE ALSO" 477 | As an alternative to speedtest.net , you 478 | could consider . 479 | .PP 480 | The speedtest\-cli project 481 | that inspired me to improve a broken CLI written in python into our 482 | beloved language Perl. 483 | .SH CONTRIBUTING 484 | .IX Header "CONTRIBUTING" 485 | .SS General 486 | .IX Subsection "General" 487 | I am always open to improvements and suggestions. Use issues at 488 | github issues . 489 | .SS Style 490 | .IX Subsection "Style" 491 | I will never accept pull request that do not strictly conform to my 492 | style, however you might hate it. You can read the reasoning behind 493 | my preferences here . 494 | .PP 495 | I really don\*(Aqt care about mixed spaces and tabs in (leading) whitespace 496 | .SH WARRANTY 497 | .IX Header "WARRANTY" 498 | This tool is by no means a guarantee to show the correct speeds. It 499 | is only to be used as an indication of the throughput of your internet 500 | connection. The values shown cannot be used in a legal debate. 501 | .SH AUTHOR 502 | .IX Header "AUTHOR" 503 | H.Merijn Brand \fI\fR wrote this for his own 504 | personal use, but was asked to make it publicly available as application. 505 | .SH "COPYRIGHT AND LICENSE" 506 | .IX Header "COPYRIGHT AND LICENSE" 507 | Copyright (C) 2014\-2025 H.Merijn Brand 508 | .PP 509 | This software is free; you can redistribute it and/or modify 510 | it under the same terms as Perl itself. 511 | -------------------------------------------------------------------------------- /sandbox/genMETA.pm: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | package genMETA; 4 | 5 | our $VERSION = "1.18-20250113"; 6 | 7 | use 5.014001; 8 | use warnings; 9 | use Carp; 10 | 11 | use CPAN::Meta::Converter; 12 | use CPAN::Meta::Validator; 13 | use Data::Peek; 14 | use Date::Calc qw( Delta_Days ); 15 | use Encode qw( encode decode ); 16 | use File::Find; 17 | use JSON::PP; 18 | use List::Util qw( first ); 19 | use Parse::CPAN::Meta; 20 | use Software::Security::Policy::Individual; 21 | use Term::ANSIColor qw(:constants); 22 | use Test::CPAN::Meta::YAML::Version; 23 | use Test::More (); 24 | use Text::Diff; 25 | use YAML::Syck; 26 | 27 | sub new { 28 | my $package = shift; 29 | return bless { @_ }, $package; 30 | } # new 31 | 32 | sub extract_version { 33 | my $fh = shift; 34 | my @vsn; 35 | while (<$fh>) { 36 | m/\$VERSION\b/ and push @vsn => $_; 37 | m{^(?:our\s+)? # declaration 38 | \$VERSION \s*=\s* # variable 39 | ["']? ([0-9._]+) # version 40 | (?:\s* - \s* [0-9]{4}-?[0-9]{2}-?[0-9]{2} \s*)? # date "0.01 - 20230412" 41 | ['"]? 42 | \s*;\s* 43 | (?:\x23 \s* [0-9]{4}-?[0-9]{2}-?[0-9]{2} \s*)? # date "0.01"; # 20230502 44 | $}x or next; 45 | return $1; 46 | } 47 | # No match on first scan, try without date 48 | for (@vsn) { 49 | m{^(?:our\s+)? # declaration 50 | \$VERSION \s*=\s* # variable 51 | ([""'']) ([0-9._]+) \1 # version 52 | \s*; 53 | }x or next; 54 | return $2; 55 | } 56 | } # extract_version 57 | 58 | sub version_from { 59 | my ($self, $src) = @_; 60 | 61 | $self->{mfpr} = {}; 62 | if (open my $mh, "<", "Makefile.PL") { 63 | my $mf = do { local $/; <$mh> }; 64 | 65 | if ($mf =~ m{\b NAME \s*=>\s* ["'] (\S+) ['"]}x) { 66 | $self->{name} = $1; 67 | $self->{name} =~ m/-/ and 68 | warn RED, "NAME in Makefile.PL contains a -", RESET, "\n"; 69 | $self->{name} =~ s/::/-/g; 70 | } 71 | if ($mf =~ m{\b DISTNAME \s*=>\s* ["'] (\S+) ['"]}x) { 72 | $self->{name} = $1; 73 | } 74 | 75 | if ($mf =~ m{\b VERSION_FROM \s*=>\s* ["'] (\S+) ['"]}x) { 76 | my $from = $1; 77 | -f $from or 78 | croak RED, "Makefile wants version from nonexisten $from", RESET, "\n"; 79 | $self->{from} //= $from; 80 | $from eq $self->{from} or 81 | croak RED, "VERSION_FROM mismatch Makefile.PL ($from) / YAML ($self->{from})", RESET, "\n"; 82 | } 83 | 84 | if ($mf =~ m[\b PREREQ_PM \s*=>\s* \{ ( [^}]+ ) \}]x) { 85 | my @pr = split m/\n/ => $1; 86 | $self->{mfpr} = { map { (m{ \b ["']? (\S+?) ['"]? \s*=>\s* ["']? ([-0-9._]+) ['"]? }x) } grep !m/^\s*#/ => @pr }; 87 | } 88 | 89 | $mf =~ m{--format=ustar} or 90 | warn RED, "TARFLAGS macro is missing", RESET, "\n"; 91 | } 92 | 93 | $src //= $self->{from} or croak "No file to extract version from"; 94 | 95 | open my $pm, "<", $src or croak "Cannot read $src"; 96 | my $version = extract_version ($pm) or croak "Cannot extract VERSION from $src\n"; 97 | close $pm; 98 | $self->{version} = $version; 99 | return $version 100 | } # version_from 101 | 102 | sub from_data { 103 | my ($self, @data) = @_; 104 | $self->{version} or $self->version_from (); 105 | s/VERSION/$self->{version}/g for @data; 106 | my ($dsct, $dmod); 107 | for (@data) { 108 | s/[ \t]+$//; 109 | m/^\s*(\w+):$/ and $dsct = $1; 110 | m/^\s*(\w(?:[\w:]+\w)?):\s+\d/ and $dmod = $1; 111 | s/\s+#\s*ignore\b\s*[:=]?\s*(\S+)$//i or next; 112 | $self->{cve_ignore}{$dsct}{$dmod} = $1; 113 | } 114 | $self->{yml} = \@data; 115 | $self->check_yaml (); 116 | $self->check_provides (); 117 | #DDumper $self->{cve_ignore}; 118 | return @data; 119 | } # from_data 120 | 121 | sub check_encoding { 122 | my $self = shift; 123 | my @tf = grep m{^(?: change | readme | .*\.pod )}ix => glob "*"; 124 | (my $tf = join ", " => @tf) =~ s/.*\K, / and /; 125 | 126 | print "Check if $tf are still valid UTF8 ...\n"; 127 | foreach my $tf (@tf) { 128 | open my $fh, "<", $tf or croak "$tf: $!\n"; 129 | my @c = <$fh>; 130 | my $c = join "" => @c; 131 | my @e; 132 | my $s = decode ("utf-8", $c, sub { push @e, shift; }); 133 | if (@e) { 134 | my @l; 135 | my $n = 0; 136 | for (@c) { 137 | $n++; 138 | eval { decode ("utf-8", $_, 1) }; 139 | $@ or next; 140 | $@ =~ s{ at /\S+ line \d+.*}{}; 141 | print BLUE, "$tf:$n\t$_\t$@", RESET; 142 | } 143 | croak "$tf is not valid UTF-8\n"; 144 | } 145 | my $u = encode ("utf-8", $s); 146 | $c eq $u and next; 147 | 148 | my $n; 149 | $n = 1; $c =~ s/^/$n++ . "\t"/gem; 150 | $n = 1; $u =~ s/^/$n++ . "\t"/gem; 151 | croak "$tf: recode makes content differ\n". diff \$c, \$u; 152 | } 153 | } # check_encoding 154 | 155 | sub check_required { 156 | my $self = shift; 157 | 158 | my $yml = $self->{h} or croak "No YAML to check"; 159 | 160 | warn "Check required and recommended module versions ...\n"; 161 | BEGIN { $V::NO_EXIT = $V::NO_EXIT = 1 } require V; 162 | my %req = map { %{$yml->{$_}} } grep m/requires/ => keys %{$yml}; 163 | my %rec = map { %{$yml->{$_}} } grep m/recommends/ => keys %{$yml}; 164 | my %sug = map { %{$yml->{$_}} } grep m/suggests/ => keys %{$yml}; 165 | if (my $of = $yml->{optional_features}) { 166 | foreach my $f (values %{$of}) { 167 | my %q = map { %{$f->{$_}} } grep m/requires/ => keys %{$f}; 168 | my %c = map { %{$f->{$_}} } grep m/recommends/ => keys %{$f}; 169 | my %s = map { %{$f->{$_}} } grep m/suggests/ => keys %{$f}; 170 | @req{keys %q} = values %q; 171 | @rec{keys %c} = values %c; 172 | @sug{keys %s} = values %s; 173 | } 174 | } 175 | if (my $of = $yml->{prereqs}) { 176 | foreach my $f (values %{$of}) { 177 | my %q = map { %{$f->{$_}} } grep m/requires/ => keys %{$f}; 178 | my %c = map { %{$f->{$_}} } grep m/recommends/ => keys %{$f}; 179 | my %s = map { %{$f->{$_}} } grep m/suggests/ => keys %{$f}; 180 | @req{keys %q} = values %q; 181 | @rec{keys %c} = values %c; 182 | @sug{keys %s} = values %s; 183 | } 184 | } 185 | my %vsn = ( %req, %rec, %sug ); 186 | delete @vsn{qw( perl version )}; 187 | for (sort keys %vsn) { 188 | if (my $mfv = delete $self->{mfpr}{$_}) { 189 | $req{$_} eq $mfv or 190 | croak RED, "PREREQ mismatch for $_ Makefile.PL ($mfv) / YAML ($req{$_})", RESET, "\n"; 191 | } 192 | $vsn{$_} eq "0" and next; 193 | my $v = V::get_version ($_); 194 | $v eq $vsn{$_} and next; 195 | printf STDERR "%s%-35s %-6s => %s%s%s\n", BLUE, $_, $vsn{$_}, GREEN, $v, RESET; 196 | } 197 | if (my @mfpr = grep { $_ ne "version" } sort keys %{$self->{mfpr}}) { 198 | croak RED, "Makefile.PL requires @mfpr, YAML does not", RESET, "\n"; 199 | } 200 | 201 | find (sub { 202 | $File::Find::dir =~ m{^blib\b} and return; 203 | $File::Find::name =~ m{(?:^|/)Bundle/.*\.pm} or return; 204 | if (open my $bh, "<", $_) { 205 | warn "Check bundle module versions $File::Find::name ...\n"; 206 | while (<$bh>) { 207 | my ($m, $dv) = m/^([A-Za-z_:]+)\s+([0-9.]+)\s*$/ or next; 208 | my $v = $m eq $self->{name} ? $self->{version} : V::get_version ($m); 209 | $v eq $dv and next; 210 | printf STDERR "%s%-35s %-6s => %s%s%s\n", BLUE, $m, $dv, GREEN, $v, RESET; 211 | } 212 | } 213 | }, glob "*"); 214 | } # check_required 215 | 216 | sub check_yaml { 217 | my $self = shift; 218 | 219 | my @yml = @{$self->{yml}} or croak "No YAML to check"; 220 | 221 | warn "Checking generated YAML ...\n" unless $self->{quiet}; 222 | my $h; 223 | my $yml = join "", @yml; 224 | eval { $h = Load ($yml) }; 225 | $@ and croak "$@\n"; 226 | $self->{name} //= $h->{name}; 227 | $self->{name} eq $h->{name} or 228 | croak RED, "NAME mismatch Makefile.PL / YAML", RESET, "\n"; 229 | $self->{name} =~ s/-/::/g; 230 | warn "Checking for $self->{name}-$self->{version}\n" unless $self->{quiet}; 231 | 232 | $self->{verbose} and print Dump $h; 233 | 234 | my $t = Test::CPAN::Meta::YAML::Version->new (data => $h); 235 | $t->parse () and 236 | croak join "\n", "Test::CPAN::Meta::YAML reported failure:", $t->errors, ""; 237 | 238 | eval { Parse::CPAN::Meta::Load ($yml) }; 239 | $@ and croak "$@\n"; 240 | 241 | $self->{h} = $h; 242 | $self->{yaml} = $yml; 243 | } # check_yaml 244 | 245 | sub check_minimum { 246 | my $self = shift; 247 | my $reqv = $self->{h}{requires}{perl} || $self->{h}{prereqs}{runtime}{requires}{perl}; 248 | my $locs; 249 | 250 | for (@_) { 251 | if (ref $_ eq "ARRAY") { 252 | $locs = { paths => $_ }; 253 | } 254 | elsif (ref $_ eq "HASH") { 255 | $locs = $_; 256 | } 257 | else { 258 | $reqv = $_; 259 | } 260 | } 261 | my $paths = (join ", " => @{($locs // {})->{paths} // []}) || "default paths"; 262 | 263 | $reqv or croak "No minimal required version for perl"; 264 | my $tmv = 0; 265 | $reqv > 5.009 and eval "use Test::MinimumVersion::Fast; \$tmv = 1"; 266 | $tmv or eval "use Test::MinimumVersion;"; 267 | print "Checking if $reqv is still OK as minimal version for $paths\n"; 268 | # All other minimum version checks done in xt 269 | Test::More::subtest "Minimum perl version $reqv" => sub { 270 | all_minimum_version_ok ($reqv, $locs); 271 | } or warn RED, "\n### Use 'perlver --blame' on the failing file(s)\n\n", RESET; 272 | } # check_minimum 273 | 274 | sub check_provides { 275 | my $self = shift; 276 | my $prov = $self->{h}{provides}; 277 | 278 | print "Check distribution module versions ...\n"; 279 | 280 | $prov or croak RED, "META does not contain a provides section", RESET, "\n"; 281 | 282 | ref $prov eq "HASH" or 283 | croak RED, "The provides section in META is not a HASH", RESET, "\n"; 284 | 285 | my $fail = 0; 286 | foreach my $m (sort keys %{$prov}) { 287 | my ($file, $pvsn) = @{$prov->{$m}}{qw( file version )}; 288 | unless ($file) { 289 | $fail++; 290 | say RED, " provided $m does not refer to a file", RESET; 291 | next; 292 | } 293 | unless ($pvsn) { 294 | $fail++; 295 | say RED, " provided $m does not declare a version", RESET; 296 | next; 297 | } 298 | 299 | printf " Expect %5s for %-32s ", $pvsn, $m; 300 | open my $fh, "<", $file; 301 | unless ($fh) { 302 | $fail++; 303 | say RED, "$file: $!\n", RESET; 304 | next; 305 | } 306 | 307 | my $version = extract_version ($fh); 308 | close $fh; 309 | unless ($version) { 310 | $fail++; 311 | say RED, "$file does not contain a VERSION", RESET; 312 | next; 313 | } 314 | 315 | if ($version ne $pvsn) { 316 | $fail++; 317 | say RED, "mismatch: $version", RESET; 318 | next; 319 | } 320 | say "ok"; 321 | } 322 | 323 | $fail and exit 1; 324 | } # check_provides 325 | 326 | sub check_changelog { 327 | # Check if the first date has been updated ... 328 | my @td = grep m/^Change(?:s|Log)$/i => glob "[Cc]*"; 329 | unless (@td) { 330 | warn "No ChangeLog to check\n"; 331 | return; 332 | } 333 | my %mnt = qw( jan 1 feb 2 mar 3 apr 4 may 5 jun 6 jul 7 aug 8 sep 9 oct 10 nov 11 dec 12 ); 334 | open my $fh, "<", $td[0] or croak "$td[0]: $!\n"; 335 | while (<$fh>) { 336 | s/\b([0-9]{4}) (?:[- ]) 337 | ([0-9]{1,2}) (?:[- ]) 338 | ([0-9]{1,2})\b/$3-$2-$1/x; # 2015-01-15 => 15-01-2015 339 | m/\b([0-9]{1,2}) (?:[- ]) 340 | ([0-9]{1,2}|[ADFJMNOSadfjmnos][acekopu][abcgilnprtvy]) (?:[- ]) 341 | ([0-9]{4})\b/x or next; 342 | my ($d, $m, $y) = ($1 + 0, ($mnt{lc $2} || $2) + 0, $3 + 0); 343 | printf STDERR "Most recent ChangeLog entry is dated %02d-%02d-%04d\n", $d, $m, $y; 344 | unless ($ENV{SKIP_CHANGELOG_DATE}) { 345 | my @t = localtime; 346 | my $D = Delta_Days ($y, $m , $d, $t[5] + 1900, $t[4] + 1, $t[3]); 347 | $D < 0 and croak RED, "Last entry in $td[0] is in the future!", RESET, "\n"; 348 | $D > 2 and croak RED, "Last entry in $td[0] is not up to date ($D days ago)", RESET, "\n"; 349 | $D > 0 and warn YELLOW, "Last entry in $td[0] is not today", RESET, "\n"; 350 | } 351 | last; 352 | } 353 | close $fh; 354 | } # check_changelog 355 | 356 | sub done_testing { 357 | check_changelog (); 358 | Test::More::done_testing (); 359 | } # done_testing 360 | 361 | sub quiet { 362 | my $self = shift; 363 | @_ and $self->{quiet} = defined $_[0]; 364 | $self->{quiet}; 365 | } # quiet 366 | 367 | sub print_json { 368 | my $self = shift; 369 | my $jsn = $self->{jsn} || $self->add_json (); 370 | print JSON::PP->new->utf8 (1)->pretty (1)->encode ($jsn); 371 | } # print_json 372 | 373 | sub print_yaml { 374 | my $self = shift; 375 | print @{$self->{yml}}; 376 | } # print_yaml 377 | 378 | sub write_yaml { 379 | my ($self, $out) = @_; 380 | $out ||= "META.yml"; 381 | $out =~ s/\.jso?n$/.yml/; 382 | open my $fh, ">", $out or croak "$out: $!\n"; 383 | print $fh @{$self->{yml}}; 384 | close $fh; 385 | $self->fix_meta ($out); 386 | } # print_yaml 387 | 388 | sub add_json { 389 | my $self = shift; 390 | # Convert to meta-spec version 2 391 | # licenses are lists now 392 | my $jsn = $self->{h}; 393 | $jsn->{"meta-spec"} = { 394 | version => "2", 395 | url => "https://metacpan.org/module/CPAN::Meta::Spec?#meta-spec", 396 | }; 397 | exists $jsn->{resources}{license} and 398 | $jsn->{resources}{license} = [ $jsn->{resources}{license} ]; 399 | delete $jsn->{distribution_type}; 400 | if (exists $jsn->{license}) { 401 | if (ref $jsn->{license} eq "ARRAY") { 402 | $jsn->{license}[0] =~ s/^perl$/perl_5/i; 403 | } 404 | else { 405 | $jsn->{license} =~ s/^perl$/perl_5/i; 406 | $jsn->{license} = [ $jsn->{license} ]; 407 | } 408 | } 409 | if (exists $jsn->{resources}{bugtracker}) { 410 | my $url = $jsn->{resources}{bugtracker}; 411 | $jsn->{resources}{bugtracker} = { 412 | web => $url, 413 | }; 414 | } 415 | if (exists $jsn->{resources}{repository}) { 416 | my $url = $jsn->{resources}{repository}; 417 | my $web = $url; 418 | $url =~ s{repo.or.cz/w/}{repo.or.cz/r/}; 419 | $web =~ s{repo.or.cz/r/}{repo.or.cz/w/}; 420 | $jsn->{resources}{repository} = { 421 | type => "git", 422 | web => $web, 423 | url => $url, 424 | }; 425 | } 426 | foreach my $sct ("", "configure_", "build_", "test_") { 427 | (my $x = $sct || "runtime") =~ s/_$//; 428 | for (qw( requires recommends suggests )) { 429 | exists $jsn->{"$sct$_"} and 430 | $jsn->{prereqs}{$x}{$_} = delete $jsn->{"$sct$_"}; 431 | } 432 | } 433 | 434 | # optional features do not yet know about requires and/or recommends diirectly 435 | if (my $of = $jsn->{optional_features}) { 436 | foreach my $f (keys %$of) { 437 | if (my $r = delete $of->{$f}{requires}) { 438 | #$jsn->{prereqs}{runtime}{recommends}{$_} //= $r->{$_} for keys %$r; 439 | $of->{$f}{prereqs}{runtime}{requires} = $r; 440 | } 441 | if (my $r = delete $of->{$f}{recommends}) { 442 | #$jsn->{prereqs}{runtime}{recommends}{$_} //= $r->{$_} for keys %$r; 443 | $of->{$f}{prereqs}{runtime}{recommends} = $r; 444 | } 445 | if (my $r = delete $of->{$f}{suggests}) { 446 | #$jsn->{prereqs}{runtime}{suggests}{$_} //= $r->{$_} for keys %$r; 447 | $of->{$f}{prereqs}{runtime}{suggests} = $r; 448 | } 449 | } 450 | } 451 | 452 | $jsn = CPAN::Meta::Converter->new ($jsn)->convert (version => "2"); 453 | $jsn->{generated_by} = "Author"; 454 | $self->{jsn} = $jsn; 455 | } # add_json 456 | 457 | sub fix_meta { 458 | my ($self, $yf) = @_; 459 | 460 | my $jsn = $self->add_json (); 461 | 462 | my $cmv = CPAN::Meta::Validator->new ($jsn); 463 | $cmv->is_valid or 464 | croak join "\n" => RED, "META Validator found fail:\n", $cmv->errors, RESET, ""; 465 | 466 | unless ($yf) { 467 | my @my = grep { -s } glob ("*/META.yml"), "META.yml" or croak "No META files"; 468 | $yf = $my[0]; 469 | } 470 | my $jf = $yf =~ s/yml$/json/r; 471 | open my $jh, ">", $jf or croak "Cannot update $jf: $!\n"; 472 | print $jh JSON::PP->new->utf8 (1)->pretty (1)->encode ($jsn); 473 | close $jh; 474 | 475 | # Now that 2.0 JSON is corrrect, create a 1.4 YAML back from the modified stuff 476 | my $yml = $jsn; 477 | # 1.4 does not know about test_*, move them to * 478 | if (my $tp = delete $yml->{prereqs}{test}) { 479 | foreach my $phase (keys %{$tp}) { 480 | my $p = $tp->{$phase}; 481 | #DDumper { $phase => $p }; 482 | $yml->{prereqs}{runtime}{$phase}{$_} //= $p->{$_} for keys %{$p}; 483 | } 484 | } 485 | 486 | # Optional features in 1.4 knows requires, but not recommends. 487 | # The Lancaster Consensus moves 2.0 optional recommends promote to 488 | # requires in 1.4 489 | if (my $of = $yml->{optional_features}) { 490 | foreach my $f (keys %$of) { 491 | if (my $r = delete $of->{$f}{prereqs}{runtime}{recommends}) { 492 | $of->{$f}{requires} = $r; 493 | } 494 | if (my $r = delete $of->{$f}{prereqs}{runtime}{suggests}) { 495 | $of->{$f}{suggests} = $r; 496 | } 497 | } 498 | } 499 | # runtime and test_requires are unknown as top-level in 1.4 500 | foreach my $phase (qw( xuntime test_requires )) { 501 | if (my $p = delete $yml->{$phase}) { 502 | foreach my $f (keys %$p) { 503 | $yml->{$f}{$_} ||= $p->{$f}{$_} for keys %{$p->{$f}}; 504 | } 505 | } 506 | } 507 | 508 | #DDumper $yml; 509 | # This does NOT create a correct YAML id the source does not comply! 510 | $yml = CPAN::Meta::Converter->new ($yml)->convert (version => "1.4"); 511 | $yml->{requires}{perl} //= $jsn->{prereqs}{runtime}{requires}{perl} 512 | // $self->{h}{requires}{perl} 513 | // ""; 514 | $yml->{build_requires} && !keys %{$yml->{build_requires}} and 515 | delete $yml->{build_requires}; 516 | #DDumper $yml; 517 | #exit; 518 | 519 | open my $my, ">", $yf or croak "Cannot update $yf: $!\n"; 520 | print $my Dump $yml; # @{$self->{yml}}; 521 | close $my; 522 | 523 | chmod 0644, glob "*/META.*"; 524 | unlink glob "MYMETA*"; 525 | } # fix_meta 526 | 527 | sub _cpfd { 528 | my ($self, $jsn, $sct, $f) = @_; 529 | 530 | open my $sh, ">", \my $b; 531 | my $sep = ""; 532 | for (qw( requires recommends suggests )) { 533 | my $x = "$sct$_"; 534 | my $s = $jsn->{$x} or next; 535 | print $sh $sep; 536 | foreach my $m (sort keys %$s) { 537 | $m eq "perl" and next; 538 | my $v = $s->{$m}; 539 | printf $sh qq{%-10s "%s"}, $_, $m; 540 | my $aw = (24 - length $m); $aw < 0 and $aw = 0; 541 | printf $sh qq{%s => "%s"}, " " x $aw, $v if $v; 542 | print $sh ";"; 543 | if (my $i = $self->{cve_ignore}{$x}{$m}) { 544 | print $sh " # ignore : $i"; 545 | } 546 | say $sh ""; 547 | } 548 | $sep = "\n"; 549 | } 550 | close $sh; 551 | $sct || $f and $b and $b .= "};"; 552 | return $b; 553 | } # _cpfd 554 | 555 | sub gen_cpanfile { 556 | my $self = shift; 557 | 558 | warn "Generating cpanfile ...\n"; 559 | open my $fh, ">", "cpanfile"; 560 | 561 | my $jsn = $self->{h}; 562 | foreach my $sct_ ("", "configure_", "build_", "test_", "runtime_") { 563 | 564 | my $sct = $sct_ =~ s/_$//r; 565 | 566 | my $b = _cpfd ($self, $jsn, $sct_, 0) or next; 567 | 568 | if ($sct) { 569 | say $fh qq/\non "$sct" => sub {/; 570 | say $fh $b =~ s/^(?=\S)/ /gmr; 571 | } 572 | else { 573 | print $fh $b; 574 | } 575 | } 576 | 577 | if (my $of = $jsn->{optional_features}) { 578 | foreach my $f (sort keys %$of) { 579 | my $fs = $of->{$f}; 580 | say $fh qq/\nfeature "$f", "$fs->{description}" => sub {/;#} 581 | say $fh _cpfd ($self, $fs, "", 1) =~ s/^(?=\S)/ /gmr; 582 | } 583 | } 584 | 585 | close $fh; 586 | 587 | warn "Check CVE's ...\n"; 588 | if (system "cpan-cve.pl", "-d", ".") { 589 | warn "### CVE WARNING\n"; 590 | warn "#\n"; 591 | warn "# The current release would have recommended versions\n"; 592 | warn "# with known CVE's that are not (yet) ignored\n"; 593 | sleep (5); 594 | } 595 | } # gen_cpanfile 596 | 597 | sub security_md { 598 | my ($self, $update) = @_; 599 | 600 | my $sfn = "SECURITY.md"; 601 | my $policy = Software::Security::Policy::Individual->new ({ 602 | maintainer => $self->{h}{author}[0], 603 | program => $self->{name}, 604 | timeframe => "10 days", 605 | url => $self->{h}{resources}{repository}, 606 | perl_support_years => 5, 607 | }); 608 | 609 | my $smd = $policy->fulltext; 610 | 611 | unless (-s $sfn) { 612 | open my $fh, ">:encoding(utf-8)", $sfn or die "$sfn: $! \n"; 613 | print $fh $smd; 614 | close $fh; 615 | 616 | if (open $fh, "<", "MANIFEST") { 617 | my @m = <$fh>; 618 | close $fh; 619 | unless (grep m/^$sfn(?:\s|$)/ => @m) { 620 | open $fh, ">>", "MANIFEST" or die "MANIFEST: $!\n"; 621 | say $fh "$sfn\t\tGuide for reporting security issues"; 622 | close $fh; 623 | } 624 | } 625 | say "$sfn added"; 626 | } 627 | 628 | open my $fh, "<:encoding(utf-8)", $sfn or die "$sfn: $!\n"; 629 | my $old = do { local $/; <$fh> }; 630 | close $fh; 631 | 632 | $old eq $smd and return; 633 | 634 | if ($update) { 635 | open my $fh, ">:encoding(utf-8)", $sfn or die "$sfn: $!\n"; 636 | print $fh $smd; 637 | close $fh; 638 | say "$sfn updated"; 639 | } 640 | else { 641 | say "$sfn required updates:"; 642 | say diff \$old, \$smd; 643 | say "to apply, use $0 --check --update"; 644 | } 645 | } # gen_security 646 | 647 | 1; 648 | -------------------------------------------------------------------------------- /sandbox/config.dd: -------------------------------------------------------------------------------- 1 | { settings => { 2 | client => { 3 | ip => '80.100.130.165', 4 | isp => 'XS4ALL Internet BV', 5 | ispdlavg => 11440, 6 | isprating => '3.8', 7 | ispulavg => 4627, 8 | lat => '52.0568', 9 | loggedin => 0, 10 | lon => '5.4663', 11 | rating => 0 12 | }, 13 | conditions => { 14 | cond => [ 15 | { download => '+100000', 16 | name => 'tcpulthreads', 17 | value => 8 18 | }, 19 | { download => '+10000', 20 | name => 'tcpulthreads', 21 | value => 4 22 | }, 23 | { name => 'tcpulthreads', 24 | value => 2 25 | } 26 | ] 27 | }, 28 | customer => 'speedtest', 29 | download => { 30 | initialtest => '250K', 31 | mintestsize => '250K', 32 | testlength => 10, 33 | threadsperurl => 4 34 | }, 35 | endtest => { 36 | endtest => 'standard-wide-new-1button' 37 | }, 38 | interface => { 39 | colortcp => 0, 40 | template => 'mbps' 41 | }, 42 | latency => { 43 | testlength => 10, 44 | timeout => 20, 45 | waittime => 50 46 | }, 47 | licensekey => '9c1687ea58e5e770-1df5b7cd427370f7-4b62a84526ea1f56', 48 | odometer => { 49 | rate => 23, 50 | start => '6495497731' 51 | }, 52 | panels => { 53 | panel0 => 'wave-ad-wide', 54 | panel1 => 'share-wide', 55 | panel2 => 'link:/results.php?source=compare', 56 | panel3 => 'contribute-wide-new:wide' 57 | }, 58 | 'server-config' => { 59 | forcepingid => '', 60 | ignoreids => '660,683,954,963,1023,1084,1161,1254,1389,1390,1403,1404,1405,1406,1407,1411,1412,1413,1435,1436,1525,1597,1670,1719,1758,1762,1800,1815,1816,1834,1838,1839,1840,1847,1850,1852,1854,1859,1860,1861,1871,1872,1873,1874,1875,1877,1880,1913,2052,2108,2148,2257,2317,2341,2373,2560,2631,2849,2871,3043,3280,3383,3448,3695,3696,3697,3698,3699,3725,3726,3727,3728,3729,3730,3731,3732,3733,3788,4021,4533,4787,5023,5024,5025,5026,5027,5028,5029,5030,5031,5032,5033,5085,5086,5107,5108,5109,5111,5112,5113,5114,5115,5116,5117,5118,949,5249', 61 | notonmap => '4179,5237,2690,4810,4781,4231,2801,4689,4558,4984,2322,5040,4381,5201,4472,3682,4835,5077,3868,4046,5045,5147,4219,4716,4268,4521,3326,2806,4493,3923,951,4734,1894,5046,4446,4864,5059,4778,4008,2295,5121,5142,5157,2760,2356,3145,3782,5339,4688,1263,2828,4964,4500,3862,5066,1483,4111,4290,4662,4590,5082,4169,2565,3860,4049,2485,4933,4208,3104,4587,4378,4667,2185,4272,4128,3007,1355,3226,5303,1705,2712,4081,5348,4622,4848,3892,4937,2115,3967,2181,2133,4728,5020,3366,4251,4535,3624,1445,4406,4588,3737,4567,1219,2459,428,4673,4085,4161,4306,480,4487,4403,5304,4235,367,5168,4614,5248,4210,5356,4615,4635,4594,4402,2329,788,3611,5375,4245,5205,2173,4696,4336,4953,4989,4775', 62 | preferredserverid => '', 63 | threadcount => 4 64 | }, 65 | 'socket-download' => { 66 | bufferlength => 5000, 67 | initialthreads => 4, 68 | maxsamplesize => 5000000, 69 | maxthreads => 32, 70 | minsamplesize => 32000, 71 | minthreads => 4, 72 | packetlength => 1000, 73 | readbuffer => 65536, 74 | startbuffersize => 1, 75 | startsamplesize => 1000000, 76 | testlength => 15, 77 | threadratio => '750K' 78 | }, 79 | 'socket-latency' => { 80 | testlength => 10, 81 | timeout => 20, 82 | waittime => 50 83 | }, 84 | 'socket-upload' => { 85 | bufferlength => 1000, 86 | disabled => 'false', 87 | initialthreads => 'dyn:tcpulthreads', 88 | maxsamplesize => 1000000, 89 | maxthreads => 32, 90 | minsamplesize => 32000, 91 | minthreads => 'dyn:tcpulthreads', 92 | packetlength => 1000, 93 | startbuffersize => 2, 94 | startsamplesize => 100000, 95 | testlength => 15, 96 | threadratio => '750K' 97 | }, 98 | survey => { 99 | currency => { 100 | rate_USD => '1.2559', 101 | sign => "\x{20ac}" 102 | }, 103 | defaults => { 104 | isp_common_name => 'XS4ALL', 105 | isp_name => 'XS4ALL Internet BV', 106 | postal_code => '' 107 | } 108 | }, 109 | times => { 110 | dl1 => 5000000, 111 | dl2 => 35000000, 112 | dl3 => 800000000, 113 | ul1 => 1000000, 114 | ul2 => 8000000, 115 | ul3 => 35000000 116 | }, 117 | translation => { 118 | lang => 'xml', 119 | text => [ 120 | { content => 'Rate Your ISP', 121 | id => 'rateyourisp' 122 | }, 123 | { content => 'COPY IP', 124 | id => 'copy' 125 | }, 126 | { content => 'kilobits', 127 | id => 'long-kbps' 128 | }, 129 | { content => 'megabits', 130 | id => 'long-Mbps' 131 | }, 132 | { content => 'NEW SERVER', 133 | id => 'newserver' 134 | }, 135 | { content => 'TEST AGAIN', 136 | id => 'testagain' 137 | }, 138 | { content => 'UPLOAD SPEED', 139 | id => 'uploadspeed' 140 | }, 141 | { content => 'DOWNLOAD SPEED', 142 | id => 'downloadspeed' 143 | }, 144 | { content => 'kbps', 145 | id => 'kbps' 146 | }, 147 | { content => 'Mbps', 148 | id => 'Mbps' 149 | }, 150 | { content => 'BEGIN TEST', 151 | id => 'begintest' 152 | }, 153 | { content => 'START TEST TO RECOMMENDED SERVER', 154 | id => 'startclosest' 155 | }, 156 | { content => 'megabytes', 157 | id => 'long-MB/s' 158 | }, 159 | { content => 'kilobytes', 160 | id => 'long-kB/s' 161 | }, 162 | { content => 'kB/s', 163 | id => 'kB/s' 164 | }, 165 | { content => 'MB/s', 166 | id => 'MB/s' 167 | }, 168 | { content => 'Mbps', 169 | id => 'mbps' 170 | }, 171 | { content => 'How happy are you with your current Internet service provider?', 172 | id => 'ratinghelp' 173 | }, 174 | { content => 'Very unhappy', 175 | id => 'rating1' 176 | }, 177 | { content => 'Unhappy', 178 | id => 'rating2' 179 | }, 180 | { content => 'Neutral', 181 | id => 'rating3' 182 | }, 183 | { content => 'Happy', 184 | id => 'rating4' 185 | }, 186 | { content => 'Very happy', 187 | id => 'rating5' 188 | }, 189 | { content => 'YOUR RESULT WILL BECOME PART OF A SPEED WAVE', 190 | id => 'speedwavebegin' 191 | }, 192 | { content => 'PING', 193 | id => 'ping' 194 | }, 195 | { content => 'Hosted by', 196 | id => 'hostedby' 197 | }, 198 | { content => 'TOTAL TESTS 199 | TO DATE', 200 | id => 'counterdescription' 201 | }, 202 | { content => 'COPIED', 203 | id => 'copied' 204 | }, 205 | { content => 'AUTO STARTING SPEED TEST IN', 206 | id => 'autostartdesc' 207 | }, 208 | { content => 'SECONDS', 209 | id => 'seconds' 210 | }, 211 | { content => 'SECOND', 212 | id => 'second' 213 | }, 214 | { content => 'ERROR', 215 | id => 'error' 216 | }, 217 | { content => 'Try Again', 218 | id => 'tryagain' 219 | }, 220 | { content => 'START A SPEED WAVE', 221 | id => 'share-wavetitle' 222 | }, 223 | { content => 'Speed Wave Name', 224 | id => 'share-namewave' 225 | }, 226 | { content => 'Your result is now part of the Speed Wave!', 227 | id => 'share-waveresults' 228 | }, 229 | { content => 'Your Result', 230 | id => 'compare-yourtest' 231 | }, 232 | { content => 'Help Us Understand Broadband Costs', 233 | id => 'survey-surveytitle' 234 | }, 235 | { content => 'Download Package', 236 | id => 'survey-downloadpackage' 237 | }, 238 | { content => 'Upload Package', 239 | id => 'survey-uploadpackage' 240 | }, 241 | { content => 'How much do you pay?', 242 | id => 'survey-howmuch' 243 | }, 244 | { content => 'Includes:', 245 | id => 'survey-includes' 246 | }, 247 | { content => 'Is this your postal code?', 248 | id => 'survey-postalcode' 249 | }, 250 | { content => 'SUBMIT', 251 | id => 'survey-submit' 252 | }, 253 | { content => 'GET A FREE OOKLA SPEEDTEST ACCOUNT', 254 | id => 'share-accounttitle' 255 | }, 256 | { content => 'Being logged in would allow you to start a Speed Wave here! 257 | Registration is free and only requires a valid email address.', 258 | id => 'share-accountdescription' 259 | }, 260 | { content => 'Your Email Address', 261 | id => 'share-emailaddress' 262 | }, 263 | { content => 'https://twitter.com/share?text=Check%20out%20my%20%40Ookla%20Speedtest%20result!%20What%27s%20your%20speed%3F&url=http%3A%2F%2Fwww.speedtest.net%2Fmy-result%2F{RESULTID}&related=ookla%3ACreators%20of%20Ookla%20Speedtest&hashtags=speedtest', 264 | id => 'share-twitterurl' 265 | }, 266 | { content => 'https://www.facebook.com/dialog/feed?app_id=581657151866321&link=http://www.speedtest.net/my-result/{RESULTID}&description=This%20is%20my%20Ookla%20Speedtest%20result.%20Compare%20your%20speed%20to%20mine!&redirect_uri=http://www.speedtest.net&name=Check%20out%20my%20Ookla%20Speedtest%20results.%20What%27s%20your%20speed%3F', 267 | id => 'share-facebookurl' 268 | }, 269 | { content => 'VIEW SPEED WAVE', 270 | id => 'share-viewwave' 271 | }, 272 | { content => 'CREATE', 273 | id => 'share-createwave' 274 | }, 275 | { content => 'Speed', 276 | id => 'survey-speed' 277 | }, 278 | { content => 'Phone', 279 | id => 'survey-phone' 280 | }, 281 | { content => 'TV', 282 | id => 'survey-tv' 283 | }, 284 | { content => 'What speeds do you pay for?', 285 | id => 'survey-package' 286 | }, 287 | { content => 'Thanks for participating in the survey!', 288 | id => 'survey-thanks' 289 | }, 290 | { content => 'SELECTING BEST SERVER BASED ON PING', 291 | id => 'selectingbestserver' 292 | }, 293 | { content => 'MY RESULTS', 294 | id => 'compare-myresults' 295 | }, 296 | { content => 'CREATE', 297 | id => 'share-createaccount' 298 | }, 299 | { content => 'YOUR PREFERRED SERVER', 300 | id => 'begintest-preferred' 301 | }, 302 | { content => 'RECOMMENDED SERVER', 303 | id => 'begintest-ping' 304 | }, 305 | { content => 'CONNECTING', 306 | id => 'connecting' 307 | }, 308 | { content => 'COPY', 309 | id => 'share-copy' 310 | }, 311 | { content => 'SHARE THIS RESULT', 312 | id => 'endtest-share-button' 313 | }, 314 | { content => 'COMPARE 315 | YOUR RESULT', 316 | id => 'endtest-compare-button' 317 | }, 318 | { content => 'CONTRIBUTE 319 | TO NET INDEX', 320 | id => 'endtest-contribute-button' 321 | }, 322 | { content => 'CLOSE', 323 | id => 'close' 324 | }, 325 | { content => 'RETAKE THE 326 | SURVEY', 327 | id => 'survey-retake' 328 | }, 329 | { content => 'IMAGE', 330 | id => 'share-link' 331 | }, 332 | { content => 'FORUM', 333 | id => 'share-forum' 334 | }, 335 | { content => 'Use this test result to begin your own Speed Wave!', 336 | id => 'share-wavedescription' 337 | }, 338 | { content => 'Fastest ISPs', 339 | id => 'pcmagmessage' 340 | }, 341 | { content => 'wave', 342 | id => 'panel0' 343 | }, 344 | { content => 'share', 345 | id => 'panel1' 346 | }, 347 | { content => 'link:{LANG_CODE}/results.php?source=compare', 348 | id => 'panel2' 349 | }, 350 | { content => 'contribute', 351 | id => 'panel3' 352 | }, 353 | { content => 'bits per second', 354 | id => 'bitspersecond' 355 | }, 356 | { content => 'standard', 357 | id => 'endtest' 358 | }, 359 | { content => 'en', 360 | id => 'lang' 361 | }, 362 | { content => 'http://pinterest.com/pin/create/button/?url=http%3A%2F%2Fwww.speedtest.net%2F&media=http%3A%2F%2Fspeedtest.net%2Fresult%2F{RESULTID}.png&description=Check%20out%20my%20result%20from%20Ookla%20Speedtest!', 363 | id => 'share-pinteresturl' 364 | }, 365 | { id => 'panelsuffix' 366 | }, 367 | { content => 'Continue', 368 | id => 'survey-nextbtn' 369 | }, 370 | { content => 'EDIT', 371 | id => 'survey-editbtn' 372 | }, 373 | { content => 'Download', 374 | id => 'survey-download' 375 | }, 376 | { content => 'Download:', 377 | id => 'survey-download-validate' 378 | }, 379 | { content => 'Upload', 380 | id => 'survey-upload' 381 | }, 382 | { content => 'Upload:', 383 | id => 'survey-upload-validate' 384 | }, 385 | { content => 'Connection Type?', 386 | id => 'survey-connectiontype' 387 | }, 388 | { content => 'Home', 389 | id => 'survey-q1label1' 390 | }, 391 | { content => 'Business', 392 | id => 'survey-q1label2' 393 | }, 394 | { content => 'School', 395 | id => 'survey-q1label3' 396 | }, 397 | { content => 'Public Wi-Fi', 398 | id => 'survey-q1label4' 399 | }, 400 | { content => 'Other', 401 | id => 'survey-q1label5' 402 | }, 403 | { content => 'My ISP is:', 404 | id => 'survey-ispconf' 405 | }, 406 | { content => 'Yes', 407 | id => 'survey-q2label1' 408 | }, 409 | { content => 'Wrong', 410 | id => 'survey-q2label2' 411 | }, 412 | { content => 'Yes', 413 | id => 'survey-q3label1' 414 | }, 415 | { content => 'Wrong', 416 | id => 'survey-q3label2' 417 | }, 418 | { content => 'Please enter your postal code', 419 | id => 'survey-postalcode-input' 420 | }, 421 | { content => 'Please enter your ISP name', 422 | id => 'survey-labelispinput' 423 | }, 424 | { content => 'OK', 425 | id => 'survey-okbtn' 426 | }, 427 | { content => 'Please check your upload speed. 428 | This seems faster than expected.', 429 | id => 'survey-validationUploadline1' 430 | }, 431 | { content => 'Please check the amount entered. 432 | This seems higher than expected.', 433 | id => 'survey-validationAmountline1' 434 | }, 435 | { content => 'Please check your Download speed. 436 | This seems faster than expected.', 437 | id => 'survey-validationDownloadline1' 438 | }, 439 | { content => 'WEB', 440 | id => 'share-web' 441 | }, 442 | { content => 'EMBED', 443 | id => 'share-html' 444 | }, 445 | { content => 'Are you on', 446 | id => 'endtest-contribute-are-you-on' 447 | }, 448 | { content => 'Take our Broadband Internet Survey!', 449 | id => 'endtest-contribute-take-survey' 450 | } 451 | ] 452 | }, 453 | upload => { 454 | initialtest => 0, 455 | maxchunkcount => 50, 456 | maxchunksize => '512K', 457 | mintestsize => '32K', 458 | ratio => 5, 459 | testlength => 10, 460 | threads => 2, 461 | threadsperurl => 4 462 | } 463 | } 464 | } 465 | -------------------------------------------------------------------------------- /speedtest: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | # speedtest - test network speed using speedtest.net 4 | # (m)'20 [2020-06-30] Copyright H.M.Brand 2014-2025 5 | 6 | require 5.010; 7 | use strict; 8 | use warnings; 9 | 10 | our $VERSION = "0.31"; 11 | our $CMD = $0; $CMD =~ s{.*/}{}; 12 | 13 | sub usage { 14 | my $err = shift and select STDERR; 15 | (my $p = $0) =~ s{.*/}{}; 16 | print <<"EOH"; 17 | usage: $p [ --no-geo | --country=NL ] [ --list | --ping[=n] ] [ options ] 18 | --geo use Geo location (default true) for closest testserver 19 | --all include *all* servers (default only in own country) 20 | -c --country=IS use ISO country code for closest test server 21 | --list-cc list country codes and countries with server count 22 | -1 --one-line show summary in one line 23 | -C --csv output in CSV (stamp,id,ping,tests,direction,speed,min,max) 24 | --csv-eol-unix EOL = NL (default = CR NL) implies -C 25 | -P --prtg output in XML for PRTG 26 | 27 | -l --list list test servers in chosen country sorted by distance 28 | -p --ping[=40] list test servers in chosen country sorted by latency 29 | --url show server url in list 30 | 31 | -s --server=nnn use testserver with id nnn 32 | --server=file use testserver from file 33 | -t --timeout=nnn set server timeout to nnn seconds 34 | --url=sss use specific server url (do not scan) ext php 35 | --mini=sss use specific server url (do not scan) ext from sss 36 | --download test download speed (default true) 37 | --upload test upload speed (default true) 38 | -q --quick[=20] do a quick test (only the fastest 20 tests) 39 | -Q --realquick do a real quick test (only the fastest 10 tests) 40 | -T --try[=5] try all tests on the n fastest servers 41 | -U --skip-undef skip results with no actual measurements 42 | 43 | -v --verbose[=1] set verbosity 44 | --simple alias for -v0 45 | --ip show IP for server 46 | -V --version show version and exit 47 | -? --help show this help 48 | --man show the builtin manual (requires nroff) 49 | --info show the builtin manual as plain text 50 | 51 | $p --list 52 | $p --ping --country=BE 53 | $p 54 | $p -s 4358 55 | $p --url=http://ookla.extraip.net 56 | $p -q --no-download 57 | $p -Q --no-upload 58 | 59 | EOH 60 | exit $err; 61 | } # usage 62 | 63 | use Getopt::Long qw(:config bundling noignorecase); 64 | my $opt_c = ""; 65 | my $opt_v = 1; 66 | my $opt_d = 1; 67 | my $opt_u = 1; 68 | my $opt_g = 1; 69 | my $opt_q = 0; 70 | my $opt_T = 1; 71 | my $unit = [ 1, "bit" ]; 72 | GetOptions ( 73 | "help|h|?" => sub { usage (0); }, 74 | "V|version!" => sub { print "$CMD [$VERSION]\n"; exit 0; }, 75 | "v|verbose:2" => \$opt_v, 76 | "simple!" => sub { $opt_v = 0; }, 77 | "man" => sub { pod_nroff (); }, 78 | "info" => sub { pod_text (); }, 79 | 80 | "all!" => \my $opt_a, 81 | "g|geo!" => \$opt_g, 82 | "c|cc|country=s" => \$opt_c, 83 | "list-cc!" => \my $opt_cc, 84 | "1|one-line!" => \my $opt_1, 85 | "C|csv!" => \my $opt_C, 86 | "csv-eol-unix|". 87 | "csv-eol-nl!" => \my $opt_CNL, 88 | "P|prtg!" => \my $opt_P, 89 | 90 | "l|list!" => \my $list, 91 | "p|ping:40" => \my $opt_ping, 92 | "url:s" => \my $url, 93 | "ip!" => \my $ip, 94 | 95 | "B|bytes" => sub { $unit = [ 8, "byte" ] }, 96 | 97 | "T|try:5" => \$opt_T, 98 | "s|server=s" => \my @server, 99 | "t|timeout=i" => \my $timeout, 100 | "d|download!" => \$opt_d, 101 | "u|upload!" => \$opt_u, 102 | "q|quick|fast:20" => \$opt_q, 103 | "Q|realquick:10" => \$opt_q, 104 | "U|skip-undef!" => \my $opt_U, 105 | 106 | "m|mini=s" => \my $mini, 107 | "source=s" => \my $source, # NYI 108 | ) or usage (1); 109 | 110 | $opt_CNL and $opt_C++; 111 | $opt_C || $opt_P and $opt_v = 0; 112 | 113 | use LWP::UserAgent; 114 | use XML::Simple; # Can safely be replaced with XML::LibXML::Simple 115 | use HTML::TreeBuilder; 116 | use Term::ANSIColor; 117 | use Time::HiRes qw( gettimeofday tv_interval ); 118 | use List::Util qw( first sum ); 119 | use Socket qw( inet_ntoa ); 120 | use Math::Trig; 121 | 122 | sub pod_text { 123 | require Pod::Text::Color; 124 | my $m = $ENV{NO_COLOR} ? "Pod::Text" : "Pod::Text::Color"; 125 | my $p = $m->new (); 126 | open my $fh, ">", \my $out; 127 | $p->parse_from_file ($0, $fh); 128 | close $fh; 129 | print $out; 130 | exit 0; 131 | } # pod_text 132 | 133 | sub pod_nroff { 134 | first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text (); 135 | 136 | require Pod::Man; 137 | my $p = Pod::Man->new (); 138 | open my $fh, "|-", "nroff", "-man"; 139 | $p->parse_from_file ($0, $fh); 140 | close $fh; 141 | exit 0; 142 | } # pod_nroff 143 | 144 | # Debugging. Prefer Data::Peek over Data::Dumper if available 145 | { use Data::Dumper; 146 | my $dp = eval { require Data::Peek; 1; }; 147 | sub ddumper { 148 | $dp ? Data::Peek::DDumper (@_) 149 | : print STDERR Dumper (@_); 150 | } # ddumper 151 | } 152 | 153 | $timeout ||= 10; 154 | my $ua = LWP::UserAgent->new ( 155 | max_redirect => 2, 156 | agent => "speedtest/$VERSION", 157 | parse_head => 0, 158 | timeout => $timeout, 159 | cookie_jar => {}, 160 | ); 161 | $ua->env_proxy; 162 | 163 | binmode STDOUT, ":encoding(utf-8)"; 164 | 165 | # Speedtest.net defines Mbit/s and kbit/s using 1000 as multiplier, 166 | # https://support.speedtest.net/entries/21057567-What-do-mbps-and-kbps-mean- 167 | my $k = 1000; 168 | 169 | my $config = get_config (); 170 | my $client = $config->{"client"} or die "Config saw no client\n"; 171 | my $times = $config->{"times"} or die "Config saw no times\n"; 172 | my $downld = $config->{"download"} or die "Config saw no download\n"; 173 | my $upld = $config->{"upload"} or die "Config saw no upload\n"; 174 | $opt_v > 3 and ddumper { 175 | client => $client, 176 | times => $times, 177 | down => $downld, 178 | up => $upld, 179 | }; 180 | 181 | if ($url || $mini) { 182 | $opt_g = 0; 183 | $opt_c = ""; 184 | @server = (); 185 | my $ping = 0.05; 186 | my $name = ""; 187 | my $sponsor = "CLI"; 188 | if ($mini) { 189 | my $t0 = [ gettimeofday ]; 190 | my $rsp = $ua->request (HTTP::Request->new (GET => $mini)); 191 | $ping = tv_interval ($t0); 192 | $rsp->is_success or die $rsp->status_line . "\n"; 193 | my $tree = HTML::TreeBuilder->new (); 194 | $tree->parse_content ($rsp->content) or die "Cannot parse\n"; 195 | my $ext = ""; 196 | for ($tree->look_down (_tag => "script")) { 197 | my $c = ($_->content)[0] or next; 198 | ref $c eq "ARRAY" && $c->[0] && 199 | $c->[0] =~ m{\b (?: upload_? | config ) Extension 200 | \s*: \s* "? ([^"\s]+) }xi or next; 201 | $ext = $1; 202 | last; 203 | } 204 | $ext or die "No ext found\n"; 205 | ($url = $mini) =~ s{/*$}{/speedtest/upload.$ext}; 206 | $sponsor = $_->as_text for $tree->look_down (_tag => "title"); 207 | $name ||= $_->as_text for $tree->look_down (_tag => "h1"); 208 | $name ||= "Speedtest mini"; 209 | } 210 | else { 211 | $name = "Local"; 212 | $url =~ m{/\w+\.\w+$} or $url =~ s{/?$}{/speedtest/upload.php}; 213 | my $t0 = [ gettimeofday ]; 214 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 215 | $ping = tv_interval ($t0); 216 | $rsp->is_success or die $rsp->status_line . "\n"; 217 | } 218 | (my $host = $url) =~ s{^\w+://([^/]+)(?:/.*)?}{$1}; 219 | $url = { 220 | cc => "", 221 | country => "", 222 | dist => "0.0", 223 | host => $host, 224 | id => 0, 225 | lat => "0.0000", 226 | lon => "0.0000", 227 | name => $name, 228 | ping => $ping * 1000, 229 | sponsor => $sponsor, 230 | url => $url, 231 | url2 => $url, 232 | }; 233 | } 234 | 235 | if (@server) { 236 | $opt_c = ""; 237 | $opt_a = 1; 238 | unless ($server[0] =~ m{^[0-9]+$}) { 239 | open my $fh, "<", $server[0] or die;#usage (1); 240 | my $data = do { local $/; <$fh>; }; 241 | print $data; 242 | $data =~ m/^\s*\{\s*(['"]?)cc\1\s*=>\s*(["'])[A-Z]{1,3}\2\s*,/ && 243 | $data =~ m/\s(["']?)id\1\s*=>\s*[0-9]+\s*,/ or die;#usage (1); 244 | $data = eval $data; 245 | $data->{dist} = distance ($client->{lat}, $client->{lon}, 246 | $data->{lat}, $data->{lon}); 247 | ($data->{url0} = $data->{url}) =~ s{/speedtest/upload.*}{}; 248 | $url = $data; 249 | } 250 | } 251 | else { 252 | if ($opt_c) { 253 | $opt_c = uc $opt_c; 254 | } 255 | elsif ($opt_g) { # Try GeoIP 256 | $opt_v > 5 and say STDERR "Testing Geo location"; 257 | my $url = "http://www.geoiptool.com"; 258 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 259 | if ($rsp->is_success) { 260 | my $tree = HTML::TreeBuilder->new (); 261 | if ($tree->parse_content ($rsp->content)) { 262 | foreach my $e ($tree->look_down (_tag => "div", class => "data-item")) { 263 | $opt_v > 2 and say STDERR $e->as_text; 264 | $e->as_text =~ m{Country code(?:\s*:)?\s*([A-Za-z]+)}i or next; 265 | $opt_c = uc $1; 266 | last; 267 | } 268 | } 269 | } 270 | unless ($opt_c) { # GEO-Ip failed :/ 271 | $opt_v and warn "GEO-IP failed. Getting country code based on nearest server\n"; 272 | my $keep_a = $opt_a; 273 | $opt_a = 1; 274 | my %list = servers (); 275 | my $nearest = { dist => 9999999 }; 276 | foreach my $id (keys %list) { 277 | $list{$id}{dist} < $nearest->{dist} and $nearest = $list{$id}; 278 | } 279 | $opt_v > 3 and ddumper { nearest => $nearest }; 280 | $opt_c = $nearest->{cc}; 281 | $opt_a = $keep_a; 282 | } 283 | } 284 | $opt_c ||= "IS"; # Iceland seems like a nice default :P 285 | } 286 | 287 | if ($opt_cc) { 288 | my %sl = get_servers (); 289 | my %cc; 290 | foreach my $s (values %sl) { 291 | my $cc = $s->{cc}; 292 | $cc{$cc} //= { cc => $cc, country => $s->{country}, count => 0 }; 293 | $cc = $cc{$cc}; 294 | $cc->{count}++; 295 | } 296 | for (sort { $a->{cc} cmp $b->{cc} } values %cc) { 297 | printf "%2s %-32s %4d\n", $_->{cc}, $_->{country}, $_->{count}; 298 | } 299 | exit 0; 300 | } 301 | 302 | if ($list) { 303 | my %list = servers (); 304 | my @fld = qw( id sponsor name dist ); 305 | my $fmt = "%3d: %5d - %-30.30s %-15.15s %7.2f km\n"; 306 | if (defined $url) { 307 | push @fld, "url0"; 308 | $fmt .= " %s\n"; 309 | } 310 | my $idx = 1; 311 | printf $fmt, $idx++, @{$list{$_}}{@fld} 312 | for sort { $list{$a}{dist} <=> $list{$b}{dist} } keys %list; 313 | exit 0; 314 | } 315 | 316 | if ($opt_ping) { 317 | my @fld = qw( id sponsor name dist ping ); 318 | my $fmt = "%3d: %5d - %-30.30s %-15.15s %7.2f km %7.0f ms\n"; 319 | if (defined $url) { 320 | push @fld, "url0"; 321 | $fmt .= " %s\n"; 322 | } 323 | my $idx = 1; 324 | printf $fmt, $idx++, @{$_}{@fld} for servers_by_ping (); 325 | exit 0; 326 | } 327 | 328 | $opt_v and say STDERR "Testing for $client->{ip} : $client->{isp} ($opt_c)"; 329 | $opt_P and print qq{\n\n}, 330 | qq{ Testing from $client->{isp} ($client->{ip})\n}; 331 | 332 | # default action is to run on fastest server 333 | my @srvrs = $url ? ($url) : servers_by_ping (); 334 | my @hosts = grep { $_->{ping} < 1000 } @srvrs; 335 | @server and $opt_T = @server; 336 | @hosts > $opt_T and splice @hosts, $opt_T; 337 | my @try; 338 | foreach my $host (@hosts) { 339 | $host->{sponsor} =~ s/\s+$//; 340 | if ($opt_P) { 341 | printf do { join "\n", map { " $_" } 342 | "", 343 | " Ping", 344 | " ms", 345 | " 1", 346 | " %0.2f", 347 | " \n", 348 | }, $host->{ping}; 349 | } 350 | elsif ($opt_v) { 351 | my $s = ""; 352 | if ($ip) { 353 | (my $h = $host->{url}) =~ s{^\w+://([^/]+)(?:/.*)?$}{$1}; 354 | my @ad = gethostbyname ($h); 355 | $s = join " " => "", map { inet_ntoa ($_) } @ad[4 .. $#ad]; 356 | } 357 | @hosts > 1 and print STDERR "\n"; 358 | printf STDERR "Using %5d: %6.2f km %7.0f ms%s %s\n", 359 | $host->{id}, $host->{dist}, $host->{ping}, $s, $host->{sponsor}; 360 | } 361 | $opt_v > 3 and ddumper $host; 362 | (my $base = $host->{url}) =~ s{/[^/]+$}{}; 363 | 364 | my $dl = "-"; 365 | if ($opt_d) { 366 | $opt_v and print STDERR "Test download "; 367 | # http://ookla.extraip.net/speedtest/random350x350.jpg 368 | my @url = @{$host->{dl_list} // [ 369 | map { ("$base/random${_}x${_}.jpg") x 4 } 370 | 350, 500, 750, 1000, 1500, 2000, 2500, 3000, 3500, 4000 ]}; 371 | my @rslt; 372 | $opt_q and splice @url, $opt_q; 373 | foreach my $url (@url) { 374 | my $req = HTTP::Request->new (GET => $url); 375 | my $t0 = [ gettimeofday ]; 376 | my $rsp = $ua->request ($req); 377 | my $elapsed = tv_interval ($t0); 378 | unless ($rsp->is_success) { 379 | warn "$url: ", $rsp->status_line, "\n"; 380 | next; 381 | } 382 | my $sz = length $rsp->content; 383 | my $speed = 8 * $sz / $elapsed / $k / $k; 384 | push @rslt, [ $sz, $elapsed, $speed ]; 385 | $opt_v and print STDERR "."; 386 | $opt_v > 2 and printf STDERR "\n%12.3f %s (%7d) ", $speed, $url, $sz; 387 | } 388 | $dl = result ("Download", $host, scalar @url, @rslt); 389 | } 390 | 391 | my $ul = "-"; 392 | if ($opt_u) { 393 | $opt_v and print STDERR "Test upload "; 394 | my @data = (0 .. 9, "a" .. "Z", "a" .. "z"); # Random pure ASCII data 395 | my $data = join "" => map { $data[int rand $#data] } 0 .. 4192; 396 | $data = "content1=".($data x 8192); # Total length just over 4 Mb 397 | my @rslt; 398 | my $url = $host->{url}; # .php, .asp, .aspx, .jsp 399 | # see $upld->{mintestsize} and $upld->{maxchunksize} ? 400 | my @size = map { $_ * 1000 } 401 | # ((256) x 10, (512) x 10, (1024) x 10, (4096) x 10); 402 | ((256) x 10, (512) x 10, (1024) x 5, (2048) x 5, (4096) x 5, (8192) x 5); 403 | $opt_q and splice @size, $opt_q; 404 | foreach my $sz (@size) { 405 | my $req = HTTP::Request->new (POST => $url); 406 | $req->content (substr $data, 0, $sz); 407 | my $t0 = [ gettimeofday ]; 408 | my $rsp = $ua->request ($req); 409 | my $elapsed = tv_interval ($t0); 410 | unless ($rsp->is_success) { 411 | warn "$url: ", $rsp->status_line, "\n"; 412 | next; 413 | } 414 | my $speed = 8 * $sz / $elapsed / $k / $k; 415 | push @rslt, [ $sz, $elapsed, $speed ]; 416 | $opt_v and print STDERR "."; 417 | $opt_v > 2 and printf STDERR "\n%12.3f %s (%7d) ", $speed, $url, $sz; 418 | } 419 | 420 | $ul = result ("Upload", $host, scalar @size, @rslt); 421 | } 422 | my $sum = $dl eq "-" ? 0 : $dl; 423 | $sum += $ul eq "-" ? 0 : $ul; 424 | $sum ||= "-"; 425 | push @try => [ $host, $dl, $ul, $sum ]; 426 | $opt_1 and print "DL: $dl M$unit->[1]/s, UL: $ul M$unit->[1]/s, SRV: $host->{id}\n"; 427 | } 428 | $opt_P and print " \n"; 429 | 430 | if ($opt_T and @try > 1) { 431 | print "\n"; 432 | my $rank = 1; 433 | foreach my $t (sort { $b->[-1] <=> $a->[-1] } @try) { 434 | my ($host, $dl, $ul) = @$t; 435 | printf "Rank %02d: Server: %6d %6.2f km %7.0f ms, DL: %s UL: %s\n", 436 | $rank++, $host->{id}, $host->{dist}, $host->{ping}, $dl, $ul; 437 | } 438 | } 439 | 440 | sub result { 441 | my ($dir, $host, $n, @rslt) = @_; 442 | 443 | my $size = (sum map { $_->[0] } @rslt) // 0; 444 | my $time = (sum map { $_->[1] } @rslt) // 0; 445 | 446 | my @speed = sort { $a <=> $b } grep { $_ } map { $_->[2] } @rslt; 447 | $opt_U && @speed == 0 and return; 448 | 449 | my $slow = $speed[ 0] // 0.000; 450 | my $fast = $speed[-1] // 999999999.999; 451 | 452 | my $sp = sprintf "%8.3f", 8 * ($size / ($time || 1)) / $k / $k / $unit->[0]; 453 | if ($opt_C) { 454 | my @d = localtime; 455 | # stamp,id,ping,tests,direction,speed) 456 | printf qq{"%4d-%02d-%02d %02d:%02d:%02d",%d,%.2f,%d,%.1s,%.2f,%.2f,%.2f%s}, 457 | $d[5] + 1900, ++$d[4], @d[3,2,1,0], 458 | $host->{id}, $host->{ping}, 459 | $n, $dir, $sp, $slow, $fast, $opt_CNL ? "\n" : "\r\n"; 460 | } 461 | elsif ($opt_P) { 462 | printf do { join "\n", map { " $_" } 463 | "", 464 | " %s", 465 | " M%s/s", 466 | " 1", 467 | " %0.2f", 468 | " \n", 469 | }, $dir, $unit->[1], $sp; 470 | } 471 | else { 472 | $opt_q && $opt_v and print $opt_v > 2 ? "\n " : " " x (40 - $opt_q); 473 | $opt_v || !$opt_1 and printf "%-10s %8s M%s/s\n", $dir, $sp, $unit->[1]; 474 | $opt_v > 1 and printf " Transfer %10.3f kb in %9.3f s. [%8.3f - %8.3f]\n", 475 | $size / 1024, $time, $slow, $fast; 476 | } 477 | return $sp; 478 | } # result 479 | 480 | ### ############################################################################ 481 | 482 | sub get_config { 483 | my $url = "http://www.speedtest.net/speedtest-config.php"; 484 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 485 | $rsp->is_success or die "Cannot get config: ", $rsp->status_line, "\n"; 486 | my $xml = XMLin ( $rsp->content, 487 | keeproot => 1, 488 | noattr => 0, 489 | keyattr => [ ], 490 | suppressempty => "", 491 | ); 492 | $opt_v > 5 and ddumper $xml->{settings}; 493 | return $xml->{settings}; 494 | } # get_config 495 | 496 | sub get_servers { 497 | my $servlist; 498 | foreach my $url (qw( 499 | http://www.speedtest.net/speedtest-servers-static.php 500 | http://www.speedtest.net/speedtest-servers.php 501 | http://c.speedtest.net/speedtest-servers.php 502 | )) { 503 | $opt_v > 2 and warn "Fetching $url\n"; 504 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 505 | $opt_v > 2 and warn $rsp->status_line, "\n"; 506 | $rsp->is_success and $servlist = $rsp->content and last; 507 | } 508 | $servlist or die "Cannot get any config\n"; 509 | my $xml = XMLin ($servlist, 510 | keeproot => 1, 511 | noattr => 0, 512 | keyattr => [ ], 513 | suppressempty => "", 514 | ); 515 | # 4601 => { 516 | # cc => 'NL', 517 | # country => 'Netherlands', 518 | # dist => '38.5028663935342602', # added later 519 | # id => 4601, 520 | # lat => '52.2167', 521 | # lon => '5.9667', 522 | # name => 'Apeldoorn', 523 | # sponsor => 'Solcon Internetdiensten N.V.', 524 | # url => 'http://speedtest.solcon.net/speedtest/upload.php', 525 | # url2 => 'http://ooklaspeedtest.solcon.net/speedtest/upload.php' 526 | # }, 527 | 528 | return map { $_->{id} => $_ } @{$xml->{settings}{servers}{server}}; 529 | } # get_servers 530 | 531 | sub distance { 532 | my ($lat_c, $lon_c, $lat_s, $lon_s) = @_; 533 | my $rad = 6371; # km 534 | 535 | # Convert angles from degrees to radians 536 | my $dlat = deg2rad ($lat_s - $lat_c); 537 | my $dlon = deg2rad ($lon_s - $lon_c); 538 | 539 | my $x = sin ($dlat / 2) * sin ($dlat / 2) + 540 | cos (deg2rad ($lat_c)) * cos (deg2rad ($lat_s)) * 541 | sin ($dlon / 2) * sin ($dlon / 2); 542 | 543 | return $rad * 2 * atan2 (sqrt ($x), sqrt (1 - $x)); # km 544 | } # distance 545 | 546 | sub servers { 547 | my %list = get_servers (); 548 | if (my $iid = $config->{"server-config"}{ignoreids}) { 549 | $opt_v > 3 and warn "Removing servers $iid from server list\n"; 550 | delete @list{split m/\s*,\s*/ => $iid}; 551 | } 552 | $opt_a or delete @list{grep { $list{$_}{cc} ne $opt_c } keys %list}; 553 | %list or die "No servers in $opt_c found\n"; 554 | for (values %list) { 555 | $_->{dist} = distance ($client->{lat}, $client->{lon}, 556 | $_->{lat}, $_->{lon}); 557 | ($_->{url0} = $_->{url}) =~ s{/speedtest/upload.*}{}; 558 | $opt_v > 7 and ddumper $_; 559 | } 560 | return %list; 561 | } # servers 562 | 563 | sub servers_by_ping { 564 | my %list = servers; 565 | my @list = values %list; 566 | $opt_v > 1 and say STDERR "Finding fastest host out of @{[scalar @list]} hosts for $opt_c ..."; 567 | my $pa = LWP::UserAgent->new ( 568 | max_redirect => 2, 569 | agent => "Opera/25.00 opera 25", 570 | parse_head => 0, 571 | cookie_jar => {}, 572 | timeout => $timeout, 573 | ); 574 | $pa->env_proxy; 575 | $opt_ping ||= 40; 576 | if (@list > $opt_ping) { 577 | @list = sort { $a->{dist} <=> $b->{dist} } @list; 578 | @server or splice @list, $opt_ping; 579 | } 580 | foreach my $h (@list) { 581 | my $t = 0; 582 | if (@server and not first { $h->{id} == $_ } @server) { 583 | $h->{ping} = 999999; 584 | next; 585 | } 586 | $opt_v > 5 and printf STDERR "? %4d %-20.20s %s\n", 587 | $h->{id}, $h->{sponsor}, $h->{url}; 588 | my $req = HTTP::Request->new (GET => "$h->{url}/latency.txt"); 589 | for (0 .. 3) { 590 | my $t0 = [ gettimeofday ]; 591 | my $rsp = $pa->request ($req); 592 | my $elapsed = tv_interval ($t0); 593 | $opt_v > 8 and printf STDERR "%4d %9.2f\n", $_, $elapsed; 594 | if ($elapsed >= 15) { 595 | $t = 40; 596 | last; 597 | } 598 | $t += ($rsp->is_success ? $elapsed : 1000); 599 | } 600 | $h->{ping} = $t * 1000; # report in ms 601 | } 602 | sort { $a->{ping} <=> $b->{ping} 603 | || $a->{dist} <=> $b->{dist} } @list; 604 | } # servers_by_ping 605 | 606 | __END__ 607 | 608 | =encoding UTF-8 609 | 610 | =head1 NAME 611 | 612 | App::SpeedTest - Command-line interface to speedtest.net 613 | 614 | =head1 SYNOPSIS 615 | 616 | $ speedtest [ --no-geo | --country=NL ] [ --list | --ping ] [ options ] 617 | 618 | $ speedtest --list 619 | $ speedtest --ping --country=BE 620 | $ speedtest 621 | $ speedtest -s 4358 622 | $ speedtest --url=http://ookla.extraip.net 623 | $ speedtest -q --no-download 624 | $ speedtest -Q --no-upload 625 | 626 | =head1 DESCRIPTION 627 | 628 | The provided perl script is a command-line interface to the 629 | L infrastructure so that 630 | flash is not required 631 | 632 | It was written to feature the functionality that speedtest.net offers 633 | without the overhead of flash or java and the need of a browser. 634 | 635 | =head1 Raison-d'être 636 | 637 | The tool is there to give you a quick indication of the achievable 638 | throughput of your current network. That can drop dramatically if 639 | you are behind (several) firewalls or badly configured networks (or 640 | network parts like switches, hubs and routers). 641 | 642 | It was inspired by L, 643 | a project written in python. But I neither like python, nor did I like the 644 | default behavior of that script. I also think it does not take the right 645 | decisions in choosing the server based on distance instead of speed. That 646 | B matter if one has fiber lines. I prefer speed over distance. 647 | 648 | =head1 Command-line Arguments 649 | X 650 | 651 | =over 2 652 | 653 | =item -? | --help 654 | X<-?> 655 | X<--help> 656 | 657 | Show all available options and then exit. 658 | 659 | =item -V | --version 660 | X<-V> 661 | X<--version> 662 | 663 | Show program version and exit. 664 | 665 | =item --man 666 | X<--man> 667 | 668 | Show the builtin manual using C and C. 669 | 670 | =item --info 671 | X<--info> 672 | 673 | Show the builtin manual using C. 674 | 675 | =item -v[#] | --verbose[=#] 676 | X<-v> 677 | X<--version> 678 | 679 | Set verbose level. Default value is 1. A plain -v without value will set 680 | the level to 2. 681 | 682 | =item --simple 683 | X<--simple> 684 | 685 | An alias for C<-v0> 686 | 687 | =item --all 688 | X<--all> 689 | 690 | No (default) filtering on available servers. Useful when finding servers 691 | outside of the country of your own location. 692 | 693 | =item -g | --geo 694 | X<-g> 695 | X<--geo> 696 | 697 | Use GEO-IP service to find the country your ISP is located. The default 698 | is true. If disable (C<--no-geo>), the server to use will be based on 699 | distance instead of on latency. 700 | 701 | =item -cXX | --cc=XX | --country=XX 702 | X<-c> 703 | X<--cc> 704 | X<--country> 705 | 706 | Pass the ISO country code to select the servers 707 | 708 | $ speedtest -c NL ... 709 | $ speedtest --cc=B ... 710 | $ speedtest --country=D ... 711 | 712 | =item --list-cc 713 | X<--list-cc> 714 | 715 | Fetch the server list and then show the list of countries the servers are 716 | located with their country code and server count 717 | 718 | $ speedtest --list-cc 719 | AD Andorra 1 720 | AE United Arab Emirates 4 721 | : 722 | ZW Zimbabwe 6 723 | 724 | You can then use that code to list the servers in the chosen country, as 725 | described below. 726 | 727 | =item -l | --list 728 | X<-l> 729 | X<--list> 730 | 731 | This option will show all servers in the selection with the distance in 732 | kilometers to the server. 733 | 734 | $ speedtest --list --country=IS 735 | 1: 10661 - Tengir hf Akureyri 1980.02 km 736 | 2: 21605 - Premis ehf Reykjavík 2039.16 km 737 | 3: 3684 - Nova Reykjavik 2039.16 km 738 | 4: 6471 - Gagnaveita Reykjavikur Reykjavik 2039.16 km 739 | 5: 10650 - Nova VIP Reykjavik 2039.16 km 740 | 6: 16148 - Hringidan Reykjavik 2039.16 km 741 | 7: 4818 - Siminn Reykjavik 2039.16 km 742 | 8: 17455 - Hringdu Reykjavík 2039.16 km 743 | 9: 4141 - Vodafone Reykjavík 2039.16 km 744 | 10: 3644 - Snerpa Isafjordur 2192.27 km 745 | 746 | =item -p | --ping | --ping=40 747 | X<-p> 748 | X<--ping> 749 | 750 | Show a list of servers in the selection with their latency in ms. 751 | Be very patient if running this with L. 752 | 753 | $ speedtest --ping --cc=BE 754 | 1: 4320 - EDPnet Sint-Niklaas 148.06 km 52 ms 755 | 2: 12627 - Proximus Brussels 173.04 km 55 ms 756 | 3: 10986 - Proximus Schaarbeek 170.54 km 55 ms 757 | 4: 15212 - Telenet BVBA/SPRL Mechelen 133.89 km 57 ms 758 | 5: 29238 - Arcadiz DIEGEM 166.33 km 58 ms 759 | 6: 5151 - Combell Brussels 173.04 km 59 ms 760 | 7: 26887 - Arxus NV Brussels 173.04 km 64 ms 761 | 8: 4812 - Universite Catholiq… Louvain-La-Neuv 186.87 km 70 ms 762 | 9: 2848 - Cu.be Solutions Diegem 166.33 km 75 ms 763 | 10: 12306 - VOO Liège 186.26 km 80 ms 764 | 11: 24261 - Une Nouvelle Ville… Charleroi 217.48 km 147 ms 765 | 12: 30594 - Orange Belgium Evere 169.29 km 150 ms 766 | 767 | If a server does not respond, a very high latency is used as default. 768 | 769 | This option only shows the 40 nearest servers. The number can be changed 770 | as optional argument. 771 | 772 | $ speedtest --cc=BE --ping=4 773 | 1: 4320 - EDPnet Sint-Niklaas 148.06 km 53 ms 774 | 2: 29238 - Arcadiz DIEGEM 166.33 km 57 ms 775 | 3: 15212 - Telenet BVBA/SPRL Mechelen 133.89 km 62 ms 776 | 4: 2848 - Cu.be Solutions Diegem 166.33 km 76 ms 777 | 778 | =item -1 | --one-line 779 | X<-1> 780 | X<--ono-line> 781 | 782 | Generate a very short report easy to paste in e.g. IRC channels. 783 | 784 | $ speedtest -1Qv0 785 | DL: 40.721 Mbit/s, UL: 30.307 Mbit/s 786 | 787 | =item -B | --bytes 788 | X<-B> 789 | X<--bytes> 790 | 791 | Report throughput in Mbyte/s instead of Mbit/s 792 | 793 | =item -C | --csv 794 | X<-C> 795 | X<--csv> 796 | 797 | Generate the measurements in CSV format. The data can be collected in 798 | a file (by a cron job) to be able to follow internet speed over time. 799 | 800 | The reported fields are 801 | 802 | - A timestam (the time the tests are finished) 803 | - The server ID 804 | - The latency in ms 805 | - The number of tests executed in this measurement 806 | - The direction of the test (D = Down, U = Up) 807 | - The measure avarage speed in Mbit/s 808 | - The minimum speed measured in one of the test in Mbit/s 809 | - The maximum speed measured in one of the test in Mbit/s 810 | 811 | $ speedtest -Cs4358 812 | "2015-01-24 17:15:09",4358,63.97,40,D,93.45,30.39,136.93 813 | "2015-01-24 17:15:14",4358,63.97,40,U,92.67,31.10,143.06 814 | 815 | =item -U | --skip-undef 816 | X<-U> 817 | X<--skip-undef> 818 | 819 | Skip reporting measurements that have no speed recordings at all. 820 | The default is to report these as C<0.00> .. C<999999999.999>. 821 | 822 | =item -P | --prtg 823 | X<-P> 824 | X<--prtg> 825 | 826 | Generate the measurements in XML suited for PRTG 827 | 828 | $ speedtest -P 829 | 830 | 831 | Testing from My ISP (10.20.30.40) 832 | 833 | Ping 834 | ms 835 | 1 836 | 56.40 837 | 838 | 839 | Download 840 | Mbit/s 841 | 1 842 | 38.34 843 | 844 | 845 | Upload 846 | Mbit/s 847 | 1 848 | 35.89 849 | 850 | 851 | 852 | =item --url[=XXX] 853 | X<--url> 854 | 855 | With no value, show server url in list 856 | 857 | With value, use specific server url: do not scan available servers 858 | 859 | =item --ip 860 | X<--ip> 861 | 862 | Show IP for server 863 | 864 | =item -T[#] | --try[=#] 865 | X<-T> 866 | X<--try> 867 | 868 | Use the top # (based on lowest latency or shortest distance) from the list 869 | to do all required tests. 870 | 871 | $ speedtest -T3 -c NL -Q2 872 | Testing for 80.x.y.z : XS4ALL Internet BV (NL) 873 | 874 | Using 13218: 26.52 km 25 ms XS4ALL Internet BV 875 | Test download .. Download 31.807 Mbit/s 876 | Test upload .. Upload 86.587 Mbit/s 877 | 878 | Using 15850: 26.09 km 25 ms QTS Data Centers 879 | Test download .. Download 80.763 Mbit/s 880 | Test upload .. Upload 77.122 Mbit/s 881 | 882 | Using 11365: 26.09 km 27 ms Vancis 883 | Test download .. Download 106.022 Mbit/s 884 | Test upload .. Upload 82.891 Mbit/s 885 | 886 | Rank 01: Server: 11365 26.09 km 27 ms, DL: 106.022 UL: 82.891 887 | Rank 02: Server: 15850 26.09 km 25 ms, DL: 80.763 UL: 77.122 888 | Rank 03: Server: 13218 26.52 km 25 ms, DL: 31.807 UL: 86.587 889 | 890 | $ speedtest -1v0 -T5 891 | DL: 200.014 Mbit/s, UL: 159.347 Mbit/s, SRV: 13218 892 | DL: 203.599 Mbit/s, UL: 166.247 Mbit/s, SRV: 15850 893 | DL: 207.249 Mbit/s, UL: 134.957 Mbit/s, SRV: 11365 894 | DL: 195.490 Mbit/s, UL: 172.109 Mbit/s, SRV: 5972 895 | DL: 179.413 Mbit/s, UL: 160.309 Mbit/s, SRV: 2042 896 | 897 | Rank 01: Server: 15850 26.09 km 30 ms, DL: 203.599 UL: 166.247 898 | Rank 02: Server: 5972 26.09 km 32 ms, DL: 195.490 UL: 172.109 899 | Rank 03: Server: 13218 26.52 km 23 ms, DL: 200.014 UL: 159.347 900 | Rank 04: Server: 11365 26.09 km 31 ms, DL: 207.249 UL: 134.957 901 | Rank 05: Server: 2042 51.41 km 33 ms, DL: 179.413 UL: 160.309 902 | 903 | =item -s# | --server=# | --server=filename 904 | X<-s> 905 | X<--server> 906 | 907 | Specify the ID of the server to test against. This ID can be taken from the 908 | output of L or L. Using this option prevents fetching the 909 | complete server list and calculation of distances. It also enables you to 910 | always test against the same server. 911 | 912 | $ speedtest -1s4358 913 | Testing for 80.x.y.z : XS4ALL Internet BV () 914 | Using 4358: 52.33 km 64 ms KPN 915 | Test download ........................................Download: 92.633 Mbit/s 916 | Test upload ........................................Upload: 92.552 Mbit/s 917 | DL: 92.633 Mbit/s, UL: 92.552 Mbit/s 918 | 919 | This argument may be repeated to test against multile servers, more or less 920 | like specifying your own top x (as with C<-T>). 921 | 922 | $ speedtest -s 22400 -s 1208 -s 13218 923 | Testing for 185.x.y.z : Freedom Internet BV () 924 | 925 | Using 13218: 80.15 km 32 ms XS4ALL Internet BV 926 | Test download ........................................Download 66.833 Mbit/s 927 | Test upload ........................................Upload 173.317 Mbit/s 928 | 929 | Using 1208: 51.19 km 37 ms Qweb | Full-Service Hosting 930 | Test download ........................................Download 52.077 Mbit/s 931 | Test upload ........................................Upload 195.833 Mbit/s 932 | 933 | Using 22400: 80.15 km 46 ms Usenet.Farm 934 | Test download ........................................Download 96.341 Mbit/s 935 | Test upload ........................................Upload 203.306 Mbit/s 936 | 937 | Rank 01: Server: 22400 80.15 km 46 ms, DL: 96.341 UL: 203.306 938 | Rank 02: Server: 1208 51.19 km 37 ms, DL: 52.077 UL: 195.833 939 | Rank 03: Server: 13218 80.15 km 32 ms, DL: 66.833 UL: 173.317 940 | 941 | If you pass a filename, it is expected to reflect a server-like structure as 942 | received from the speedtest server-list, possibly completed with upload- and 943 | download URL's. You can only pass one filename not consisting of all digits. 944 | If you do, all remaining C<-s> arguments are ignored. 945 | 946 | { cc => "NL", 947 | country => "Netherlands", 948 | host => "unlisted.host.amsterdam:8080", 949 | id => 9999, 950 | lat => "52.37316", 951 | lon => "4.89122", 952 | name => "Amsterdam", 953 | ping => 20.0, 954 | sponsor => "Dam tot Damloop", 955 | url => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 956 | url2 => "http://unlisted.host.amsterdam/speedtest/speedtest/upload.php", 957 | 958 | dl_list => [ 959 | "http://unlisted.host.amsterdam/files/128.bin", 960 | "http://unlisted.host.amsterdam/files/256.bin", 961 | # 40 URL's pointing to files in increasing size 962 | "http://unlisted.host.amsterdam/files/2G.bin", 963 | ], 964 | ul_list => [ 965 | # 40 URL's 966 | ], 967 | } 968 | 969 | =item -t# | --timeout=# 970 | X<-t> 971 | X<--timeout> 972 | 973 | Specify the maximum timeout in seconds. 974 | 975 | =item -d | --download 976 | X<-d> 977 | X<--download> 978 | 979 | Run the download tests. This is default unless L is passed. 980 | 981 | =item -u | --upload 982 | X<-u> 983 | X<--upload> 984 | 985 | Run the upload tests. This is default unless L is passed. 986 | 987 | =item -q[#] | --quick[=#] | --fast[=#] 988 | X<-q> 989 | X<--quick> 990 | X<--fast> 991 | 992 | Don't run the full test. The default test runs 40 tests, sorting on 993 | increasing test size (and thus test duration). Long(er) tests may take 994 | too long on slow connections without adding value. The default value 995 | for C<-q> is 20 but any value between 1 and 40 is allowed. 996 | 997 | =item -Q[#] | --realquick[=#] 998 | X<-Q> 999 | X<--realquick> 1000 | 1001 | Don't run the full test. The default test runs 40 tests, sorting on 1002 | increasing test size (and thus test duration). Long(er) tests may take 1003 | too long on slow connections without adding value. The default value 1004 | for C<-Q> is 10 but any value between 1 and 40 is allowed. 1005 | 1006 | =item -mXX | --mini=XX 1007 | X<-m> 1008 | X<--mini> 1009 | 1010 | Run the speedtest on a speedtest mini server. 1011 | 1012 | =item --source=XX 1013 | 1014 | NYI - mentioned for speedtest-cli compatibility 1015 | 1016 | =back 1017 | 1018 | =head1 EXAMPLES 1019 | 1020 | See L and L 1021 | 1022 | =head1 DIAGNOSTICS 1023 | 1024 | ... 1025 | 1026 | =head1 BUGS and CAVEATS 1027 | 1028 | Due to language implementation, it may report speeds that are not 1029 | consistent with the speeds reported by the web interface or other 1030 | speed-test tools. Likewise for reported latencies, which are not 1031 | to be compared to those reported by tools like ping. 1032 | 1033 | =head1 TODO 1034 | 1035 | =over 2 1036 | 1037 | =item Improve documentation 1038 | 1039 | What did I miss? 1040 | 1041 | =item Enable alternative XML parsers 1042 | 1043 | XML::Simple is not the recommended XML parser, but it sufficed on 1044 | startup. All other API's are more complex. 1045 | 1046 | =back 1047 | 1048 | =head1 PORTABILITY 1049 | 1050 | As Perl has been ported to a plethora of operating systems, this CLI 1051 | will work fine on all systems that fulfill the requirement as listed 1052 | in Makefile.PL (or the various META files). 1053 | 1054 | The script has been tested on Linux, HP-UX, AIX, and Windows 7. 1055 | 1056 | Debian wheezy will run with just two additional packages: 1057 | 1058 | # apt-get install libxml-simple-perl libdata-peek-perl 1059 | 1060 | =head1 SEE ALSO 1061 | 1062 | As an alternative to L, you 1063 | could consider L. 1064 | 1065 | The L project 1066 | that inspired me to improve a broken CLI written in python into our 1067 | beloved language Perl. 1068 | 1069 | =head1 CONTRIBUTING 1070 | 1071 | =head2 General 1072 | 1073 | I am always open to improvements and suggestions. Use issues at 1074 | L. 1075 | 1076 | =head2 Style 1077 | 1078 | I will never accept pull request that do not strictly conform to my 1079 | style, however you might hate it. You can read the reasoning behind 1080 | my preferences L. 1081 | 1082 | I really don't care about mixed spaces and tabs in (leading) whitespace 1083 | 1084 | =head1 WARRANTY 1085 | 1086 | This tool is by no means a guarantee to show the correct speeds. It 1087 | is only to be used as an indication of the throughput of your internet 1088 | connection. The values shown cannot be used in a legal debate. 1089 | 1090 | =head1 AUTHOR 1091 | 1092 | H.Merijn Brand Flinux@tux.freedom.nlE> wrote this for his own 1093 | personal use, but was asked to make it publicly available as application. 1094 | 1095 | =head1 COPYRIGHT AND LICENSE 1096 | 1097 | Copyright (C) 2014-2025 H.Merijn Brand 1098 | 1099 | This software is free; you can redistribute it and/or modify 1100 | it under the same terms as Perl itself. 1101 | 1102 | =cut 1103 | --------------------------------------------------------------------------------