]> git.openstreetmap.org Git - dns.git/blob - bin/mkgeo
Merge remote-tracking branch 'github/pull/14'
[dns.git] / bin / mkgeo
1 #!/usr/bin/perl
2
3 use v5.12;
4
5 use strict;
6 use warnings;
7
8 use IO::File;
9 use Math::Trig qw(deg2rad pip2 great_circle_distance);
10 use JSON::XS;
11 use LWP::UserAgent;
12 use YAML::XS qw(LoadFile DumpFile);
13
14 my $originfile = shift @ARGV;
15 my $clusterfile = shift @ARGV;
16 my $zone = shift @ARGV;
17 my $targetoriginfile = shift @ARGV;
18 my $origins = LoadFile($originfile);
19 my $clusters = LoadFile($clusterfile);
20 my $gdnsname = shift @ARGV;
21 my @servers;
22
23 # Initialise cluster details
24 while (my($name,$cluster) = each %$clusters)
25 {
26     if ($cluster->{servers})
27     {
28         $cluster->{requests} = 0;
29
30         foreach my $server (@{$cluster->{servers}})
31         {
32             $server->{cluster} = $cluster;
33             $cluster->{requests} = $cluster->{requests} + $server->{requests};
34
35             push @servers, $server;
36         }
37     }
38     else
39     {
40         my $server = {
41             cluster => $cluster,
42             statuscake => $cluster->{statuscake},
43             requests => $cluster->{requests},
44             cname => $cluster->{cname},
45             ipv4 => $cluster->{ipv4},
46             ipv6 => $cluster->{ipv6}
47         };
48
49         $cluster->{servers} = [ $server ];
50
51         push @servers, $server;
52     }
53
54     $cluster->{name} = $name;
55     $cluster->{status} = "down";
56 }
57
58 # Initialise server details
59 foreach my $server (@servers)
60 {
61     $server->{status} = "up";
62 }
63
64 # If statuscake support is enabled then check which servers are up
65 if ($ENV{STATUSCAKE_USERNAME} && $ENV{STATUSCAKE_APIKEY})
66 {
67     my $ua = LWP::UserAgent->new;
68     my $cache;
69
70     $ua->agent("mkgeo/1.0");
71     $ua->default_header("Username", $ENV{STATUSCAKE_USERNAME});
72     $ua->default_header("API", $ENV{STATUSCAKE_APIKEY});
73
74     if (-f "statuscake.yml")
75     {
76         $cache = LoadFile("statuscake.yml");
77     }
78     else
79     {
80         $cache = {};
81     }
82
83     my $response = $ua->get("https://app.statuscake.com/API/Tests/");
84
85     if ($response->is_success)
86     {
87         my $tests = decode_json($response->content);
88
89         foreach my $test (@$tests)
90         {
91             my $testid = $test->{TestID};
92
93             if ($test->{Status} eq "Up" && !$test->{Paused})
94             {
95                 $cache->{$testid} = "up";
96             }
97             else
98             {
99                 $cache->{$testid} = "down";
100             }
101         }
102     }
103
104     foreach my $server (@servers)
105     {
106         if (my $testids = $server->{statuscake})
107         {
108             $server->{status} = "up";
109
110             for my $testid (@$testids)
111             {
112                 my $testresult = $cache->{$testid} || "down";
113
114                 $server->{status} = "down" if $testresult eq "down";
115             }
116         }
117         else
118         {
119             $server->{status} = "down";
120         }
121     }
122
123     DumpFile("statuscake-$$.yml", $cache);
124     rename("statuscake-$$.yml", "statuscake.yml");
125 }
126
127 # Mark a cluster as up if any servers are up
128 foreach my $server (@servers)
129 {
130     if ($server->{status} eq "up")
131     {
132         $server->{cluster}->{status} = "up";
133     }
134     else
135     {
136         $server->{cluster}->{requests} = $server->{cluster}->{requests} - $server->{requests};
137     }
138 }
139
140 # Create target origins object
141 my $targetorigins = {};
142
143 # Initialise cluster details
144 while (my($name,$cluster) = each %$clusters)
145 {
146     $cluster->{requests_limit} = $cluster->{requests};
147     $cluster->{requests_used} = 0;
148
149     next if $cluster->{global};
150
151     $targetorigins->{$cluster->{name}} = {
152         code => $cluster->{name},
153         name => $cluster->{name},
154         lat => $cluster->{lat},
155         lon => $cluster->{lon},
156         requests => 0
157     };
158 }
159
160 my @mappings = ();
161
162 # Scan origins and work out which clusters each can use
163 foreach my $origin (values %$origins)
164 {
165     foreach my $cluster (values %$clusters)
166     {
167         my $match = match_origin($cluster, $origin);
168
169         if ($cluster->{status} eq "up" && $match ne "denied")
170         {
171             my $priority = $match eq "preferred" ? 20 : 10;
172             my $distance;
173
174             if ($cluster->{global})
175             {
176                 $distance = 0;
177             }
178             else
179             {
180                 $distance = distance($origin->{lat}, $origin->{lon}, $cluster->{lat}, $cluster->{lon});
181             }
182
183             push @mappings, {
184                 origin => $origin, cluster => $cluster,
185                 priority => $priority, distance => $distance
186             };
187         }
188     }
189 }
190
191 # Allocate each country to a cluster
192 allocate_clusters(@mappings);
193
194 # If we failed to allocate every origin then loop, increasing
195 # the requests for each cluster by a little and retrying until
196 # we manage to allocate everything
197 while (grep { !exists($_->{cluster}) } values %$origins)
198 {
199     # Clear any existing mappings of countries to clusters
200     foreach my $origin (values %$origins)
201     {
202         delete $origin->{cluster};
203     }
204
205     # Reset requests usage for clusters and increase limits by 10%
206     foreach my $cluster (values %$clusters)
207     {
208         $cluster->{requests_used} = 0;
209         $cluster->{requests_limit} = $cluster->{requests_limit} * 1.1;
210     }
211
212     # Try the allocate again
213     allocate_clusters(@mappings);
214 }
215
216 # Create JSON collection object
217 my @json;
218
219 # Open output files
220 my $zonefile = IO::File->new("> include/${zone}.js") || die "$!";
221 my $jsonfile = IO::File->new("> json/${zone}.openstreetmap.org.json") || die "$!";
222
223 # Output headers
224 $zonefile->print("var \U${zone}\E_RECORDS = [\n");
225
226 # Output details for each country
227 foreach my $origin (sort { $a->{name} cmp $b->{name} } values %$origins)
228 {
229     my $cluster = $origin->{cluster};
230
231     if (!defined($gdnsname))
232     {
233         $zonefile->print("  CNAME(\"\L$origin->{code}\E.${zone}\", \"$cluster->{name}.${zone}.openstreetmap.org.\", TTL(\"10m\")),\n");
234     }
235
236     if ($cluster->{lon} && $cluster->{lat})
237     {
238         my $clon = $origin->{lon};
239         my $clat = $origin->{lat};
240         my $slon = $cluster->{lon};
241         my $slat = $cluster->{lat};
242
243         if ($clon > 0 && $slon < 0 && 360 + $slon - $clon < $clon - $slon)
244         {
245             $slon = $slon + 360;
246         }
247         elsif ($slon > 0 && $clon < 0 && 360 + $clon - $slon < $slon - $clon)
248         {
249             $clon = $clon + 360;
250         }
251
252         push @json, {
253             type => "Feature",
254             geometry => {
255                 type => "LineString",
256                 coordinates => [ [ $clon, $clat ], [ $slon, $slat ] ]
257             },
258             properties => {
259                 origin => $origin->{name},
260                 server => $cluster->{name},
261                 colour => $cluster->{colour}
262             }
263         };
264     }
265
266     next if $cluster->{global};
267
268     $targetorigins->{$cluster->{name}}->{requests} += $origin->{requests};
269 }
270
271 # Skip default records if we don't need them
272 if (!defined($gdnsname))
273 {
274     # Output default records for IPs that can't be mapped to a country
275     foreach my $cluster (sort { $a->{name} cmp $b->{name} } values %$clusters)
276     {
277         my $name = $cluster->{name};
278
279         if (my $default = $cluster->{default})
280         {
281             output_server($zonefile, "${default}.${zone}", $cluster, 0);
282         }
283         elsif (exists($cluster->{default}))
284         {
285             output_server($zonefile, "${zone}", $cluster, 0);
286         }
287     }
288 }
289
290 # Output A records for each cluster
291 foreach my $cluster (sort { $a->{name} cmp $b->{name} } values %$clusters)
292 {
293     my $name = $cluster->{name};
294
295     if (@{$cluster->{servers}} > 1)
296     {
297         output_server($zonefile, "${name}-%02d.${zone}", $cluster, 1);
298     }
299     else
300     {
301         output_server($zonefile, "${name}.${zone}", $cluster, 1);
302     }
303 }
304
305 # Output the GeoJSON text
306 $jsonfile->print(encode_json(\@json));
307
308 # Output footers
309 $zonefile->print("];\n");
310
311 # Close the output files
312 $zonefile->close();
313 $zonefile->close();
314
315 # Output gdnsd configuration
316 if (defined($gdnsname))
317 {
318     my $gdnsmapfile = IO::File->new("> gdns/${gdnsname}.map") || die "$!";
319     my $gdnsresourcefile = IO::File->new("> gdns/${gdnsname}.resource") || die "$!";
320     my $gdnsweightedfile = IO::File->new("> gdns/${gdnsname}.weighted") || die "$!";
321     my $continent = "";
322
323     $gdnsmapfile->print("${gdnsname} => {\n");
324     $gdnsmapfile->print("  geoip2_db => /usr/share/GeoIP/GeoLite2-Country.mmdb\n");
325     $gdnsmapfile->print("  datacenters => [" . join(",", sort(keys(%$clusters))) . "]\n");
326     $gdnsmapfile->print("  map => {\n");
327     $gdnsmapfile->print("    default => [" . join(",", sort(map { $_->{name} } grep { $_->{default} } values(%$clusters))) . "]\n");
328
329     foreach my $origin (sort { $a->{continent} cmp $b->{continent} || $a->{code} cmp $b->{code} } values %$origins)
330     {
331         my $code = $origin->{code};
332         my $cluster = $origin->{cluster}->{name};
333
334         next if $code eq "XK";
335
336         if ($continent ne $origin->{continent})
337         {
338             $gdnsmapfile->print("    }\n") if $continent;
339
340             $continent = $origin->{continent};
341
342             $gdnsmapfile->print("    ${continent} => {\n");
343         }
344
345         $gdnsmapfile->print("      ${code} => [${cluster}]\n");
346     }
347
348     $gdnsmapfile->print("    }\n") if $continent;
349
350     $gdnsmapfile->print("  }\n");
351     $gdnsmapfile->print("}\n");
352
353     $gdnsresourcefile->print("${gdnsname} => {\n");
354     $gdnsresourcefile->print("  map => ${gdnsname}\n");
355     $gdnsresourcefile->print("  dcmap => {\n");
356
357     foreach my $cluster (sort { $a->{name} cmp $b->{name} } values %$clusters)
358     {
359         my $name = $cluster->{name};
360
361         if (@{$cluster->{servers}} > 1 && grep { $_->{status} eq "up" } @{$cluster->{servers}})
362         {
363             $gdnsweightedfile->print("${name} => {\n");
364
365             while (my($index,$server) = each @{$cluster->{servers}})
366             {
367                 if ($server->{status} eq "up")
368                 {
369                     my $number = sprintf("%02d", $index + 1);
370                     my $requests = $server->{requests};
371
372                     if (my $cname = $server->{cname})
373                     {
374                         $gdnsweightedfile->print("  ${name}-${number} = [ ${cname}., ${requests} ]\n");
375                     }
376                     else
377                     {
378                         $gdnsweightedfile->print("  ${name}-${number} = [ ${name}-${number}.${zone}.openstreetmap.org., ${requests} ]\n");
379                     }
380                 }
381             }
382
383             $gdnsweightedfile->print("}\n");
384
385             $gdnsresourcefile->print("    ${name} => %weighted!${name}\n");
386         }
387         elsif (my $cname = $cluster->{cname})
388         {
389             $gdnsresourcefile->print("    ${name} => ${cname}.\n");
390         }
391         else
392         {
393             $gdnsresourcefile->print("    ${name} => ${name}.${zone}.openstreetmap.org.\n");
394         }
395     }
396
397     $gdnsresourcefile->print("  }\n");
398     $gdnsresourcefile->print("}\n");
399
400     $gdnsweightedfile->close();
401     $gdnsresourcefile->close();
402     $gdnsmapfile->close();
403 }
404
405 # Output the target details in origin format if required
406 DumpFile($targetoriginfile, $targetorigins) if $targetoriginfile;
407
408 exit 0;
409
410 #
411 # Match an origin against a cluster
412 #
413 sub match_origin
414 {
415     my $cluster = shift;
416     my $origin = shift;
417     my $match;
418
419     if ($cluster->{preferred} &&
420         $cluster->{preferred}->{origins} &&
421         grep { $_ eq $origin->{name} } @{$cluster->{preferred}->{origins}})
422     {
423         $match = "preferred";
424     }
425     elsif ($cluster->{allowed} &&
426            $cluster->{allowed}->{origins} &&
427            grep { $_ eq $origin->{name} } @{$cluster->{allowed}->{origins}})
428     {
429         $match = "allowed";
430     }
431     elsif ($cluster->{preferred} &&
432            $cluster->{preferred}->{countries} &&
433            grep { $_ eq $origin->{country} } @{$cluster->{preferred}->{countries}})
434     {
435         $match = "preferred";
436     }
437     elsif ($cluster->{allowed} &&
438            $cluster->{allowed}->{countries} &&
439            grep { $_ eq $origin->{country} } @{$cluster->{allowed}->{countries}})
440     {
441         $match = "allowed";
442     }
443     elsif ($cluster->{denied} &&
444            $cluster->{denied}->{countries} &&
445            grep { $_ eq $origin->{country} } @{$cluster->{denied}->{countries}})
446     {
447         $match = "denied";
448     }
449     elsif ($cluster->{preferred} &&
450            $cluster->{preferred}->{continents} &&
451            grep { $_ eq $origin->{continent} } @{$cluster->{preferred}->{continents}})
452     {
453         $match = "preferred";
454     }
455     elsif ($cluster->{allowed} &&
456            $cluster->{allowed}->{continents} &&
457            grep { $_ eq $origin->{continent} } @{$cluster->{allowed}->{continents}})
458     {
459         $match = "allowed";
460     }
461     elsif ($cluster->{denied} &&
462            $cluster->{denied}->{continents} &&
463            grep { $_ eq $origin->{continent} } @{$cluster->{denied}->{continents}})
464     {
465         $match = "denied";
466     }
467     elsif ($cluster->{allowed})
468     {
469         $match = "denied";
470     }
471     else
472     {
473         $match = "allowed";
474     }
475
476     return $match;
477 }
478
479 #
480 # Compute the great circle distance between two points
481 #
482 sub distance
483 {
484     my $lat1 = deg2rad(shift);
485     my $lon1 = deg2rad(shift);
486     my $lat2 = deg2rad(shift);
487     my $lon2 = deg2rad(shift);
488
489     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
490 }
491
492 #
493 # Allocate each origin to a cluster
494 #
495 sub allocate_clusters
496 {
497     my @mappings = sort { compare_mappings($a, $b) } @_;
498
499     # Loop over the mappings, trying to assign each origin to the
500     # nearest cluster, but subject to the request limits
501     while (my $mapping = shift @mappings)
502     {
503         my @group;
504
505         push @group, $mapping;
506
507         while (@mappings && compare_mappings($mapping, $mappings[0]) == 0)
508         {
509             push @group, shift @mappings;
510         }
511
512         for my $mapping (sort compare_requests @group)
513         {
514             my $origin = $mapping->{origin};
515             my $cluster = $mapping->{cluster};
516
517             if (!exists($origin->{cluster}) &&
518                 $cluster->{requests_used} + $origin->{requests} <= $cluster->{requests_limit})
519             {
520                 $origin->{cluster} = $cluster;
521                 $cluster->{requests_used} = $cluster->{requests_used} + $origin->{requests};
522             }
523         }
524     }
525
526     return;
527 }
528
529 #
530 # Compare two mappings to decide which to use
531 #
532 sub compare_mappings
533 {
534     my $a = shift;
535     my $b = shift;
536
537     return $b->{priority} <=> $a->{priority} ||
538            $a->{distance} <=> $b->{distance};
539 }
540
541 #
542 # Compare two mappings to decide which to try first
543 #
544 sub compare_requests
545 {
546     my $a_used = ( $a->{cluster}->{requests_used} * 100.0 ) / ( $a->{cluster}->{requests_limit} * 1.0 );
547     my $b_used = ( $b->{cluster}->{requests_used} * 100.0 ) / ( $b->{cluster}->{requests_limit} * 1.0 );
548
549     return $a_used <=> $b_used;
550 }
551
552 #
553 # Output DNS records for a server
554 #
555 sub output_server
556 {
557     my $zonefile = shift;
558     my $name = shift;
559     my $cluster = shift;
560     my $all = shift;
561
562     while (my($index,$server) = each @{$cluster->{servers}})
563     {
564         if ($all || $server->{status} eq "up")
565         {
566             if ($server->{ipv4})
567             {
568                 $zonefile->printf("  A(\"${name}\", \"$server->{ipv4}\", TTL(\"10m\")),\n", $index + 1);
569             }
570
571             if ($server->{ipv6})
572             {
573                 $zonefile->printf("  AAAA(\"${name}\", \"$server->{ipv6}\", TTL(\"10m\")),\n", $index + 1);
574             }
575         }
576     }
577
578     return;
579 }