45d68837cab843dad265b502c8e0bcb1b8f5046e
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

1) #!/usr/bin/perl -w
2) use warnings;
3) use strict;
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

4) use Data::Dumper;
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

5) use LWP::Simple;
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

6) use HTML::LinkExtor;
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

7) use LWP;
8) use Date::Parse;
Jacob Appelbaum Removed dupe mirror entry,...

Jacob Appelbaum authored 15 years ago

9) use Date::Format;
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

10) use Digest::SHA qw(sha256_hex);
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

11) 
Jacob Appelbaum Add credit and some idea of...

Jacob Appelbaum authored 15 years ago

12) # This is Free Software (GPLv3)
13) # http://www.gnu.org/licenses/gpl-3.0.txt
14) 
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

15) print "Creating LWP agent ($LWP::VERSION)...\n";
16) my $lua = LWP::UserAgent->new(
17)     keep_alive => 1,
Jon@svn.torproject.org alter timout values (15 -> 30)

Jon@svn.torproject.org authored 14 years ago

18)     timeout => 30,
Jon@svn.torproject.org revert r21050

Jon@svn.torproject.org authored 14 years ago

19)     agent => "Tor MirrorCheck Agent"
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

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) }
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

33) sub ExtractLinks {
34)     my $content = shift; 
35)     my $url     = shift;
36)     my @links;
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

37) 
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

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)$/)
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

48) 	 #elsif ($attr_value =~ /\.(asc)$/) # small pgp files easier to test with
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

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) {
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

62)     	print "\tExtractDate($content) = $date\n";
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

63)         return $date;
64)     } else {
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

65)     	print "\tExtractDate($content) = ?\n";
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

66) 	return undef;
67)     }
68) }
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

69) 
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

70) sub ExtractSig {
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

71)     my $content = shift; 
72)     my $url     = shift;
73)     my $sig = sha256_hex($content);
74)     print "\tExtractSig($url) = $sig\n";
75)     return $sig;
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

76) }
77) 
78) sub Fetch {
79)     my ($url, $sub) = @_; # Base url for mirror
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

80)     $|++; # unbuffer stdout to show progress
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

81) 
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

82)     print "\nGET $url: ";
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

83)     my $request = new HTTP::Request GET => "$url";
84)     my $result = $lua->request($request);
Jacob Appelbaum Fix a date bug.

Jacob Appelbaum authored 15 years ago

85)     my $code = $result->code();
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

86)     print "$code\n";
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

87) 
Jacob Appelbaum Fix a date bug.

Jacob Appelbaum authored 15 years ago

88)     if ($result->is_success && $code eq "200"){
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

89)        my $content = $result->content;
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

90)        if ($content) {
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

91) 	    return $sub->($content, $url);
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

92)         } else {
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

93)             print "Unable to fetch $url, empty content returned.\n";
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

94)         }
95)     }
Jacob Appelbaum Fix a date bug.

Jacob Appelbaum authored 15 years ago

96) 
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

97)     return undef;
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

98) }
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

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) }
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

121) 
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

122) sub DumpMirrors {
123)     my @m = @_;
Andrew Lewman update the mirrors page, ha...

Andrew Lewman authored 10 years ago

124)     open(CSV, ">", "include/tor-mirrors.csv") or die "Cannot open tor-mirrors.csv: $!";
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

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";
Andrew Lewman add the cloudflare mirror,...

Andrew Lewman authored 11 years ago

130)     }
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

131) 
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

132)     close(CSV);
133) }
134) 
135) my @m     = LoadMirrors();
136) my $count = scalar(@m);
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

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

Andrew Lewman authored 10 years ago

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

Andrew Lewman authored 10 years ago

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);
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

154) print "\n";
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

155) 
Andrew Lewman update the mirrors page, ha...

Andrew Lewman authored 10 years ago

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

Andrew Lewman authored 11 years ago

157) $tortime -= 1 * 172800;
Andrew Lewman Change mirror script to use...

Andrew Lewman authored 14 years ago

158) print "The official time for Tor is $tortime. \n";
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

159) 
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

160) for(my $server = 0; $server < scalar(@m); $server++) {
161)     foreach my $serverType('httpWebsiteMirror', 'httpsWebsiteMirror', 'ftpWebsiteMirror', 'httpDistMirror', 'httpsDistMirror')
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

162)     {
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

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;
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

169)                 foreach my $randomtorfile(keys %randomtorfiles) {
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

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)             	    }
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

178) 		}
179)             }
180) 	    last;
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

181)         }
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

182)     }
Andrew Lewman new update mirrors script,...

Andrew Lewman authored 10 years ago

183) }
184) 
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

185) sub PrintServer {
186)      my $server = shift;
Jacob Appelbaum Removed dupe mirror entry,...

Jacob Appelbaum authored 15 years ago

187) print OUT <<"END";
188)      \n<tr>\n
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

189)          <td>$server->{isoCC}</td>\n
190)          <td>$server->{orgName}</td>\n
Andrew Lewman update the mirrors page, ha...

Andrew Lewman authored 10 years ago

191)          <td>Up to date</td>\n
Jacob Appelbaum Removed dupe mirror entry,...

Jacob Appelbaum authored 15 years ago

192) END
193) 
194)      my %prettyNames = (
195)                         httpWebsiteMirror => "http",
196)                         httpsWebsiteMirror => "https",
197)                         ftpWebsiteMirror => "ftp",
198)                         rsyncWebsiteMirror => "rsync",
199)                         httpDistMirror => "http",
200)                         httpsDistMirror => "https",
Andrew Lewman unicorns found by creep.im...

Andrew Lewman authored 10 years ago

201)                         rsyncDistMirror => "rsync", );
Jacob Appelbaum Removed dupe mirror entry,...

Jacob Appelbaum authored 15 years ago

202) 
203)      foreach my $precious ( sort keys %prettyNames )
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

204)      {
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

205)         if ($server->{$precious}) {
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

206)             print OUT "    <td><a href=\"" . $server->{$precious} . "\">" .
Jacob Appelbaum Removed dupe mirror entry,...

Jacob Appelbaum authored 15 years ago

207)                       "$prettyNames{$precious}</a></td>\n";
Jacob Appelbaum Add a perl script that auto...

Jacob Appelbaum authored 15 years ago

208)         } else { print OUT "    <td> - </td>\n"; }
209)      }
210) 
211)      print OUT "</tr>\n";
212) }
213) 
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

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
Andrew Lewman update mirror script again,...

Andrew Lewman authored 10 years ago

220) foreach my $server ( sort { $b->{updateDate} <=> $a->{updateDate} } grep {$_->{updateDate} && $_->{updateDate} > $tortime && $_->{sigMatched}} @m ) {
221)     PrintServer($server);
222) }
Andrew Lewman update the script some more...

Andrew Lewman authored 10 years ago

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