tor-webwml.git

1) #!/usr/bin/perl -w
2) use warnings;
3) use strict;

4) use Data::Dumper;

5) use LWP::Simple;

6) use HTML::LinkExtor;

7) use LWP;
8) use Date::Parse;

9) use Date::Format;

10) use Digest::SHA qw(sha256_hex);

11) 

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

15) print "Creating LWP agent ($LWP::VERSION)...\n";
16) my $lua = LWP::UserAgent->new(
17)     keep_alive => 1,

18)     timeout => 30,

19)     agent => "Tor MirrorCheck Agent"

20) );
21) 
22) sub sanitize {
23)     my $taintedData = shift;
24)     my $cleanedData;
25)     my $whitelist = '-a-zA-Z0-9: +';
26) 
27)     # clean the data, return cleaned data
28)     $taintedData =~ s/[^$whitelist]//go;
29)     $cleanedData = $taintedData;
30) 
31)     return $cleanedData;
32) }

33) sub ExtractLinks {
34)     my $content = shift; 
35)     my $url     = shift;
36)     my @links;

37) 

38)     my $parser = HTML::LinkExtor->new(undef, $url);
39)     $parser->parse($content);
40)     foreach my $linkarray($parser->links)
41)     {
42)          my ($elt_type, $attr_name, $attr_value) = @$linkarray;
43)          if ($elt_type eq 'a' && $attr_name eq 'href' && $attr_value =~ /\/$/ && $attr_value =~ /^$url/)
44)          {
45)          	push @links, Fetch($attr_value, \&ExtractLinks);
46)          }
47) 	 elsif ($attr_value =~ /\.(xpi|dmg|exe|tar\.gz)$/)

48) 	 #elsif ($attr_value =~ /\.(asc)$/) # small pgp files easier to test with

49)          {
50)          	push @links, $attr_value;
51)          }
52)     }
53)     return @links;
54) }
55) 
56) sub ExtractDate {
57)     my $content = shift;  
58)     $content    = sanitize($content);
59)     my $date    = str2time($content);
60) 
61)     if ($date) {

62)     	print "ExtractDate($content) = $date\n";

63)         return $date;
64)     } else {

65)     	print "ExtractDate($content) = ?\n";

66) 	return undef;
67)     }
68) }

69) 

70) sub ExtractSig {
71)     my $content = shift;
72)     return sha256_hex($content); 
73) }
74) 
75) sub Fetch {
76)     my ($url, $sub) = @_; # Base url for mirror

77) 
78)     my $request = new HTTP::Request GET => "$url";
79)     my $result = $lua->request($request);

80)     my $code = $result->code();

81)     print "\nGET $url: $code\n";

82) 

83)     if ($result->is_success && $code eq "200"){

84)        my $content = $result->content;

85)        if ($content) {

86) 	    return $sub->($content, $url);

87)         } else {

88)             print "Unable to fetch $url, empty content returned.\n";

89)         }
90)     }

91) 

92)     return undef;

93) }

94) my @columns;
95) sub LoadMirrors {
96)     open(CSV, "<", "include/tor-mirrors.csv") or die "Cannot open tor-mirrors.csv: $!"; 
97)     my $line = <CSV>;
98)     chomp($line);
99)     @columns = split(/\s*,\s*/, $line);
100)     my @mirrors;
101)     while ($line = <CSV>)
102)     {
103)         chomp($line);
104) 	my @values = split(/\s*,\s*/, $line);
105) 	my %server;
106) 	for (my $i = 0; $i < scalar(@columns); $i++)
107) 	{
108) 	    $server{$columns[$i]} = $values[$i] || '';
109) 	}
110) 	$server{updateDate} = str2time($server{updateDate}) if ($server{updateDate});
111) 	push @mirrors, {%server};
112)     }
113)     close(CSV);
114)     return @mirrors;
115) }

116) 

117) sub DumpMirrors {
118)     my @m = @_;
119)     open(CSV, ">", "tor-mirrors.csv") or die "Cannot open tor-mirrors.csv: $!";
120)     print CSV join(", ", @columns) . "\n";
121)     foreach my $server(@m) {
122) 	$server->{updateDate} = gmtime($server->{updateDate}) if ($server->{updateDate});
123)         print CSV join(", ", map($server->{$_}, @columns));
124) 	print CSV "\n";

125)     }

126) 

127)     close(CSV);
128) }
129) 
130) my @m     = LoadMirrors();
131) my $count = scalar(@m);

132) print "We have a total of $count mirrors\n";
133) print "Fetching the last updated date for each mirror.\n";
134) 

135) my $tortime  = Fetch("https://www.torproject.org/project/trace/www-master.torproject.org", \&ExtractDate);

136) my @torfiles = Fetch("https://www.torproject.org/dist/", \&ExtractLinks); 
137) my %randomtorfiles;
138) 
139) for (1 .. 1)
140) {
141) 	my $r = int(rand(scalar(@torfiles)));
142) 	my $suffix = $torfiles[$r];
143) 	$suffix =~ s/^https:\/\/www.torproject.org//;
144) 	$randomtorfiles{$suffix} = Fetch($torfiles[$r], \&ExtractSig);
145) }
146) 
147) print "Using these files for sig matching:\n";
148) print join("\n", keys %randomtorfiles);
149) 

150) # Adjust official Tor time by out-of-date offset: number of days * seconds per day

151) $tortime -= 1 * 172800;

152) print "The official time for Tor is $tortime. \n";

153) 

154) for(my $server = 0; $server < scalar(@m); $server++) {
155)     foreach my $serverType('httpWebsiteMirror', 'httpsWebsiteMirror', 'ftpWebsiteMirror', 'httpDistMirror', 'httpsDistMirror')

156)     {

157)         if ($m[$server]->{$serverType}) {
158)             my $updateDate = Fetch("$m[$server]->{$serverType}/project/trace/www-master.torproject.org", \&ExtractDate);
159)     				      
160)             if ($updateDate) {
161) 		$m[$server]->{updateDate} = $updateDate;
162) 		$m[$server]->{sigMatched} = 1;

163)                 foreach my $randomtorfile(keys %randomtorfiles) {

164)                     my $sig = Fetch("$m[$server]->{$serverType}/$randomtorfile", \&ExtractSig);
165)             	    if (!$sig) {
166) 		        print STDERR "Unreadable $randomtorfile on $m[$server]->{$serverType}";
167) 			$m[$server]->{sigMatched} = 0;
168)             	    	last;
169) 		    } elsif ($sig ne $randomtorfiles{$randomtorfile}) {
170) 			$m[$server]->{sigMatched} = 0;
171) 		        print STDERR "Sig mismatch of $randomtorfile on $m[$server]->{$serverType}";
172)             	    	last;
173)             	    }

174) 		}
175)             }
176) 	    last;

177)         }

178)     }

179) }
180) 

181) sub PrintServer {
182)      my $server = shift;

183)      my $time;

184)      if ( $server->{'updateDate'} ) {
185) 	  if ( $server->{'updateDate'} > $tortime ) {

186) 	    $time = "Up to date";

187) 	  } else { $time = "DO NOT USE. Out of date."; }

188)      } else { $time = "Unknown"; }

189) print OUT <<"END";
190)      \n<tr>\n

191)          <td>$server->{'isoCC'}</td>\n
192)          <td>$server->{'orgName'}</td>\n

193)          <td>$time</td>\n
194) END
195) 
196)      my %prettyNames = (
197)                         httpWebsiteMirror => "http",
198)                         httpsWebsiteMirror => "https",
199)                         ftpWebsiteMirror => "ftp",
200)                         rsyncWebsiteMirror => "rsync",
201)                         httpDistMirror => "http",
202)                         httpsDistMirror => "https",

203)                         rsyncDistMirror => "rsync", );

204) 
205)      foreach my $precious ( sort keys %prettyNames )

206)      {

207)         if ($server->{"$precious"}) {
208)             print OUT "    <td><a href=\"" . $server->{$precious} . "\">" .

209)                       "$prettyNames{$precious}</a></td>\n";

210)         } else { print OUT "    <td> - </td>\n"; }
211)      }
212) 
213)      print OUT "</tr>\n";
214) }
215) 

216) 
217) my $outFile = "include/mirrors-table.wmi";
218) open(OUT, "> $outFile") or die "Can't open $outFile: $!";
219) 
220) # Here's where we open a file and print some wml include goodness
221) # This is sorted from last known recent update to unknown update times
222) foreach my $server ( sort { $b->{'updateDate'} <=> $a->{'updateDate'}} grep {$_->{updateDate} && $_->{sigMatched}} @m ) {
223)     PrintServer($server);
224) }
225) foreach my $server ( grep {!$_->{updateDate} || !$_->{sigMatched}} @m ) {
226)     PrintServer($server);
227) }
228) 
229) DumpMirrors(@m);
230)