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