1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
#!/usr/bin/perl
# Given a bunch of IP's figure out how fast you can look up their
# regions and then determine how good we are at this.
use locale;
use DBI;
use Data::Dumper;
use LWP;
use LWP::UserAgent;
use Config::Tiny;
$ua = LWP::UserAgent->new;
$ua->timeout(4);
$ua->agent("Gentoo Mirror Monitor/1.0");
my $DEBUG = 1;
my %products = ();
my %oss = ();
my $Config = Config::Tiny->read( 'db.conf' );
# Some db credentials
my $host = $Config->{database}->{host};
my $user = $Config->{database}->{user};
my $pass = $Config->{database}->{pass};
my $db = $Config->{database}->{db};
my $dbh = DBI->connect( "DBI:mysql:$db:$host",$user,$pass) or die "Connecting : $dbi::errstr\n";
$location_sql = qq{SELECT * FROM mirror_locations JOIN mirror_products USING (product_id) WHERE product_priority > 0 ORDER BY product_priority DESC};
#$mirror_sql = qq{SELECT * FROM mirror_mirrors WHERE mirror_active IN ('1') ORDER BY mirror_rating DESC, mirror_name};
$mirror_sql = qq{SELECT * FROM mirror_mirrors WHERE mirror_active IN ('1') ORDER BY RAND()};
$update_sql = qq{REPLACE mirror_location_mirror_map SET location_id=?,mirror_id=?,location_active=?};
my $location_sth = $dbh->prepare($location_sql);
my $mirror_sth = $dbh->prepare($mirror_sql);
my $update_sth = $dbh->prepare($update_sql);
# populate a product and os hash if we're debugging stuff
# this way we don't have to make too many selects against the DB
if ( $DEBUG ) {
print "Getting raw\n";
my $product_sql = qq{SELECT * FROM mirror_products};
my $oss_sql = qq{SELECT * FROM mirror_os};
my $product_sth = $dbh->prepare($product_sql);
$product_sth->execute();
while ( my $product = $product_sth->fetchrow_hashref() ) {
$products{$product->{product_id}} = $product->{product_name};
}
$oss_sth = $dbh->prepare($oss_sql);
$oss_sth->execute();
while ( my $os = $oss_sth->fetchrow_hashref() ) {
$oss{$os->{os_id}} = $os->{os_name};
}
}
# let's build the location information
print "Building location info\n";
$location_sth->execute();
my @locations = ();
while (my $location = $location_sth->fetchrow_hashref() ) {
push(@locations, $location);
}
print "Building location info\n";
$mirror_sth->execute();
while (my $mirror = $mirror_sth->fetchrow_hashref() ) {
print "Testing $mirror->{mirror_baseurl}\n";
foreach my $location (@locations) {
my $req = HTTP::Request->new(HEAD => $mirror->{mirror_baseurl} . $location->{location_path});
my $res;
#next if !($location->{location_path} =~ /2009/);
#next if !($location->{location_path} =~ /10.0\//);
$res = $ua->request($req);
if ( $res->{_rc} == 200 ) {
print "$mirror->{mirror_name} for $products{$location->{product_id}} on $oss{$location->{os_id}} is okay.\n" if $DEBUG;
$update_sth->execute($location->{location_id}, $mirror->{mirror_id}, '1');
}
else {
print "$mirror->{mirror_name} for $products{$location->{product_id}} on $oss{$location->{os_id}} FAILED.\n" if $DEBUG;
$update_sth->execute($location->{location_id}, $mirror->{mirror_id}, '0');
}
# content-type == text/plain hack here for Mac dmg's
#if ( $location->{os_id} == 4 ) {
# print "Testing: $products{$location->{product_id}} on $oss{$location->{os_id}} content-type: " .
# $res->{_headers}->{'content-type'} . "\n" if $DEBUG;
# if ( $res->{_headers}->{'content-type'} !~ /application\/octet-stream/ &&
# $res->{_headers}->{'content-type'} !~ /application\/x-apple-diskimage/ ) {
# print "$mirror->{mirror_name} for $products{$location->{product_id}} on $oss{$location->{os_id}} FAILED due to content-type mis-match.\n" if $DEBUG;
# $update_sth->execute($location->{location_id}, $mirror->{mirror_id}, '0');
# }
#}
}
}
|
GitWeb