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
 113     $zonefile->print("C\L$country->{code}\E.${zone}:$servers[0]->{name}.${zone}:600\n");
 114
 115     $kmlwriter->startTag("Placemark");
 116     $kmlwriter->dataElement("name", $country->{name});
 117     $kmlwriter->startTag("LineString");
 118     $kmlwriter->dataElement("coordinates", "$clon,$clat $slon,$slat");
 119     $kmlwriter->endTag("LineString");
 120     $kmlwriter->endTag("Placemark");
 121 }
 122
 123 foreach my $server (grep { $servers->{$_}->{default} } keys %$servers)
 124 {
 125     $zonefile->print("Cxx.${zone}:${server}.${zone}:600\n");
 126 }
 127
 128 $kmlwriter->endTag("Document");
 129 $kmlwriter->endTag("kml");
 130 $kmlwriter->end();
 131
 132 $kmlfile->close();
 133 $zonefile->close();
 134
 135 exit 0;
 136
 137 sub centre_lat
 138 {
 139     my $south = shift;
 140     my $north = shift;
 141
 142     return ( $south + $north ) / 2;
 143 }
 144
 145 sub centre_lon
 146 {
 147     my $west = shift;
 148     my $east = shift;
 149     my $lon;
 150
 151     if ($west < $east)
 152     {
 153         $lon = ( $west + $east ) / 2;
 154     }
 155     else
 156     {
 157         $lon = ( $west + $east + 360 ) / 2;
 158     }
 159
 160     $lon = $lon - 360 if $lon > 180;
 161
 162     return $lon
 163 }
 164
 165 sub match_country
 166 {
 167     my $server = shift;
 168     my $country = shift;
 169     my $continent = shift;
 170     my $match;
 171
 172     if ($server->{preferred} &&
 173         $server->{preferred}->{countries} &&
 174         grep { $_ eq $country } @{$server->{preferred}->{countries}})
 175     {
 176         $match = "preferred";
 177     }
 178     elsif ($server->{preferred} &&
 179            $server->{preferred}->{continents} &&
 180            grep { $_ eq $continent } @{$server->{preferred}->{continents}})
 181     {
 182         $match = "preferred";
 183     }
 184     elsif ($server->{allowed} &&
 185            $server->{allowed}->{countries} &&
 186            grep { $_ eq $country } @{$server->{allowed}->{countries}})
 187     {
 188         $match = "allowed";
 189     }
 190     elsif ($server->{allowed} &&
 191            $server->{allowed}->{continents} &&
 192            grep { $_ eq $continent } @{$server->{allowed}->{continents}})
 193     {
 194         $match = "allowed";
 195     }
 196     elsif ($server->{allowed})
 197     {
 198         $match = "none";
 199     }
 200     else
 201     {
 202         $match = "allowed";
 203     }
 204
 205     return $match;
 206 }
 207
 208 sub distance
 209 {
 210     my $lat1 = deg2rad(shift);
 211     my $lon1 = deg2rad(shift);
 212     my $lat2 = deg2rad(shift);
 213     my $lon2 = deg2rad(shift);
 214
 215     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
 216 }