xref: /netbsd-src/external/mpl/bind/dist/bin/tests/system/geoip2/data/write-test-data.pl (revision f281902de12281841521aa31ef834ad944d725e2)
1#!/usr/bin/env perl
2
3# Copyright (C) Internet Systems Consortium, Inc. ("ISC")
4#
5# SPDX-License-Identifier: MPL-2.0
6#
7# This Source Code Form is subject to the terms of the Mozilla Public
8# License, v. 2.0.  If a copy of the MPL was not distributed with this
9# file, you can obtain one at https://mozilla.org/MPL/2.0/.
10#
11# See the COPYRIGHT file distributed with this work for additional
12# information regarding copyright ownership.
13
14use strict;
15use warnings;
16use autodie;
17use utf8;
18
19use Carp qw( croak );
20use Cwd qw( abs_path );
21use File::Basename qw( dirname );
22use File::Slurper qw( read_binary write_binary );
23use Cpanel::JSON::XS qw( decode_json );
24use Math::Int128 qw( MAX_UINT128 string_to_uint128 uint128 );
25use MaxMind::DB::Writer::Serializer 0.100004;
26use MaxMind::DB::Writer::Tree 0.100004;
27use MaxMind::DB::Writer::Util qw( key_for_data );
28use Net::Works::Network;
29use Test::MaxMind::DB::Common::Util qw( standard_test_metadata );
30
31my $Dir = dirname( abs_path($0) );
32
33sub main {
34    write_geoip2_dbs();
35}
36
37sub write_geoip2_dbs {
38    _write_geoip2_db( @{$_}[ 0, 1 ], 'Test' )
39        for (
40        ['GeoIP2-City'],
41        ['GeoIP2-Country'],
42        ['GeoIP2-Domain'],
43        ['GeoIP2-ISP'],
44        ['GeoLite2-ASN'],
45        );
46}
47
48sub _universal_map_key_type_callback {
49    my $map = {
50
51        # languages
52        de      => 'utf8_string',
53        en      => 'utf8_string',
54        es      => 'utf8_string',
55        fr      => 'utf8_string',
56        ja      => 'utf8_string',
57        'pt-BR' => 'utf8_string',
58        ru      => 'utf8_string',
59        'zh-CN' => 'utf8_string',
60
61        # production
62        accuracy_radius                => 'uint16',
63        autonomous_system_number       => 'uint32',
64        autonomous_system_organization => 'utf8_string',
65        average_income                 => 'uint32',
66        city                           => 'map',
67        code                           => 'utf8_string',
68        confidence                     => 'uint16',
69        connection_type                => 'utf8_string',
70        continent                      => 'map',
71        country                        => 'map',
72        domain                         => 'utf8_string',
73        geoname_id                     => 'uint32',
74        ipv4_24                        => 'uint32',
75        ipv4_32                        => 'uint32',
76        ipv6_32                        => 'uint32',
77        ipv6_48                        => 'uint32',
78        ipv6_64                        => 'uint32',
79        is_anonymous                   => 'boolean',
80        is_anonymous_proxy             => 'boolean',
81        is_anonymous_vpn               => 'boolean',
82        is_hosting_provider            => 'boolean',
83        is_in_european_union           => 'boolean',
84        is_legitimate_proxy            => 'boolean',
85        is_public_proxy                => 'boolean',
86        is_satellite_provider          => 'boolean',
87        is_tor_exit_node               => 'boolean',
88        iso_code                       => 'utf8_string',
89        isp                            => 'utf8_string',
90        latitude                       => 'double',
91        location                       => 'map',
92        longitude                      => 'double',
93        metro_code                     => 'uint16',
94        names                          => 'map',
95        organization                   => 'utf8_string',
96        population_density             => 'uint32',
97        postal                         => 'map',
98        registered_country             => 'map',
99        represented_country            => 'map',
100        subdivisions                   => [ 'array', 'map' ],
101        time_zone                      => 'utf8_string',
102        traits                         => 'map',
103        traits                         => 'map',
104        type                           => 'utf8_string',
105        user_type                      => 'utf8_string',
106
107        # for testing only
108        foo       => 'utf8_string',
109        bar       => 'utf8_string',
110        buzz      => 'utf8_string',
111        our_value => 'utf8_string',
112    };
113
114    my $callback = sub {
115        my $key = shift;
116
117        return $map->{$key} || die <<"ERROR";
118Unknown tree key '$key'.
119
120The universal_map_key_type_callback doesn't know what type to use for the passed
121key.  If you are adding a new key that will be used in a frozen tree / mmdb then
122you should update the mapping in both our internal code and here.
123ERROR
124    };
125
126    return $callback;
127}
128
129sub _write_geoip2_db {
130    my $type                            = shift;
131    my $populate_all_networks_with_data = shift;
132    my $description                     = shift;
133
134    my $writer = MaxMind::DB::Writer::Tree->new(
135        ip_version    => 6,
136        record_size   => 28,
137        ip_version    => 6,
138        database_type => $type,
139        languages     => [ 'en', $type eq 'GeoIP2-City' ? ('zh') : () ],
140        description   => {
141            en => ( $type =~ s/-/ /gr )
142                . " $description Database (fake GeoIP2 data, for example purposes only)",
143            $type eq 'GeoIP2-City' ? ( zh => '小型数据库' ) : (),
144        },
145        alias_ipv6_to_ipv4    => 1,
146        map_key_type_callback => _universal_map_key_type_callback(),
147        remove_reserved_networks => 0,
148    );
149
150    _populate_all_networks( $writer, $populate_all_networks_with_data )
151        if $populate_all_networks_with_data;
152
153    my $value = shift;
154    my $nodes
155        = decode_json( read_binary("$Dir/$type.json") );
156
157    for my $node (@$nodes) {
158        for my $network ( keys %$node ) {
159            $writer->insert_network(
160                Net::Works::Network->new_from_string( string => $network ),
161                $node->{$network}
162            );
163        }
164    }
165
166    open my $output_fh, '>', "$Dir/$type.mmdb";
167    $writer->write_tree($output_fh);
168    close $output_fh;
169
170    return;
171}
172
173sub _populate_all_networks {
174    my $writer = shift;
175    my $data   = shift;
176
177    my $max_uint128 = uint128(0) - 1;
178    my @networks    = Net::Works::Network->range_as_subnets(
179        Net::Works::Address->new_from_integer(
180            integer => 0,
181            version => 6,
182        ),
183        Net::Works::Address->new_from_integer(
184            integer => $max_uint128,
185            version => 6,
186        ),
187    );
188
189    for my $network (@networks) {
190        $writer->insert_network( $network => $data );
191    }
192}
193
194main();
195