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 "\tExtractDate($content) = $date\n";

63)         return $date;
64)     } else {

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

66) 	return undef;
67)     }
68) }

69) 

70) sub ExtractSig {

71)     my $content = shift; 
72)     my $url     = shift;
73)     my $sig = sha256_hex($content);
74)     print "\tExtractSig($url) = $sig\n";
75)     return $sig;

76) }
77) 
78) sub Fetch {
79)     my ($url, $sub) = @_; # Base url for mirror

80)     $|++; # unbuffer stdout to show progress

81) 

82)     print "\nGET $url: ";

83)     my $request = new HTTP::Request GET => "$url";
84)     my $result = $lua->request($request);

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

86)     print "$code\n";

87) 

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

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

90)        if ($content) {

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

92)         } else {

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

94)         }
95)     }

96) 

97)     return undef;

98) }

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

121) 

122) sub DumpMirrors {
123)     my @m = @_;

124)     open(CSV, ">", "include/tor-mirrors.csv") or die "Cannot open tor-mirrors.csv: $!";

125)     print CSV join(", ", @columns) . "\n";
126)     foreach my $server(@m) {
127) 	$server->{updateDate} = gmtime($server->{updateDate}) if ($server->{updateDate});
128)         print CSV join(", ", map($server->{$_}, @columns));
129) 	print CSV "\n";

130)     }

131) 

132)     close(CSV);
133) }
134) 
135) my @m     = LoadMirrors();
136) my $count = scalar(@m);

137) print "We have a total of $count mirrors\n";
138) print "Fetching the last updated date for each mirror.\n";
139) 

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

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

154) print "\n";

155) 

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

157) $tortime -= 1 * 172800;

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

159) 

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

162)     {

163)         if ($m[$server]->{$serverType}) {
164)             my $updateDate = Fetch("$m[$server]->{$serverType}/project/trace/www-master.torproject.org", \&ExtractDate);
165)     				      
166)             if ($updateDate) {
167) 		$m[$server]->{updateDate} = $updateDate;
168) 		$m[$server]->{sigMatched} = 1;

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

170)                     my $sig = Fetch("$m[$server]->{$serverType}/$randomtorfile", \&ExtractSig);
171)             	    if (!$sig) {
172) 			$m[$server]->{sigMatched} = 0;
173)             	    	last;
174) 		    } elsif ($sig ne $randomtorfiles{$randomtorfile}) {
175) 			$m[$server]->{sigMatched} = 0;
176)             	    	last;
177)             	    }

178) 		}
179)             }
180) 	    last;

181)         }

182)     }

183) }
184) 

185) sub PrintServer {
186)      my $server = shift;

187) print OUT <<"END";
188)      \n<tr>\n

189)          <td>$server->{isoCC}</td>\n
190)          <td>$server->{orgName}</td>\n

191)          <td>Up to date</td>\n

192) END
193) 
194)      my %prettyNames = (
195)                         httpWebsiteMirror => "http",
196)                         httpsWebsiteMirror => "https",
197)                         ftpWebsiteMirror => "ftp",
198)                         rsyncWebsiteMirror => "rsync",
199)                         httpDistMirror => "http",
200)                         httpsDistMirror => "https",

201)                         rsyncDistMirror => "rsync", );

202) 
203)      foreach my $precious ( sort keys %prettyNames )

204)      {

205)         if ($server->{$precious}) {

206)             print OUT "    <td><a href=\"" . $server->{$precious} . "\">" .

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

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

214) 
215) my $outFile = "include/mirrors-table.wmi";
216) open(OUT, "> $outFile") or die "Can't open $outFile: $!";
217) 
218) # Here's where we open a file and print some wml include goodness
219) # This is sorted from last known recent update to unknown update times

220) foreach my $server ( sort { $b->{updateDate} <=> $a->{updateDate} } grep {$_->{updateDate} && $_->{updateDate} > $tortime && $_->{sigMatched}} @m ) {
221)     PrintServer($server);
222) }

223) 
224) DumpMirrors(@m);
225)