]> git.openstreetmap.org Git - dns.git/blob - bin/mkgeo
Fix bandwidth tracking
[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->{bandwidth} = 0;
29
30         foreach my $server (@{$cluster->{servers}})
31         {
32             $server->{cluster} = $cluster;
33             $cluster->{bandwidth} = $cluster->{bandwidth} + $server->{bandwidth};
34
35             push @servers, $server;
36         }
37     }
38     else
39     {
40         my $server = {
41             cluster => $cluster,
42             statuscake => $cluster->{statuscake},
43             bandwidth => $cluster->{bandwidth},
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}->{bandwidth} = $server->{cluster}->{bandwidth} - $server->{bandwidth};
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->{bandwidth_limit} = $cluster->{bandwidth} * 1024 * 1024;
147     $cluster->{bandwidth_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         bandwidth => 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 bandwidth 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 bandwidth usage for clusters and increase limits by 10%
206     foreach my $cluster (values %$clusters)
207     {
208         $cluster->{bandwidth_used} = 0;
209         $cluster->{bandwidth_limit} = $cluster->{bandwidth_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     $targetorigins->{$cluster->{name}}->{bandwidth} += $origin->{bandwidth};
267 }
268
269 # Skip default records if we don't need them
270 if (!defined($gdnsname))
271 {
272     # Output default records for IPs that can't be mapped to a country
273     foreach my $cluster (sort { $a->{name} cmp $b->{name} } values %$clusters)
274     {
275         my $name = $cluster->{name};
276
277         if (my $default = $cluster->{default})
278         {
279             output_server($zonefile, "${default}.${zone}", $cluster, 0);
280         }
281         elsif (exists($cluster->{default}))
282         {
283             output_server($zonefile, "${zone}", $cluster, 0);
284         }
285     }
286 }
287
288 # Output A records for each cluster
289 foreach my $cluster (sort { $a->{name} cmp $b->{name} } values %$clusters)
290 {
291     my $name = $cluster->{name};
292
293     if (@{$cluster->{servers}} > 1)
294     {
295         output_server($zonefile, "${name}-%02d.${zone}", $cluster, 1);
296     }
297     else
298     {
299         output_server($zonefile, "${name}.${zone}", $cluster, 1);
300     }
301 }
302
303 # Output the GeoJSON text
304 $jsonfile->print(encode_json(\@json));
305
306 # Output footers
307 $zonefile->print("];\n");
308
309 # Close the output files
310 $zonefile->close();
311 $zonefile->close();
312
313 # Output gdnsd configuration
314 if (defined($gdnsname))
315 {
316     my $gdnsmapfile = IO::File->new("> gdns/${gdnsname}.map") || die "$!";
317     my $gdnsresourcefile = IO::File->new("> gdns/${gdnsname}.resource") || die "$!";
318     my $gdnsweightedfile = IO::File->new("> gdns/${gdnsname}.weighted") || die "$!";
319     my $continent = "";
320
321     $gdnsmapfile->print("${gdnsname} => {\n");
322     $gdnsmapfile->print("  geoip2_db => /usr/share/GeoIP/GeoLite2-Country.mmdb\n");
323     $gdnsmapfile->print("  datacenters => [" . join(",", sort(keys(%$clusters))) . "]\n");
324     $gdnsmapfile->print("  map => {\n");
325     $gdnsmapfile->print("    default => [" . join(",", sort(map { $_->{name} } grep { $_->{default} } values(%$clusters))) . "]\n");
326
327     foreach my $origin (sort { $a->{continent} cmp $b->{continent} || $a->{code} cmp $b->{code} } values %$origins)
328     {
329         my $code = $origin->{code};
330         my $cluster = $origin->{cluster}->{name};
331
332         next if $code eq "XK";
333
334         if ($continent ne $origin->{continent})
335         {
336             $gdnsmapfile->print("    }\n") if $continent;
337
338             $continent = $origin->{continent};
339
340             $gdnsmapfile->print("    ${continent} => {\n");
341         }
342
343         $gdnsmapfile->print("      ${code} => [${cluster}]\n");
344     }
345
346     $gdnsmapfile->print("    }\n") if $continent;
347
348     $gdnsmapfile->print("  }\n");
349     $gdnsmapfile->print("}\n");
350
351     $gdnsresourcefile->print("${gdnsname} => {\n");
352     $gdnsresourcefile->print("  map => ${gdnsname}\n");
353     $gdnsresourcefile->print("  dcmap => {\n");
354
355     foreach my $cluster (sort { $a->{name} cmp $b->{name} } values %$clusters)
356     {
357         my $name = $cluster->{name};
358
359         if (@{$cluster->{servers}} > 1 && grep { $_->{status} eq "up" } @{$cluster->{servers}})
360         {
361             $gdnsweightedfile->print("${name} => {\n");
362
363             while (my($index,$server) = each @{$cluster->{servers}})
364             {
365                 if ($server->{status} eq "up")
366                 {
367                     my $number = sprintf("%02d", $index + 1);
368                     my $bandwidth = $server->{bandwidth};
369
370                     if (my $cname = $server->{cname})
371                     {
372                         $gdnsweightedfile->print("  ${name}-${number} = [ ${cname}., ${bandwidth} ]\n");
373                     }
374                     else
375                     {
376                         $gdnsweightedfile->print("  ${name}-${number} = [ ${name}-${number}.${zone}.openstreetmap.org., ${bandwidth} ]\n");
377                     }
378                 }
379             }
380
381             $gdnsweightedfile->print("}\n");
382
383             $gdnsresourcefile->print("    ${name} => %weighted!${name}\n");
384         }
385         elsif (my $cname = $cluster->{cname})
386         {
387             $gdnsresourcefile->print("    ${name} => ${cname}.\n");
388         }
389         else
390         {
391             $gdnsresourcefile->print("    ${name} => ${name}.${zone}.openstreetmap.org.\n");
392         }
393     }
394
395     $gdnsresourcefile->print("  }\n");
396     $gdnsresourcefile->print("}\n");
397
398     $gdnsweightedfile->close();
399     $gdnsresourcefile->close();
400     $gdnsmapfile->close();
401 }
402
403 # Output the target details in origin format if required
404 DumpFile($targetoriginfile, $targetorigins) if $targetoriginfile;
405
406 exit 0;
407
408 #
409 # Match an origin against a cluster
410 #
411 sub match_origin
412 {
413     my $cluster = shift;
414     my $origin = shift;
415     my $match;
416
417     if ($cluster->{preferred} &&
418         $cluster->{preferred}->{origins} &&
419         grep { $_ eq $origin->{name} } @{$cluster->{preferred}->{origins}})
420     {
421         $match = "preferred";
422     }
423     elsif ($cluster->{allowed} &&
424            $cluster->{allowed}->{origins} &&
425            grep { $_ eq $origin->{name} } @{$cluster->{allowed}->{origins}})
426     {
427         $match = "allowed";
428     }
429     elsif ($cluster->{preferred} &&
430            $cluster->{preferred}->{countries} &&
431            grep { $_ eq $origin->{country} } @{$cluster->{preferred}->{countries}})
432     {
433         $match = "preferred";
434     }
435     elsif ($cluster->{allowed} &&
436            $cluster->{allowed}->{countries} &&
437            grep { $_ eq $origin->{country} } @{$cluster->{allowed}->{countries}})
438     {
439         $match = "allowed";
440     }
441     elsif ($cluster->{denied} &&
442            $cluster->{denied}->{countries} &&
443            grep { $_ eq $origin->{country} } @{$cluster->{denied}->{countries}})
444     {
445         $match = "denied";
446     }
447     elsif ($cluster->{preferred} &&
448            $cluster->{preferred}->{continents} &&
449            grep { $_ eq $origin->{continent} } @{$cluster->{preferred}->{continents}})
450     {
451         $match = "preferred";
452     }
453     elsif ($cluster->{allowed} &&
454            $cluster->{allowed}->{continents} &&
455            grep { $_ eq $origin->{continent} } @{$cluster->{allowed}->{continents}})
456     {
457         $match = "allowed";
458     }
459     elsif ($cluster->{denied} &&
460            $cluster->{denied}->{continents} &&
461            grep { $_ eq $origin->{continent} } @{$cluster->{denied}->{continents}})
462     {
463         $match = "denied";
464     }
465     elsif ($cluster->{allowed})
466     {
467         $match = "denied";
468     }
469     else
470     {
471         $match = "allowed";
472     }
473
474     return $match;
475 }
476
477 #
478 # Compute the great circle distance between two points
479 #
480 sub distance
481 {
482     my $lat1 = deg2rad(shift);
483     my $lon1 = deg2rad(shift);
484     my $lat2 = deg2rad(shift);
485     my $lon2 = deg2rad(shift);
486
487     return great_circle_distance($lon1, pip2 - $lat1, $lon2, pip2 - $lat2);
488 }
489
490 #
491 # Allocate each origin to a cluster
492 #
493 sub allocate_clusters
494 {
495     my @mappings = sort { compare_mappings($a, $b) } @_;
496
497     # Loop over the mappings, trying to assign each origin to the
498     # nearest cluster, but subject to the bandwidth limits
499     while (my $mapping = shift @mappings)
500     {
501         my @group;
502
503         push @group, $mapping;
504
505         while (@mappings && compare_mappings($mapping, $mappings[0]) == 0)
506         {
507             push @group, shift @mappings;
508         }
509
510         for my $mapping (sort compare_bandwidth @group)
511         {
512             my $origin = $mapping->{origin};
513             my $cluster = $mapping->{cluster};
514
515             if (!exists($origin->{cluster}) &&
516                 $cluster->{bandwidth_used} + $origin->{bandwidth} <= $cluster->{bandwidth_limit})
517             {
518                 $origin->{cluster} = $cluster;
519                 $cluster->{bandwidth_used} = $cluster->{bandwidth_used} + $origin->{bandwidth};
520             }
521         }
522     }
523
524     return;
525 }
526
527 #
528 # Compare two mappings to decide which to use
529 #
530 sub compare_mappings
531 {
532     my $a = shift;
533     my $b = shift;
534
535     return $b->{priority} <=> $a->{priority} ||
536            $a->{distance} <=> $b->{distance};
537 }
538
539 #
540 # Compare two mappings to decide which to try first
541 #
542 sub compare_bandwidth
543 {
544     my $a_used = ( $a->{cluster}->{bandwidth_used} * 100.0 ) / ( $a->{cluster}->{bandwidth_limit} * 1.0 );
545     my $b_used = ( $b->{cluster}->{bandwidth_used} * 100.0 ) / ( $b->{cluster}->{bandwidth_limit} * 1.0 );
546
547     return $a_used <=> $b_used;
548 }
549
550 #
551 # Output DNS records for a server
552 #
553 sub output_server
554 {
555     my $zonefile = shift;
556     my $name = shift;
557     my $cluster = shift;
558     my $all = shift;
559
560     while (my($index,$server) = each @{$cluster->{servers}})
561     {
562         if ($all || $server->{status} eq "up")
563         {
564             if ($server->{ipv4})
565             {
566                 $zonefile->printf("  A(\"${name}\", \"$server->{ipv4}\", TTL(\"10m\")),\n", $index + 1);
567             }
568
569             if ($server->{ipv6})
570             {
571                 $zonefile->printf("  AAAA(\"${name}\", \"$server->{ipv6}\", TTL(\"10m\")),\n", $index + 1);
572             }
573         }
574     }
575
576     return;
577 }