#!/usr/bin/perl
#-----------------------------------------------------------------------------#
#
# Find fastest CVSup server script for FreeBSD - version 0.2.9
# Copyright (c) A.J.Robinson (ajr@subdimension.com) 2002
# Distributed under the BSD license.
#
#-----------------------------------------------------------------------------#
#
# Changes:
# 0.2.9 - added 'us' country code for USA hosts and 'tld' for top-level
# domain machines (can be in any country)
# 0.2.8 - fixed the progress meter, timestamped %FREEBSD_SERVERS
# 0.2.7 - updated documentation, usage message and progress meter.
# 0.2.6 - changed from freebsdmirrors.org to the online handbook.
# 0.2.5 - added support for other servers (NetBSD/OpenBSD) that don't match
# the naming scheme.
# 0.2.4 - ability to get CVSup mirrors from www.freebsdmirrors.org, script re-
# writes itself if $REWRITE_SELF is set. Removed @ALL_CC.
# 0.2.3 - added exit codes, POD documentation, exit with usage() if no params
# given, 'local' and 'all' targets.
# 0.2.2 - fixed stupid coding with double DNS lookup (PeerAddr=>$server).
# 0.2.1 - better error messages, wrap gethostbyname in eval block to timeout,
# verbose and quiet modes.
# 0.2.0 - generate server list from hash.
# 0.1.0 - basic version - just about worked!
#
#-----------------------------------------------------------------------------#
# Load dependent modules
# We want to do this before the other modules so it fails quickly.
# Print a friendly error so newbies aren't completely stuck:
# (sorry it's a bit FreeBSD specific!)
BEGIN {
eval('use Time::HiRes qw(gettimeofday)');
if ($@) {
die( "\nYou need the Time::HiRes perl module, you can either:\n\n",
"1. Load it from CPAN:\n",
" # perl -MCPAN -e \'install Time::HiRes\'\n\n",
"2. Fetch it as a package:\n",
" # pkg_add -r p5-Time-HiRes\n\n",
"3. Compile it from the ports collection:\n",
" # cd /usr/ports/devel/p5-Time-HiRes ; make install clean\n\n",
);
}
}
# standard modules in perl distribution which _should_ be there
$|++; # (unbuffer STDOUT)
use strict;
use IO::Socket;
use Getopt::Std ('getopts');
# Works better with the port: www/p5-libwww, but not essential.
my $HAVE_LWP = eval('require LWP::Simple qw(get)');
#-----------------------------------------------------------------------------#
# User Configurable Variables (you can change these):
# edit this for countries which are fairly close to you:
my @LOCAL_CC = qw( uk ie fr de fi no nl ); # (lower case, separated by space)
# network timeouts in seconds:
my $DNS_TIMEOUT = 5; # DNS lookups
my $CVS_TIMEOUT = 5; # connect to the CVS server
my $REWRITE_SELF = 0; # shall I rewrite myself when new servers are found
# in the online Handbook? (only root can do this)
#-----------------------------------------------------------------------------#
# Other variables
# How many FreeBSD CVSup servers has each country got? (well, not strictly
# true... what's the highest cvsup number in use?
my %FREEBSD_SERVERS = ( # last updated: May 29 21:30:20 GMT 2006
'ar' => 1, # Argentina
'at' => 2, # Austria
'au' => 7, # Australia
'br' => 4, # Brazil
'ca' => 2, # Canada
'ch' => 2, # Switzerland
'cn' => 7, # China
'cr' => 1, # Costa Rica
'cz' => 1, # Czech Republic
'de' => 8, # Germany
'dk' => 3, # Denmark
'ee' => 2, # Estonia
'es' => 3, # Spain
'fi' => 2, # Finland
'fr' => 8, # France
'gr' => 2, # Greece
'hu' => 1, # Hungary
'ie' => 1, # Ireland
'is' => 1, # Iceland
'jp' => 6, # Japan
'kg' => 1, # Kyrgyzstan
'kr' => 5, # Korea
'kw' => 1, # Kuwait
'lt' => 3, # Lithuania
'lv' => 3, # Latvia
'nl' => 6, # Netherlands
'no' => 1, # Norway
'nz' => 1, # New Zealand
'ph' => 1, # Philippines
'pl' => 3, # Poland
'pt' => 3, # Portugal
'ro' => 3, # Romania
'ru' => 7, # Russia
'se' => 4, # Sweden
'sg' => 1, # Singapore
'si' => 3, # Slovenia
'sk' => 1, # Slovak Republic
'sm' => 1, # San Marino
'th' => 1, # Thailand
'tr' => 1, # Turkey
'tw' => 14, # Taiwan
'ua' => 11, # Ukraine
'uk' => 4, # United Kingdom
'us' => 18, # USA
'za' => 2, # South Africa
'tld' => 18, # Top Level Domain
);
my %OTHER_SERVERS = (
# from: http://www.netbsd.org/mirrors/#cvsup
'netbsd' => [ 'cvsup.de.netbsd.org',
'cvsup2.de.netbsd.org',
'cvsup.jp.netbsd.org',
'cvsup.pasta.cs.uit.no',
'cvsup.uk.netbsd.org',
],
# from: http://www.openbsd.org/cvsup.html#CVSROOT
'openbsd' => [ 'cvsup.uk.openbsd.org',
'cvsup.de.openbsd.org',
'cvsup2.de.openbsd.org',
'cvsup.hu.openbsd.org',
'cvsup.fr.openbsd.org',
'cvsup.ca.openbsd.org',
'cvsup.usa.openbsd.org',
'cvsup.kr.openbsd.org',
'cvsup.no.openbsd.org',
'cvsup.pt.openbsd.org',
'anoncvs.de.openbsd.org',
'rt.fm',
'skeleton.phys.spbu.ru',
'cvsup.jp.openbsd.org',
'cvsup.tw.openbsd.org',
'openbsd.cc.ntu.edu.tw',
'wiretapped.net',
],
);
my $CVSUP_PORT = 5999; # we attempt to connect on this port from an
# unprivaleged local port - can change this
# so we look for fastest FTP mirrors instead.
# But that's another script... ;)
# The URL to connect to when remotely fetching a list of CVSup servers:
my $URL="http://www.freebsd.org/doc/en/books/handbook/cvsup.html";
# What shall we display?
# verbose messages:
my $GENERAL_INFO = '>> ';
my $GENERAL_WARNING = '** ';
my $SERVER_INFO = '--> ';
my $SERVER_WARNING = '==> ';
my $SERVER_RESULT = ' - ';
my $SERVER_ERROR = ' * ';
#-----------------------------------------------------------------------------#
# Usage() sub
sub Usage {
my $error = shift;
print "\n fastest_cvsup - finds fastest CVSup server\n\n";
print " Error: $error\n" if $error;
print " Usage: $0 [-h] [-q|Q] [-r] -c (country codes|local|all)\n",
" Where: -h prints this screen\n",
" -q quiet mode, only outputs fastest server\n",
" -Q very quiet mode, no progress meter\n",
" -r uses remote server list from FreeBSD Handbook\n",
" -c aa,bb,cc queries servers in countries aa,bb,cc\n",
" tld queries servers in the top level domain\n",
" local queries servers set as local in the script\n",
" all queries all FreeBSD servers\n\n",
" See the man page, fastest_cvsup(7), for more details.\n\n";
exit(1);
}
#-----------------------------------------------------------------------------#
# get user supplied options
# we need the ':' to store the actual values of the -c switch
my %opt = ();
getopts("hrqQc:", \%opt);
# if no args given, or help page requested
Usage() if ( ! %opt or $opt{'h'} );
# how noisy shall we be?
my $VERBOSE = 1; # let's be loud (default)
my $SHOW_PROGRESS = 1; # shall I show a small status bar? (default yes)
if ( $opt{'q'} or $opt{'Q'} ) { $VERBOSE = 0 } # only display fastest
if ( $opt{'Q'} ) { $SHOW_PROGRESS = 0 } # no progress meter
# shall we get a list of CVSup servers from $URL?
my $REMOTE_SERVERLIST = 0; # default is no, use internal list
if ( $opt{'r'} ) { $REMOTE_SERVERLIST = 1; }
# which servers shall we query?
my @countries = ();
unless ( $opt{'c'} ) {
# nothing to query, so we exit with an error message
Usage('You need to specify which servers to query!');
}
else {
$opt{'c'} = lc( $opt{'c'} ); # convert to lowercase
if ( $opt{'c'} eq 'local' ) { # shall we query local servers ?
@countries = @LOCAL_CC;
}
elsif ( $opt{'c'} eq 'all' ) { # shall we query all servers ?
@countries = sort ( keys %FREEBSD_SERVERS );
}
else { # build a list from the countries specified
# count number of times the country crops up, if it's greater than 1
# push it into the countries array (specifying -c uk,uk,uk will only
# query uk servers once)
my %i = (); # (just a counter)
for ( split(',',$opt{'c'}) ) { $i{$_}++ } # count times
for ( keys %i ) { push(@countries,$_) if $i{$_} >= 1 } # build array
}
}
#-----------------------------------------------------------------------------#
if ( $REMOTE_SERVERLIST ) {
print $GENERAL_INFO, "Fetching server list... " if $VERBOSE;
my $html;
# for testing
#if (open(F,"<sites.htm")){while(<F>){$html.=$_}close(F)};
if ( $HAVE_LWP ) {
$html = get($URL);
}
else {
$html = `fetch -qo- $URL`;
}
if ( $html ) { # did we get anything?
print "OK!\n" if $VERBOSE;
my %srv = (); # temporary hash before transfering into %FREEBSD_SERVERS
my %cc_name = (); # hash to hold the full country name
# get the servers from the handbook - it's a bit more messy, but as
# freebsdmirrors.org relies on DNS zone transfers (which don't seem to
# work anymore), it's the next best thing.
# non-greedy regex to grab what's between the <dl> tags just after the
# name anchor.
$html =~ s|.*name="CVSUP-MIRRORS".*?<dl>(.*?)</dl>.*|$1|s;
# split it up into countries, between '<dt>' tags
for ( split('<dt>',$html) ) {
# extract the country name and the rest (what a mess!)
s/^<a[^>]+><\/a>//;
if ( m/^(\w+)(\s{1}\w+)?\s*(.*)/s ) {
my $country = $1.$2; # for two word names
my $mess = $3; # the rest
# get rid of crap and the first '<li>'
$mess =~ s/.*?<li>(.*)/$1/s;
for ( split('<li>',$mess) ) {
# extract server name
my $server;
($server = $_ ) =~ s/.*<p>([\w\.]+).*/$1/s;
# parse non-US servers
if ( $server =~ /cvsup([\d]*)\.([\w]+)\.freebsd\.org/i ) {
my $i = $1 || 1; # set to 1 if no initial digit
my $cc = lc($2); # convert to lower case
# save the highest number encountered
if ( !$srv{$cc} or $srv{$cc} < $i ) { $srv{$cc} = $i }
# save country name
unless ( $cc_name{$cc} ) { $cc_name{$cc} = $country }
}
# parse TLD servers
elsif ( $server =~ /cvsup([\d]*)\.freebsd\.org/i ) {
my $i = $1 || 1;
if ( !$srv{'tld'} or $srv{'tld'} < $i ) { $srv{'tld'} = $i }
unless ( $cc_name{'tld'} ) { $cc_name{'tld'} = $country }
}
}
}
}
# check to see if the internal list needs updating... (this assumes that
# the Handbook will be more up to date)
my $needs_updating = ();
for ( keys %srv ) {
if ( $srv{$_} ne $FREEBSD_SERVERS{$_} ) {
$needs_updating++;
last;
}
}
if ( $needs_updating ) {
if ( $REWRITE_SELF ) {
# XXX: should really stick this in __DATA__
if ( $< == 0 ) { #same as: if ( scalar(getpwuid $<) eq 'root' ) {
# build a new FREEBSD_SERVERS hash
my $time = scalar(localtime);
my $newstring = "my \%FREEBSD_SERVERS = ( # last updated: $time\n";
for ( sort( keys %srv ) ) {
# 'cc' => number,
$newstring .= " \'$_\' => $srv{$_},";
# variable length spacer, basically for lining up USA!
$newstring .= ( " " x ( 5 - length($srv{$_}) ) );
# commented out country name
$newstring .= "# $cc_name{$_}\n";
}
$newstring .= ");";
# read in _this_ file (!)
open(OLD, "< $0") or die "Error, can't open $0: $!";
my $bigstring;
while (<OLD>) { $bigstring .= $_ }
close(OLD) or die "Error, can't close $0: $!";
# substitute the variable (non-greedy regex again)
$bigstring =~ s/(my \%FREEBSD_SERVERS = .*?;)/$newstring/gs;
# write it out to a new file
open(NEW, "> $0.new") or die "Error, can't open $0.new: $!";
print NEW $bigstring or die "Error, can't write $0.new: $!";
close(NEW) or die "Error, can't close $0.new: $!";
# swap them over
rename($0, "$0.orig") or die "Error, can't rename $0 to $0.orig: $!";
rename("$0.new", $0) or die "Error, can't rename $0.new to $0: $!";
# set permissions on new file
chmod(0755,$0) or die "\nCannot chmod(0755,$0): $!\n";
print $GENERAL_INFO, "The internal CVSup list has been updated.\n" if $VERBOSE;
}
else {
print $GENERAL_WARNING, "The internal CVSup list can ONLY be updated by ROOT.\n" if $VERBOSE;
}
}
else {
# we're not updating automagically, so you get a message to do
# it yourself!
print $GENERAL_INFO, "The internal CVSup list needs updating!\n" if $VERBOSE;
}
}
# use the new list we've downloaded
%FREEBSD_SERVERS = %srv;
# and we might need to update this if it's changed
if ( $opt{'c'} eq 'all' ) { @countries = sort ( keys %FREEBSD_SERVERS ) }
}
else {
print "Failed! (Using internal list)\n" if $VERBOSE;
}
}
#-----------------------------------------------------------------------------#
# now we build an array of servers
my (@servers,@first,@others) = ();
foreach my $cc ( @countries ) {
# For all the countries except the US, the server names follow the pattern
# cvsupXX.country.freebsd.org, with the first server omitting the XX digit.
# US servers don't include the country, but include the first digit.
for ( my $i=1; $i<=$FREEBSD_SERVERS{$cc}; $i++ ) {
if ( $cc eq 'tld' ) { # use no country code, include the '1'
if ( $i == 1 ) { push(@first,"cvsup$i.freebsd.org"); }
else { push(@others,"cvsup$i.freebsd.org"); }
}
else {
if ( $i == 1 ) { push(@first,"cvsup.$cc.freebsd.org"); }
else { push(@others,"cvsup$i.$cc.freebsd.org"); }
}
}
if ( $OTHER_SERVERS{$cc} ) {
push( @others, @{ $OTHER_SERVERS{$cc} } );
}
}
# put the first server of each country at the start of the servers array and
# the rest at the end - this gives the DNS server more time to reply. With
# slow connections and caching DNS (looking up the root), this is better, I
# think. Any comments...?
@servers = (@first,@others);
#-----------------------------------------------------------------------------#
# now we time the servers in the array
print $GENERAL_INFO, "Querying servers in countries: @countries\n" if $VERBOSE;
my %time = ();
my $srvs = scalar(@servers) - 1; # number of servers (minus one)
my $done = 0; # number of servers timed
foreach my $server (@servers) {
if ( $SHOW_PROGRESS && ! $VERBOSE ) {
# display simple progress bar (much simplified from earlier versions)
my $left = $srvs - $done;
print STDERR "\r",(' ' x 80),"\r"; # beginning of line, overwrite with ' ' 80 times, back to beginning
print STDERR " -=(\033[32mo",('o' x $done),"\033[m\033[31m",('o' x $left),"\033[m)=($server)=- ";
if ($srvs == $done) {print STDERR "\n"}
$done++;
}
my $ip_packed = (); # get ip address before attempting to connect, and
my $ip_addr = (); # wrap gethostbyname in an eval block to timeout. IP
# address is packed in memory, hence these vars.
sub timeout { die "TIMEOUT\n" }; # replacement signal
$SIG{'ALRM'} = \&timeout;
eval {
alarm($DNS_TIMEOUT); # set timeout...
$ip_packed = (gethostbyname($server))[4]; # lookup server within $TIMEOUT
alarm(0); # done, cancel alarm
};
if ($@ =~ /^TIMEOUT/ ) { # we timed out
print $SERVER_WARNING, "DNS lookup timed out for $server\n" if $VERBOSE;
next;
}
elsif (! $ip_packed ) { # no such host
print $SERVER_WARNING, "DNS lookup failed for $server\n" if $VERBOSE;
next;
}
$ip_addr = join(".",unpack("C4",$ip_packed)); # get dotted quad ip
# connect to IP address of server
print $SERVER_INFO, "Connecting to $server [$ip_addr]...\n" if $VERBOSE;
my $time_before = gettimeofday(); # start timing....
my $remote = IO::Socket::INET->new( Proto=>'tcp',
PeerAddr=>$ip_addr,
PeerPort=>$CVSUP_PORT,
Reuse=>1,
Timeout=>$CVS_TIMEOUT,
);
my $time_after = gettimeofday(); # .... end timing
if ( $@ ) { # was there an error?
if ( $VERBOSE ) { # And do we want to know about it?
my $error = ();
($error = $@) =~ s/^IO::Socket::INET\s*:\s*(.*)/$1/;
print $SERVER_ERROR, "error: $error\n";
}
next; # skip to the next one
}
if ( defined($remote) and $remote->opened ) { # did we get a connection?
my $reply = $remote->getline; # what did the server say?
chomp($reply); # remove newline
close $remote; # close connection
my $time_taken = $time_after - $time_before; # calculate time
# if the server replied 'OK', i.e. not overloaded, save the timing
$time{$server} = $time_taken if ( $reply =~ m/^OK/ );
if ( $VERBOSE ) { # print pretty display
my $ms = sprintf("%.2f", 1000 * $time_taken); # time in ms
print $SERVER_RESULT, "server replied: $reply\n";
print $SERVER_RESULT, "time taken: $ms ms\n";
}
}
}
#-----------------------------------------------------------------------------#
# now we output the fastest
if ( %time ) { # did we get *any* servers?
# sort for the fastest
my @fastest = ();
for ( sort { $time{$a} <=> $time{$b} } keys %time ) { push(@fastest,$_) }
# if we are verbose, print the gold, silver and bronze medalists
if ( $VERBOSE ) {
print "\n", $GENERAL_INFO, "Speed Daemons:\n" if $fastest[0]; # just checking ;)
print $SERVER_RESULT, "1st: $fastest[0]\n" if $fastest[0];
print $SERVER_RESULT, "2nd: $fastest[1]\n" if $fastest[1];
print $SERVER_RESULT, "3rd: $fastest[2]\n" if $fastest[2];
}
else { # otherwise just output the fastest.
print $fastest[0];
print STDERR "\n"; # ending newline
}
}
else {
# we didn't get any servers, boo hoo. Send this to STDERR.
print STDERR $GENERAL_WARNING, "No servers were found :( \n";
exit(1);
}
exit(0);
#-----------------------------------------------------------------------------#
# POD documentation follows...
__END__
=head1 NAME
B<fastest_cvsup> - find fastest CVSup server
=head1 SYNOPSIS
B<fastest_cvsup> [B<-h>] [B<-(q|Q)>] [B<-r>] B<-c> (B<country codes>|B<tld>|B<local>|B<all>)
=head1 DESCRIPTION
Displays the 3 fastest CVSup servers in user specified countries. It can just
return the fastest for use in automated shell scripts.
It uses Time::HiRes for timings and IO::Socket::INET to make a socket
connection to the target server, the server response is taken notice of. Unlike
some shell scripts it does not rely on 'pings' to measure network speed.
=head1 USAGE
=over 5
=item B<-h>
displays usage.
=item B<-q>
quiet mode - only returns the fastest server and prints a progress meter.
=item B<-Q>
very quiet mode - in addition the progress meter is not shown.
=item B<-r>
uses remote CVSup server list from the online FreeBSD Handbook.
If the variable C<$REWRITE_SELF> is set to 1 in the script then (as if by
magic) it re-writes itself with the new server list. This only works as root
and does not do it by default.
=item B<-c country codes>
this is a list (comma separated, no spaces) of server groups to time.
FreeBSD servers are grouped into country codes - see the script or the FreeBSD
Handbook for a full list.
NetBSD and OpenBSD servers are lumped together under the 'netbsd' and
'openbsd' codes respectively.
=item B<-c tld>
checks the servers in the Top Level Domain. These can be anywhere in the
world.
=item B<-c local>
uses the countries specifed in the C<@LOCAL_CC> array. Edit the script to
specify which countries are considered local.
=item B<-c all>
uses all the FreeBSD servers. This may take some time, but is quite interesting!
=back
=head1 EXAMPLES
=over 5
=item 1
times the FreeBSD CVSup servers in the United Kingdom, France and Germany:
$ fastest_cvsup -c uk,fr,de
=item 2
times the OpenBSD and NetBSD CVSup servers:
$ fastest_cvsup -c openbsd,netbsd
=item 3
shell script, finds the fastest UK FreeBSD CVSup server, then runs cvsup using
that server:
#!/bin/sh
if SERVER=`fastest_cvsup -q -c uk`; then
cvsup -h $SERVER /usr/local/etc/cvsup/supfile
fi
=back
=head1 RETURN VALUES
Returns 0 without any errors, 1 with errors.
=head1 AUTHOR
A.J.Robinson, E<lt>ajr@subdimension.comE<gt>
=cut
syntax highlighted by Code2HTML, v. 0.9.1