webwml/update-mirrors.pl

#!/usr/bin/perl -w
use warnings;
use strict;
use Data::Dumper;
use LWP::Simple;
use HTML::LinkExtor;
use LWP;
use Date::Parse;
use Date::Format;
use Digest::SHA qw(sha256_hex);

# This is Free Software (GPLv3)
# http://www.gnu.org/licenses/gpl-3.0.txt

print "Creating LWP agent ($LWP::VERSION)...\n";
my $lua = LWP::UserAgent->new(
    keep_alive => 1,
    timeout => 30,
    agent => "Tor MirrorCheck Agent"
);

sub sanitize {
    my $taintedData = shift;
    my $cleanedData;
    my $whitelist = '-a-zA-Z0-9: +';

    # clean the data, return cleaned data
    $taintedData =~ s/[^$whitelist]//go;
    $cleanedData = $taintedData;

    return $cleanedData;
}
sub ExtractLinks {
    my $content = shift; 
    my $url     = shift;
    my @links;

    my $parser = HTML::LinkExtor->new(undef, $url);
    $parser->parse($content);
    foreach my $linkarray($parser->links)
    {
         my ($elt_type, $attr_name, $attr_value) = @$linkarray;
         if ($elt_type eq 'a' && $attr_name eq 'href' && $attr_value =~ /\/$/ && $attr_value =~ /^$url/)
         {
         	push @links, Fetch($attr_value, \&ExtractLinks);
         }
	 elsif ($attr_value =~ /\.(xpi|dmg|exe|tar\.gz)$/)
	 #elsif ($attr_value =~ /\.(asc)$/) # small pgp files easier to test with
         {
         	push @links, $attr_value;
         }
    }
    return @links;
}

sub ExtractDate {
    my $content = shift;  
    $content    = sanitize($content);
    my $date    = str2time($content);

    if ($date) {
    	print "\tExtractDate($content) = $date\n";
        return $date;
    } else {
    	print "\tExtractDate($content) = ?\n";
	return undef;
    }
}

sub ExtractSig {
    my $content = shift; 
    my $url     = shift;
    my $sig = sha256_hex($content);
    print "\tExtractSig($url) = $sig\n";
    return $sig;
}

sub Fetch {
    my ($url, $sub) = @_; # Base url for mirror
    $|++; # unbuffer stdout to show progress

    print "\nGET $url: ";
    my $request = new HTTP::Request GET => "$url";
    my $result = $lua->request($request);
    my $code = $result->code();
    print "$code\n";

    if ($result->is_success && $code eq "200"){
       my $content = $result->content;
       if ($content) {
	    return $sub->($content, $url);
        } else {
            print "Unable to fetch $url, empty content returned.\n";
        }
    }

    return undef;
}
my @columns;
sub LoadMirrors {
    open(CSV, "<", "include/tor-mirrors.csv") or die "Cannot open tor-mirrors.csv: $!"; 
    my $line = <CSV>;
    chomp($line);
    @columns = split(/\s*,\s*/, $line);
    my @mirrors;
    while ($line = <CSV>)
    {
        chomp($line);
	my @values = split(/\s*,\s*/, $line);
	my %server;
	for (my $i = 0; $i < scalar(@columns); $i++)
	{
	    $server{$columns[$i]} = $values[$i] || '';
	}
	$server{updateDate} = str2time($server{updateDate}) if ($server{updateDate});
	push @mirrors, {%server};
    }
    close(CSV);
    return @mirrors;
}

sub DumpMirrors {
    my @m = @_;
    open(CSV, ">", "include/tor-mirrors.csv") or die "Cannot open tor-mirrors.csv: $!";
    print CSV join(", ", @columns) . "\n";
    foreach my $server(@m) {
	$server->{updateDate} = gmtime($server->{updateDate}) if ($server->{updateDate});
        print CSV join(", ", map($server->{$_}, @columns));
	print CSV "\n";
    }

    close(CSV);
}

my @m     = LoadMirrors();
my $count = scalar(@m);
print "We have a total of $count mirrors\n";
print "Fetching the last updated date for each mirror.\n";

my $tortime  = Fetch("https://www.torproject.org/project/trace/www-master.torproject.org", \&ExtractDate);
my @torfiles = Fetch("https://www.torproject.org/dist/", \&ExtractLinks); 
my %randomtorfiles;

for (1 .. 1)
{
	my $r = int(rand(scalar(@torfiles)));
	my $suffix = $torfiles[$r];
	$suffix =~ s/^https:\/\/www.torproject.org//;
	$randomtorfiles{$suffix} = Fetch($torfiles[$r], \&ExtractSig);
}

print "Using these files for sig matching:\n";
print join("\n", keys %randomtorfiles);
print "\n";

# Adjust official Tor time by out-of-date offset: number of days * seconds per day
$tortime -= 1 * 172800;
print "The official time for Tor is $tortime. \n";

for(my $server = 0; $server < scalar(@m); $server++) {
    foreach my $serverType('httpWebsiteMirror', 'httpsWebsiteMirror', 'ftpWebsiteMirror', 'httpDistMirror', 'httpsDistMirror')
    {
        if ($m[$server]->{$serverType}) {
            my $updateDate = Fetch("$m[$server]->{$serverType}/project/trace/www-master.torproject.org", \&ExtractDate);
    				      
            if ($updateDate) {
		$m[$server]->{updateDate} = $updateDate;
		$m[$server]->{sigMatched} = 1;
                foreach my $randomtorfile(keys %randomtorfiles) {
                    my $sig = Fetch("$m[$server]->{$serverType}/$randomtorfile", \&ExtractSig);
            	    if (!$sig) {
			$m[$server]->{sigMatched} = 0;
            	    	last;
		    } elsif ($sig ne $randomtorfiles{$randomtorfile}) {
			$m[$server]->{sigMatched} = 0;
            	    	last;
            	    }
		}
            }
	    last;
        }
    }
}

sub PrintServer {
     my $server = shift;
print OUT <<"END";
     \n<tr>\n
         <td>$server->{isoCC}</td>\n
         <td>$server->{orgName}</td>\n
         <td>Up to date</td>\n
END

     my %prettyNames = (
                        httpWebsiteMirror => "http",
                        httpsWebsiteMirror => "https",
                        ftpWebsiteMirror => "ftp",
                        rsyncWebsiteMirror => "rsync",
                        httpDistMirror => "http",
                        httpsDistMirror => "https",
                        rsyncDistMirror => "rsync", );

     foreach my $precious ( sort keys %prettyNames )
     {
        if ($server->{$precious}) {
            print OUT "    <td><a href=\"" . $server->{$precious} . "\">" .
                      "$prettyNames{$precious}</a></td>\n";
        } else { print OUT "    <td> - </td>\n"; }
     }

     print OUT "</tr>\n";
}


my $outFile = "include/mirrors-table.wmi";
open(OUT, "> $outFile") or die "Can't open $outFile: $!";

# Here's where we open a file and print some wml include goodness
# This is sorted from last known recent update to unknown update times
foreach my $server ( sort { $b->{updateDate} <=> $a->{updateDate} } grep {$_->{updateDate} && $_->{updateDate} > $tortime && $_->{sigMatched}} @m ) {
    PrintServer($server);
}

DumpMirrors(@m);

close(OUT);