]> git.openstreetmap.org Git - dns.git/blob - bin/mkgeo
9ec063e0fc9148529d22ea44faaddb503d8d68de
[dns.git] / 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 $clusters = YAML::LoadFile("src/${source}");
16 my @servers;
17
18 # Initialise cluster details
19 while (my($name,$cluster) = each %$clusters)
20 {
21     if ($cluster->{servers})
22     {
23         $cluster->{bandwidth} = 0;
24
25         foreach my $server (@{$cluster->{servers}})
26         {
27             $server->{cluster} = $cluster;
28             $cluster->{bandwidth} = $cluster->{bandwidth} + $server->{bandwidth};
29
30             push @servers, $server;
31         }
32     }
33     else
34     {
35         my $server = {
36             cluster => $cluster,
37             pingdom => $cluster->{pingdom},
38             bandwidth => $cluster->{bandwidth},
39             ipv4 => $cluster->{ipv4},
40             ipv6 => $cluster->{ipv6}
41         };
42
43         $cluster->{servers} = [ $server ];
44
45         push @servers, $server;
46     }
47
48     $cluster->{name} = $name;
49
50     if ($ENV{PINGDOM_USERNAME} && $ENV{PINGDOM_PASSWORD})
51     {
52         $cluster->{status} = "down";
53     }
54     else
55     {
56         $cluster->{status} = "up";
57     }
58 }
59
60 # Initialise server details
61 foreach my $server (@servers)
62 {
63     if ($ENV{PINGDOM_USERNAME} && $ENV{PINGDOM_PASSWORD})
64     {
65         $server->{status} = "down";
66     }
67     else
68     {
69         $server->{status} = "up";
70     }
71 }
72
73 # If pingdom support is enabled then check which servers are up
74 if ($ENV{PINGDOM_USERNAME} && $ENV{PINGDOM_PASSWORD})
75 {
76     my $ua = LWP::UserAgent->new;
77
78     $ua->default_header("App-Key", "2cohi62u5haxvqmypk3ljqqrze1jufrh");
79     $ua->credentials("api.pingdom.com:443", "Pingdom API", $ENV{PINGDOM_USERNAME}, $ENV{PINGDOM_PASSWORD});
80
81     foreach my $server (@servers)
82     {
83         if (my $checkid = $server->{pingdom})
84         {
85             my $response = $ua->get("https://api.pingdom.com/api/2.0/checks/${checkid}");
86
87             if ($response->is_success)
88             {
89                 my $check = decode_json($response->content);
90
91                 $server->{status} = $check->{check}->{status};
92
93                 if ($server->{status} eq "up")
94                 {
95                     $server->{cluster}->{status} = "up";
96                 }
97                 else
98                 {
99                     $server->{cluster}->{bandwidth} = $server->{cluster}->{bandwidth} - $server->{bandwidth};
100                 }
101             }
102         }
103     }
104 }
105
106 # Initialise cluster details
107 while (my($name,$cluster) = each %$clusters)
108 {
109     $cluster->{bandwidth_limit} = $cluster->{bandwidth} * 1024 * 1024;
110     $cluster->{bandwidth_used} = 0;
111 }
112
113 my %countries = ();
114 my @mappings = ();
115
116 # Create a parser for the country database
117 my $countries = XML::TreeBuilder->new;
118
119 # Parse the country database
120 $countries->parsefile("lib/countries.xml");
121
122 # Load the per-country bandwidth details
123 my $bandwidth = YAML::LoadFile("bandwidth/${source}.yml");
124
125 # Fill in country table and work out which clusters each can use
126 foreach my $country ($countries->look_down("_tag" => "country"))
127 {
128     my $code = $country->look_down("_tag" => "countryCode")->as_text;
129     my $name = $country->look_down("_tag" => "countryName")->as_text;
130     my $population = $country->look_down("_tag" => "population")->as_text;
131     my $bandwidth = $bandwidth->{$code} || 0;
132     my $continent = $country->look_down("_tag" => "continent")->as_text;
133     my $west = $country->look_down("_tag" => "west")->as_text;
134     my $north = $country->look_down("_tag" => "north")->as_text;
135     my $east = $country->look_down("_tag" => "east")->as_text;
136     my $south = $country->look_down("_tag" => "south")->as_text;
137     my $lat = centre_lat( $south, $north );
138     my $lon = centre_lon( $west, $east );
139
140     $countries{$code} = {
141         code => $code, name => $name, continent => $continent,
142         bandwidth => $bandwidth, lat => $lat, lon => $lon
143     };
144
145     foreach my $cluster (values %$clusters)
146     {
147         my $match = match_country($cluster, $code, $continent);
148
149         if ($cluster->{status} eq "up" && $match ne "denied")
150         {
151             my $priority = $match eq "preferred" ? 20 : 10;
152             my $distance = distance($lat, $lon, $cluster->{lat}, $cluster->{lon});
153
154             push @mappings, {
155                 country => $countries{$code}, cluster => $cluster,
156                 priority => $priority, distance => $distance
157             };
158         }
159     }
160 }
161
162 # Discard the parsed country database
163 $countries->delete;
164
165 # Allocate each country to a cluster
166 allocate_clusters(\@mappings);
167
168 # If we failed to allocate every country then loop, increasing
169 # the bandwidth for each cluster by a little and retrying until
170 # we manage to allocate everything
171 while (grep { !exists($_->{cluster}) } values %countries)
172 {
173     # Clear any existing mappings of countries to clusters
174     foreach my $country (values %countries)
175     {
176         delete $country->{cluster};
177     }
178
179     # Reset bandwidth usage for clusters and increase limits by 10%
180     foreach my $cluster (values %$clusters)
181     {
182         $cluster->{bandwidth_used} = 0;
183         $cluster->{bandwidth_limit} = $cluster->{bandwidth_limit} * 1.1;
184     }
185
186     # Try the allocate again
187     allocate_clusters(\@mappings);
188 }
189
190 # Create JSON collection object
191 my @json;
192
193 # Open output files
194 my $zonefile = IO::File->new("> data/${zone}") || die "$!";
195 my $jsonfile = IO::File->new("> json/${zone}.json") || die "$!";
196
197 # Output details for each country
198 foreach my $country (values %countries)
199 {
200     my $cluster = $country->{cluster};
201     my $clon = $country->{lon};
202     my $clat = $country->{lat};
203     my $slon = $cluster->{lon};
204     my $slat = $cluster->{lat};
205
206     if ($clon > 0 && $slon < 0 && 360 + $slon - $clon < $clon - $slon)
207     {
208         $slon = $slon + 360;
209     }
210     elsif ($slon > 0 && $clon < 0 && 360 + $clon - $slon < $slon - $clon)
211     {
212         $clon = $clon + 360;
213     }
214
215     $zonefile->print("# $country->{name}\n");
216     $zonefile->print("C\L$country->{code}\E.${zone}:$cluster->{name}.${zone}:600\n");
217
218     push @json, {
219         type => "Feature",
220         geometry => {
221             type => "LineString",
222             coordinates => [ [ $clon, $clat ], [ $slon, $slat ] ]
223         },
224         properties => {
225             country => $country->{name},
226             server => $cluster->{name},
227             colour => $cluster->{colour}
228         }
229     };
230 }
231
232 # Output default records for IPs that can't be mapped to a country
233 foreach my $cluster (grep { $clusters->{$_}->{default} } keys %$clusters)
234 {
235     $zonefile->print("# Unknown countries\n");
236     $zonefile->print("Cxx.${zone}:${cluster}.${zone}:600\n");
237 }
238
239 $zonefile->print("# Servers\n");
240
241 # Output A records for each cluster
242 while (my($name,$cluster) = each %$clusters)
243 {
244     foreach my $server (@{$cluster->{servers}})
245     {
246         if ($server->{status} eq "up")
247         {
248             $zonefile->print("+${name}.${zone}:$server->{ipv4}:600\n");
249
250             if ($server->{ipv6})
251             {
252 #                $zonefile->print("3${name}.${zone}:$server->{ipv6}:600\n");
253             }
254         }
255     }
256 }
257
258 # Output the GeoJSON text
259 $jsonfile->print(encode_json(\@json));
260
261 # Close the output files
262 $jsonfile->close();
263 $zonefile->close();
264
265 exit 0;
266
267 #
268 # Find the centre value between two latitudes
269 #
270 sub centre_lat
271 {
272     my $south = shift;
273     my $north = shift;
274
275     return ( $south + $north ) / 2;
276 }
277
278 #
279 # Find the centre value between two longitudes
280 #
281 sub centre_lon
282 {
283     my $west = shift;
284     my $east = shift;
285     my $lon;
286
287     if ($west < $east)
288     {
289         $lon = ( $west + $east ) / 2;
290     }
291     else
292     {
293         $lon = ( $west + $east + 360 ) / 2;
294     }
295
296     $lon = $lon - 360 if $lon > 180;
297
298     return $lon
299 }
300
301 #
302 # Match a country against a cluster
303 #
304 sub match_country
305 {
306     my $cluster = shift;
307     my $country = shift;
308     my $continent = shift;
309     my $match;
310
311     if ($cluster->{preferred} &&
312         $cluster->{preferred}->{countries} &&
313         grep { $_ eq $country } @{$cluster->{preferred}->{countries}})
314     {
315         $match = "preferred";
316     }
317     elsif ($cluster->{preferred} &&
318            $cluster->{preferred}->{continents} &&
319            grep { $_ eq $continent } @{$cluster->{preferred}->{continents}})
320     {
321         $match = "preferred";
322     }
323     elsif ($cluster->{allowed} &&
324            $cluster->{allowed}->{countries} &&
325            grep { $_ eq $country } @{$cluster->{allowed}->{countries}})
326     {
327         $match = "allowed";
328     }
329     elsif ($cluster->{allowed} &&
330            $cluster->{allowed}->{continents} &&
331            grep { $_ eq $continent } @{$cluster->{allowed}->{continents}})
332     {
333         $match = "allowed";
334     }
335     elsif ($cluster->{denied} &&
336            $cluster->{denied}->{countries} &&
337            grep { $_ eq $country } @{$cluster->{preferred}->{countries}})
338     {
339         $match = "denied";
340     }
341     elsif ($cluster->{denied} &&
342            $cluster->{denied}->{continents} &&
343            grep { $_ eq $continent } @{$cluster->{preferred}->{continents}})
344     {
345         $match = "denied";
346     }
347     elsif ($cluster->{allowed})
348     {
349         $match = "denied";
350     }
351     else
352     {
353         $match = "allowed";
354     }
355
356     return $match;
357 }
358
359 #
360 # Compute the great circle distance between two points
361 #
362 sub distance
363 {
364     my $lat1 = deg2rad(shift);
365     my $lon1 = deg2rad(shift);
366     my $lat2 = deg2rad(shift);
367     my $lon2 = deg2rad(shift);
368
369     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
370 }
371
372 #
373 # Allocate each country to a cluster
374 #
375 sub allocate_clusters
376 {
377     my $mappings = shift;
378
379     # Loop over the mappings, trying to assign each country to the
380     # nearest cluster, but subject to the bandwidth limits
381     foreach my $mapping (sort {  $b->{priority} <=> $a->{priority} || $a->{distance} <=> $b->{distance} } @$mappings)
382     {
383         my $country = $mapping->{country};
384         my $cluster = $mapping->{cluster};
385
386         if (!exists($country->{cluster}) &&
387             $cluster->{bandwidth_used} + $country->{bandwidth} <= $cluster->{bandwidth_limit})
388         {
389             $country->{cluster} = $cluster;
390             $cluster->{bandwidth_used} = $cluster->{bandwidth_used} + $country->{bandwidth};
391         }
392     }
393
394     return;
395 }