bin/mkgeo

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use IO::File;
   7 use Math::Trig qw(deg2rad pip2 great_circle_distance);
   8 use JSON::XS;
   9 use LWP::UserAgent;
  10 use XML::Writer;
  11 use XML::TreeBuilder;
  12 use YAML;
  13
  14 my $source = shift @ARGV;
  15 my $zone = shift @ARGV;
  16 my $servers = YAML::LoadFile("src/${source}");
  17
  18 foreach my $server (values %$servers)
  19 {
  20     $server->{status} = "down";
  21 }
  22
  23 if ($ENV{PINGDOM_USERNAME} && $ENV{PINGDOM_PASSWORD})
  24 {
  25     my $ua = LWP::UserAgent->new;
  26
  27     $ua->default_header("App-Key", "2cohi62u5haxvqmypk3ljqqrze1jufrh");
  28     $ua->credentials("api.pingdom.com:443", "Pingdom API", $ENV{PINGDOM_USERNAME}, $ENV{PINGDOM_PASSWORD});
  29
  30     foreach my $server (values %$servers)
  31     {
  32         if (my $checkid = $server->{pingdom})
  33         {
  34             my $response = $ua->get("https://api.pingdom.com/api/2.0/checks/${checkid}");
  35
  36             if ($response->is_success)
  37             {
  38                 my $check = decode_json($response->content);
  39
  40                 $server->{status} = $check->{check}->{status};
  41             }
  42         }
  43     }
  44 }
  45
  46 my %countries = ();
  47
  48 my $countries = XML::TreeBuilder->new;
  49
  50 $countries->parsefile("lib/countries.xml");
  51
  52 foreach my $country ($countries->look_down("_tag" => "country"))
  53 {
  54     my $code = $country->look_down("_tag" => "countryCode")->as_text;
  55     my $name = $country->look_down("_tag" => "countryName")->as_text;
  56     my $continent = $country->look_down("_tag" => "continent")->as_text;
  57     my $west = $country->look_down("_tag" => "bBoxWest")->as_text;
  58     my $north = $country->look_down("_tag" => "bBoxNorth")->as_text;
  59     my $east = $country->look_down("_tag" => "bBoxEast")->as_text;
  60     my $south = $country->look_down("_tag" => "bBoxSouth")->as_text;
  61     my $lat = centre_lat( $south, $north );
  62     my $lon = centre_lon( $west, $east );
  63     my @servers;
  64
  65     foreach my $servername (keys %$servers)
  66     {
  67         my $server = $servers->{$servername};
  68         my $match = match_country($server, $code, $continent);
  69
  70         if ($match eq "preferred" || $match eq "allowed")
  71         {
  72             my $priority = $match eq "preferred" ? 20 : 10;
  73             my $distance = distance($lat, $lon, $server->{lat}, $server->{lon});
  74
  75             $priority = $priority * 10 if $server->{status} eq "up";
  76
  77 #            print STDERR "$servername is $match for $name with distance $distance\n";
  78
  79             push @servers, { name => $servername, priority => $priority, distance => $distance };
  80         }
  81     }
  82
  83     $countries{$code} = {
  84         code => $code, name => $name, continent => $continent,
  85         lat => $lat, lon => $lon, servers => \@servers
  86     };
  87 }
  88
  89 $countries->delete;
  90
  91 my $zonefile = IO::File->new("> data/${zone}") || die "$!";
  92 my $kmlfile = IO::File->new("> kml/${zone}.kml") || die "$!";
  93 my $kmlwriter = XML::Writer->new(OUTPUT => $kmlfile, ENCODING => 'utf-8');
  94
  95 $kmlwriter->xmlDecl();
  96 $kmlwriter->startTag("kml", "xmlns" => "http://www.opengis.net/kml/2.2");
  97 $kmlwriter->startTag("Document");
  98
  99 foreach my $country (values %countries)
 100 {
 101     my @servers = sort { $b->{priority} <=> $a->{priority} || $a->{distance} <=> $b->{distance} } @{$country->{servers}};
 102     my $server = $servers->{$servers[0]->{name}};
 103     my $clon = $country->{lon};
 104     my $clat = $country->{lat};
 105     my $slon = $server->{lon};
 106     my $slat = $server->{lat};
 107
 108     if ($clon > 0 && $slon < 0 && 360 + $slon - $clon < $clon - $slon)
 109     {
 110         $clon = $clon - 360;
 111     }
 112     elsif ($slon > 0 && $clon < 0 && 360 + $clon - $slon < $slon - $clon)
 113     {
 114         $slon = $slon - 360;
 115     }
 116
 117     $zonefile->print("C\L$country->{code}\E.${zone}:$servers[0]->{name}.${zone}:600\n");
 118
 119     $kmlwriter->startTag("Placemark");
 120     $kmlwriter->dataElement("name", $country->{name});
 121     $kmlwriter->startTag("LineString");
 122     $kmlwriter->dataElement("coordinates", "$clon,$clat $slon,$slat");
 123     $kmlwriter->endTag("LineString");
 124     $kmlwriter->endTag("Placemark");
 125 }
 126
 127 foreach my $server (grep { $servers->{$_}->{default} } keys %$servers)
 128 {
 129     $zonefile->print("Cxx.${zone}:${server}.${zone}:600\n");
 130 }
 131
 132 $kmlwriter->endTag("Document");
 133 $kmlwriter->endTag("kml");
 134 $kmlwriter->end();
 135
 136 $kmlfile->close();
 137 $zonefile->close();
 138
 139 exit 0;
 140
 141 sub centre_lat
 142 {
 143     my $south = shift;
 144     my $north = shift;
 145
 146     return ( $south + $north ) / 2;
 147 }
 148
 149 sub centre_lon
 150 {
 151     my $west = shift;
 152     my $east = shift;
 153     my $lon;
 154
 155     if ($west < $east)
 156     {
 157         $lon = ( $west + $east ) / 2;
 158     }
 159     else
 160     {
 161         $lon = ( $west + $east + 360 ) / 2;
 162     }
 163
 164     $lon = $lon - 360 if $lon > 180;
 165
 166     return $lon
 167 }
 168
 169 sub match_country
 170 {
 171     my $server = shift;
 172     my $country = shift;
 173     my $continent = shift;
 174     my $match;
 175
 176     if ($server->{preferred} &&
 177         $server->{preferred}->{countries} &&
 178         grep { $_ eq $country } @{$server->{preferred}->{countries}})
 179     {
 180         $match = "preferred";
 181     }
 182     elsif ($server->{preferred} &&
 183            $server->{preferred}->{continents} &&
 184            grep { $_ eq $continent } @{$server->{preferred}->{continents}})
 185     {
 186         $match = "preferred";
 187     }
 188     elsif ($server->{allowed} &&
 189            $server->{allowed}->{countries} &&
 190            grep { $_ eq $country } @{$server->{allowed}->{countries}})
 191     {
 192         $match = "allowed";
 193     }
 194     elsif ($server->{allowed} &&
 195            $server->{allowed}->{continents} &&
 196            grep { $_ eq $continent } @{$server->{allowed}->{continents}})
 197     {
 198         $match = "allowed";
 199     }
 200     elsif ($server->{allowed})
 201     {
 202         $match = "none";
 203     }
 204     else
 205     {
 206         $match = "allowed";
 207     }
 208
 209     return $match;
 210 }
 211
 212 sub distance
 213 {
 214     my $lat1 = deg2rad(shift);
 215     my $lon1 = deg2rad(shift);
 216     my $lat2 = deg2rad(shift);
 217     my $lon2 = deg2rad(shift);
 218
 219     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
 220 }