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::TreeBuilder;
  11 use YAML;
  12
  13 my $source = shift @ARGV;
  14 my $zone = shift @ARGV;
  15 my $servers = YAML::LoadFile("src/${source}");
  16
  17 # Initialise server details
  18 while (my($name,$server) = each %$servers)
  19 {
  20     $server->{name} = $name;
  21     $server->{bandwidth} = $server->{bandwidth} * 1024 * 1024;
  22
  23     if ($ENV{PINGDOM_USERNAME} && $ENV{PINGDOM_PASSWORD})
  24     {
  25         $server->{status} = "down";
  26     }
  27     else
  28     {
  29         $server->{status} = "up";
  30     }
  31 }
  32
  33 # If pingdom support is enabled then check which servers are up
  34 if ($ENV{PINGDOM_USERNAME} && $ENV{PINGDOM_PASSWORD})
  35 {
  36     my $ua = LWP::UserAgent->new;
  37
  38     $ua->default_header("App-Key", "2cohi62u5haxvqmypk3ljqqrze1jufrh");
  39     $ua->credentials("api.pingdom.com:443", "Pingdom API", $ENV{PINGDOM_USERNAME}, $ENV{PINGDOM_PASSWORD});
  40
  41     foreach my $server (values %$servers)
  42     {
  43         if (my $checkid = $server->{pingdom})
  44         {
  45             my $response = $ua->get("https://api.pingdom.com/api/2.0/checks/${checkid}");
  46
  47             if ($response->is_success)
  48             {
  49                 my $check = decode_json($response->content);
  50
  51                 $server->{status} = $check->{check}->{status};
  52             }
  53         }
  54     }
  55 }
  56
  57 my %countries = ();
  58 my @mappings = ();
  59
  60 # Create a parser for the country database
  61 my $countries = XML::TreeBuilder->new;
  62
  63 # Parse the country database
  64 $countries->parsefile("lib/countries.xml");
  65
  66 # Load the per-country bandwidth details
  67 my $bandwidth = YAML::LoadFile("bandwidth/${source}.yml");
  68
  69 # Fill in country table and work out which servers each can use
  70 foreach my $country ($countries->look_down("_tag" => "country"))
  71 {
  72     my $code = $country->look_down("_tag" => "countryCode")->as_text;
  73     my $name = $country->look_down("_tag" => "countryName")->as_text;
  74     my $population = $country->look_down("_tag" => "population")->as_text;
  75     my $bandwidth = $bandwidth->{$code} || 0;
  76     my $continent = $country->look_down("_tag" => "continent")->as_text;
  77     my $west = $country->look_down("_tag" => "west")->as_text;
  78     my $north = $country->look_down("_tag" => "north")->as_text;
  79     my $east = $country->look_down("_tag" => "east")->as_text;
  80     my $south = $country->look_down("_tag" => "south")->as_text;
  81     my $lat = centre_lat( $south, $north );
  82     my $lon = centre_lon( $west, $east );
  83
  84     $countries{$code} = {
  85         code => $code, name => $name, continent => $continent,
  86         bandwidth => $bandwidth, lat => $lat, lon => $lon
  87     };
  88
  89     foreach my $server (values %$servers)
  90     {
  91         my $match = match_country($server, $code, $continent);
  92
  93         if ($server->{status} eq "up" && $match ne "denied")
  94         {
  95             my $priority = $match eq "preferred" ? 20 : 10;
  96             my $distance = distance($lat, $lon, $server->{lat}, $server->{lon});
  97
  98             push @mappings, {
  99                 country => $countries{$code}, server => $server,
 100                 priority => $priority, distance => $distance
 101             };
 102         }
 103     }
 104 }
 105
 106 # Discard the parsed country database
 107 $countries->delete;
 108
 109 # Loop over the mappings, trying to assign each country to the
 110 # nearest server, but subject to the bandwidth limits;
 111 foreach my $mapping (sort {  $b->{priority} <=> $a->{priority} || $a->{distance} <=> $b->{distance} } @mappings)
 112 {
 113     my $country = $mapping->{country};
 114     my $server = $mapping->{server};
 115
 116     if ($country->{bandwidth} <= $server->{bandwidth} && !exists($country->{server}))
 117     {
 118         $country->{server} = $server;
 119         $server->{bandwidth} = $server->{bandwidth} - $country->{bandwidth};
 120     }
 121 }
 122
 123 # Loop over the mappings again, assigning anything that is left
 124 # as best we can, and allowing bandwidth limits to be exeeded
 125 foreach my $mapping (sort {  $b->{priority} <=> $a->{priority} || $a->{distance} <=> $b->{distance} } @mappings)
 126 {
 127     my $country = $mapping->{country};
 128     my $server = $mapping->{server};
 129
 130     $country->{server} = $server unless exists($country->{server});
 131 }
 132
 133 # Create JSON collection object
 134 my @json;
 135
 136 # Open output files
 137 my $zonefile = IO::File->new("> data/${zone}") || die "$!";
 138 my $jsonfile = IO::File->new("> json/${zone}.json") || die "$!";
 139
 140 # Output details for each country
 141 foreach my $country (values %countries)
 142 {
 143     my $server = $country->{server};
 144     my $clon = $country->{lon};
 145     my $clat = $country->{lat};
 146     my $slon = $server->{lon};
 147     my $slat = $server->{lat};
 148
 149     if ($clon > 0 && $slon < 0 && 360 + $slon - $clon < $clon - $slon)
 150     {
 151         $slon = $slon + 360;
 152     }
 153     elsif ($slon > 0 && $clon < 0 && 360 + $clon - $slon < $slon - $clon)
 154     {
 155         $clon = $clon + 360;
 156     }
 157
 158     $zonefile->print("# $country->{name}\n");
 159     $zonefile->print("C\L$country->{code}\E.${zone}:$server->{name}.${zone}:600\n");
 160
 161     push @json, {
 162         type => "Feature",
 163         geometry => {
 164             type => "LineString",
 165             coordinates => [ [ $clon, $clat ], [ $slon, $slat ] ]
 166         },
 167         properties => {
 168             country => $country->{name},
 169             server => $server->{name},
 170             colour => $server->{colour}
 171         }
 172     };
 173 }
 174
 175 # Output default records for IPs that can't be mapped to a country
 176 foreach my $server (grep { $servers->{$_}->{default} } keys %$servers)
 177 {
 178     $zonefile->print("Cxx.${zone}:${server}.${zone}:600\n");
 179 }
 180
 181 # Output the GeoJSON text
 182 $jsonfile->print(encode_json(\@json));
 183
 184 # Close the output files
 185 $jsonfile->close();
 186 $zonefile->close();
 187
 188 exit 0;
 189
 190 #
 191 # Find the centre value between two latitudes
 192 #
 193 sub centre_lat
 194 {
 195     my $south = shift;
 196     my $north = shift;
 197
 198     return ( $south + $north ) / 2;
 199 }
 200
 201 #
 202 # Find the centre value between two longitudes
 203 #
 204 sub centre_lon
 205 {
 206     my $west = shift;
 207     my $east = shift;
 208     my $lon;
 209
 210     if ($west < $east)
 211     {
 212         $lon = ( $west + $east ) / 2;
 213     }
 214     else
 215     {
 216         $lon = ( $west + $east + 360 ) / 2;
 217     }
 218
 219     $lon = $lon - 360 if $lon > 180;
 220
 221     return $lon
 222 }
 223
 224 #
 225 # Match a country against a server
 226 #
 227 sub match_country
 228 {
 229     my $server = shift;
 230     my $country = shift;
 231     my $continent = shift;
 232     my $match;
 233
 234     if ($server->{preferred} &&
 235         $server->{preferred}->{countries} &&
 236         grep { $_ eq $country } @{$server->{preferred}->{countries}})
 237     {
 238         $match = "preferred";
 239     }
 240     elsif ($server->{preferred} &&
 241            $server->{preferred}->{continents} &&
 242            grep { $_ eq $continent } @{$server->{preferred}->{continents}})
 243     {
 244         $match = "preferred";
 245     }
 246     elsif ($server->{allowed} &&
 247            $server->{allowed}->{countries} &&
 248            grep { $_ eq $country } @{$server->{allowed}->{countries}})
 249     {
 250         $match = "allowed";
 251     }
 252     elsif ($server->{allowed} &&
 253            $server->{allowed}->{continents} &&
 254            grep { $_ eq $continent } @{$server->{allowed}->{continents}})
 255     {
 256         $match = "allowed";
 257     }
 258     elsif ($server->{denied} &&
 259         $server->{denied}->{countries} &&
 260         grep { $_ eq $country } @{$server->{preferred}->{countries}})
 261     {
 262         $match = "denied";
 263     }
 264     elsif ($server->{denied} &&
 265            $server->{denied}->{continents} &&
 266            grep { $_ eq $continent } @{$server->{preferred}->{continents}})
 267     {
 268         $match = "denied";
 269     }
 270     elsif ($server->{allowed})
 271     {
 272         $match = "denied";
 273     }
 274     else
 275     {
 276         $match = "allowed";
 277     }
 278
 279     return $match;
 280 }
 281
 282 #
 283 # Compute the great circle distance between two points
 284 #
 285 sub distance
 286 {
 287     my $lat1 = deg2rad(shift);
 288     my $lon1 = deg2rad(shift);
 289     my $lat2 = deg2rad(shift);
 290     my $lon2 = deg2rad(shift);
 291
 292     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
 293 }