aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to 'perl/sentry.pl')
-rwxr-xr-xperl/sentry.pl102
1 files changed, 102 insertions, 0 deletions
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');
+ # }
+ #}
+ }
+}