diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | perl/db.dist.conf | 7 | ||||
| -rwxr-xr-x | perl/sentry.pl | 102 |
3 files changed, 110 insertions, 0 deletions
@@ -1,2 +1,3 @@ php/cfg/config.php php/cfg/config.php.orig +perl/db.conf diff --git a/perl/db.dist.conf b/perl/db.dist.conf new file mode 100644 index 0000000..0540d3b --- /dev/null +++ b/perl/db.dist.conf @@ -0,0 +1,7 @@ +# Some db credentials +[database] +host = localhost +user = username +pass = password +db = database + diff --git a/perl/sentry.pl b/perl/sentry.pl new file mode 100755 index 0000000..bc4788c --- /dev/null +++ b/perl/sentry.pl @@ -0,0 +1,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'); + # } + #} + } +} |