Gentoo Archives: gentoo-commits

From: Brian Evans <grknight@g.o>
To: gentoo-commits@l.g.o
Subject: [gentoo-commits] proj/bouncer:master commit in: perl/, /
Date: Tue, 30 Jan 2018 20:19:07
Message-Id: 1517343490.494c353d1b7cbdc66219fbdddc93a254a10d0b29.grknight@gentoo
1 commit: 494c353d1b7cbdc66219fbdddc93a254a10d0b29
2 Author: Brian Evans <grknight <AT> gentoo <DOT> org>
3 AuthorDate: Tue Jan 30 20:18:10 2018 +0000
4 Commit: Brian Evans <grknight <AT> gentoo <DOT> org>
5 CommitDate: Tue Jan 30 20:18:10 2018 +0000
6 URL: https://gitweb.gentoo.org/proj/bouncer.git/commit/?id=494c353d
7
8 Add sentry.pl with config moved to its own file
9
10 .gitignore | 1 +
11 perl/db.dist.conf | 7 ++++
12 perl/sentry.pl | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
13 3 files changed, 110 insertions(+)
14
15 diff --git a/.gitignore b/.gitignore
16 index 3a7b40c..1dfa684 100644
17 --- a/.gitignore
18 +++ b/.gitignore
19 @@ -1,2 +1,3 @@
20 php/cfg/config.php
21 php/cfg/config.php.orig
22 +perl/db.conf
23
24 diff --git a/perl/db.dist.conf b/perl/db.dist.conf
25 new file mode 100644
26 index 0000000..0540d3b
27 --- /dev/null
28 +++ b/perl/db.dist.conf
29 @@ -0,0 +1,7 @@
30 +# Some db credentials
31 +[database]
32 +host = localhost
33 +user = username
34 +pass = password
35 +db = database
36 +
37
38 diff --git a/perl/sentry.pl b/perl/sentry.pl
39 new file mode 100755
40 index 0000000..bc4788c
41 --- /dev/null
42 +++ b/perl/sentry.pl
43 @@ -0,0 +1,102 @@
44 +#!/usr/bin/perl
45 +
46 +# Given a bunch of IP's figure out how fast you can look up their
47 +# regions and then determine how good we are at this.
48 +
49 +use locale;
50 +use DBI;
51 +use Data::Dumper;
52 +use LWP;
53 +use LWP::UserAgent;
54 +use Config::Tiny;
55 +
56 +$ua = LWP::UserAgent->new;
57 +$ua->timeout(4);
58 +$ua->agent("Gentoo Mirror Monitor/1.0");
59 +
60 +my $DEBUG = 1;
61 +my %products = ();
62 +my %oss = ();
63 +my $Config = Config::Tiny->read( 'db.conf' );
64 +
65 +# Some db credentials
66 +my $host = $Config->{database}->{host};
67 +my $user = $Config->{database}->{user};
68 +my $pass = $Config->{database}->{pass};
69 +my $db = $Config->{database}->{db};
70 +
71 +my $dbh = DBI->connect( "DBI:mysql:$db:$host",$user,$pass) or die "Connecting : $dbi::errstr\n";
72 +$location_sql = qq{SELECT * FROM mirror_locations JOIN mirror_products USING (product_id) WHERE product_priority > 0 ORDER BY product_priority DESC};
73 +#$mirror_sql = qq{SELECT * FROM mirror_mirrors WHERE mirror_active IN ('1') ORDER BY mirror_rating DESC, mirror_name};
74 +$mirror_sql = qq{SELECT * FROM mirror_mirrors WHERE mirror_active IN ('1') ORDER BY RAND()};
75 +$update_sql = qq{REPLACE mirror_location_mirror_map SET location_id=?,mirror_id=?,location_active=?};
76 +
77 +my $location_sth = $dbh->prepare($location_sql);
78 +my $mirror_sth = $dbh->prepare($mirror_sql);
79 +my $update_sth = $dbh->prepare($update_sql);
80 +
81 +# populate a product and os hash if we're debugging stuff
82 +# this way we don't have to make too many selects against the DB
83 +if ( $DEBUG ) {
84 + print "Getting raw\n";
85 + my $product_sql = qq{SELECT * FROM mirror_products};
86 + my $oss_sql = qq{SELECT * FROM mirror_os};
87 +
88 + my $product_sth = $dbh->prepare($product_sql);
89 + $product_sth->execute();
90 +
91 + while ( my $product = $product_sth->fetchrow_hashref() ) {
92 + $products{$product->{product_id}} = $product->{product_name};
93 + }
94 +
95 + $oss_sth = $dbh->prepare($oss_sql);
96 + $oss_sth->execute();
97 +
98 + while ( my $os = $oss_sth->fetchrow_hashref() ) {
99 + $oss{$os->{os_id}} = $os->{os_name};
100 + }
101 +}
102 +
103 +# let's build the location information
104 +print "Building location info\n";
105 +$location_sth->execute();
106 +my @locations = ();
107 +
108 +while (my $location = $location_sth->fetchrow_hashref() ) {
109 + push(@locations, $location);
110 +}
111 +
112 +print "Building location info\n";
113 +$mirror_sth->execute();
114 +
115 +while (my $mirror = $mirror_sth->fetchrow_hashref() ) {
116 + print "Testing $mirror->{mirror_baseurl}\n";
117 +
118 + foreach my $location (@locations) {
119 + my $req = HTTP::Request->new(HEAD => $mirror->{mirror_baseurl} . $location->{location_path});
120 + my $res;
121 + #next if !($location->{location_path} =~ /2009/);
122 + #next if !($location->{location_path} =~ /10.0\//);
123 + $res = $ua->request($req);
124 +
125 + if ( $res->{_rc} == 200 ) {
126 + print "$mirror->{mirror_name} for $products{$location->{product_id}} on $oss{$location->{os_id}} is okay.\n" if $DEBUG;
127 + $update_sth->execute($location->{location_id}, $mirror->{mirror_id}, '1');
128 + }
129 + else {
130 + print "$mirror->{mirror_name} for $products{$location->{product_id}} on $oss{$location->{os_id}} FAILED.\n" if $DEBUG;
131 + $update_sth->execute($location->{location_id}, $mirror->{mirror_id}, '0');
132 + }
133 +
134 + # content-type == text/plain hack here for Mac dmg's
135 + #if ( $location->{os_id} == 4 ) {
136 + # print "Testing: $products{$location->{product_id}} on $oss{$location->{os_id}} content-type: " .
137 + # $res->{_headers}->{'content-type'} . "\n" if $DEBUG;
138 + # if ( $res->{_headers}->{'content-type'} !~ /application\/octet-stream/ &&
139 + # $res->{_headers}->{'content-type'} !~ /application\/x-apple-diskimage/ ) {
140 + # print "$mirror->{mirror_name} for $products{$location->{product_id}} on $oss{$location->{os_id}} FAILED due to content-type mis-match.\n" if $DEBUG;
141 + # $update_sth->execute($location->{location_id}, $mirror->{mirror_id}, '0');
142 + # }
143 + #}
144 + }
145 +}