1#!/usr/bin/perl -w
2use strict;
3use BerkeleyDB;
4use Getopt::Long;
5
6my $opt = {};
7if (!GetOptions($opt, qw/bdb|b:s input|i:s zones|z:s help|h/)) {
8    usage('GetOptions processing failed.');
9    exit 1;
10}
11
12if ($opt->{help}) {
13    usage();
14    exit 0;
15}
16
17my $db_file = $opt->{bdb};
18if (!defined $db_file || $db_file eq '') {
19    usage('Please specify an output BerkeleyDB filename.');
20    exit 1;
21}
22
23my $input_file = $opt->{input};
24if (!defined $input_file || $input_file eq '') {
25    usage('Please specify an input records file.');
26    exit 1;
27}
28
29my $zone_list = $opt->{zones};
30if (!defined $zone_list || $zone_list eq '') {
31    usage('Please specify a space separated list of zones');
32    exit 1;
33}
34
35my $records = [];
36my $unique_names = [];
37populate_records(records=>$records, input_file=>$input_file, unique_names=>$unique_names);
38
39my $flags =  DB_CREATE;
40
41my $dns_data = new BerkeleyDB::Hash
42    -Filename  => $db_file,
43    -Flags     => $flags,
44    -Property  => DB_DUP | DB_DUPSORT,
45    -Subname   => "dns_data"
46    ||    die "Cannot create dns_data: $BerkeleyDB::Error";
47
48my $replId = 0;
49my @zones = split(/\s+/, $zone_list);
50foreach my $zone (@zones) {
51    foreach my $r (@$records) {
52        my $name = $r->{name};
53        my $ttl = $r->{ttl};
54        my $type = $r->{type};
55        my $data = $r->{data};
56
57        $data =~ s/\%zone\%/$zone/g;
58        $data =~ s/\%driver\%/bdbhpt-dynamic/g;
59
60        my $row_name  = "$zone $name";
61        my $row_value = "$replId $name $ttl $type $data";
62        if ($dns_data->db_put($row_name, $row_value) != 0) {
63            die "Cannot add record '$row_name' -> '$row_value' to dns_data: $BerkeleyDB::Error";
64        }
65        $replId++;
66    }
67}
68
69$dns_data->db_close();
70
71my $dns_xfr = new BerkeleyDB::Hash
72    -Filename  => $db_file,
73    -Flags     => $flags,
74    -Property  => DB_DUP | DB_DUPSORT,
75    -Subname   => "dns_xfr"
76    or die "Cannot create dns_xfr: $BerkeleyDB::Error";
77
78foreach my $zone (@zones) {
79    foreach my $name (@$unique_names) {
80        if ($dns_xfr->db_put($zone, $name) != 0) {
81            die "Cannot add record '$zone' -> '$name' to dns_xfr: $BerkeleyDB::Error";
82        }
83    }
84}
85
86$dns_xfr->db_close();
87
88my $dns_client = new BerkeleyDB::Hash
89    -Filename  => $db_file,
90    -Flags     => $flags,
91    -Property  => DB_DUP | DB_DUPSORT,
92    -Subname   => "dns_client"
93    or die "Cannot create dns_client: $BerkeleyDB::Error";
94
95foreach my $zone (@zones) {
96    my $ip = '127.0.0.1';
97    if ($dns_client->db_put($zone, $ip) != 0) {
98        die "Cannot add record '$zone' -> '$ip' to dns_client: $BerkeleyDB::Error";
99    }
100}
101
102$dns_client->db_close();
103
104my $dns_zone = new BerkeleyDB::Btree
105    -Filename  => $db_file,
106    -Flags     => $flags,
107    -Property  => 0,
108    -Subname   => "dns_zone"
109    or die "Cannot create dns_zone: $BerkeleyDB::Error";
110
111foreach my $zone (@zones) {
112    my $reversed_zone = reverse($zone);
113    if ($dns_zone->db_put($reversed_zone, "1") != 0) {
114        die "Cannot add record '$reversed_zone' -> '1' to dns_zone: $BerkeleyDB::Error";
115    }
116};
117
118$dns_zone->db_close();
119
120exit 0;
121
122sub usage {
123    my ($message) = @_;
124    if (defined $message && $message ne '') {
125        print STDERR $message . "\n\n";
126    }
127
128    print STDERR "usage: $0 --bdb=<bdb-file> --input=<input-file> --zones=<zone-list>\n\n";
129    print STDERR "\tbdb-file: The output BerkeleyDB file you wish to create and use with bdbhpt-dynamic\n\n";
130    print STDERR "\tinput-file: The input text-file containing records to populate within your zones\n\n";
131    print STDERR "\tzone-list: The space-separated list of zones you wish to create\n\n";
132}
133
134sub populate_records {
135    my (%args) = @_;
136    my $records = $args{records};
137    my $input_file = $args{input_file};
138    my $unique_names = $args{unique_names};
139
140    my %unique;
141
142    open(RECORDS, $input_file) || die "unable to open $input_file: $!";
143    while (<RECORDS>) {
144        chomp;
145        s/\#.*$//;
146        s/^\s+//;
147        if ($_ eq '') {
148            next;
149        }
150        my ($name, $ttl, $type, $data) = split(/\s+/, $_, 4);
151        my $record = { name=>$name, ttl=>$ttl, type=>$type, data=>$data };
152        if (validate_record($record)) {
153            push @$records, $record;
154            $unique{$name} = 1;
155        }
156    }
157    close(RECORDS);
158
159    foreach my $name (sort keys %unique) {
160        push @$unique_names, $name;
161    }
162}
163
164# This could probably do more in-depth tests, but these tests are better than nothing!
165sub validate_record {
166    my ($r) = @_;
167
168    # http://en.wikipedia.org/wiki/List_of_DNS_record_types
169    my @TYPES = qw/A AAAA AFSDB APL CERT CNAME DHCID DLV DNAME DNSKEY DS HIP IPSECKEY KEY KX LOC MX NAPTR NS NSEC NSEC3 NSEC3PARAM PTR RRSIG RP SIG SOA SPF SRV SSHFP TA TKEY TLSA TSIG TXT/;
170    my $VALID_TYPE = {};
171    foreach my $t (@TYPES) {
172        $VALID_TYPE->{$t} = 1;
173    }
174
175    if (!defined $r->{name} || $r->{name} eq '') {
176        die "Record name must be set";
177    }
178
179    if (!defined $r->{ttl} || $r->{ttl} eq '') {
180        die "Record TTL must be set";
181    }
182
183    if ($r->{ttl} =~ /\D/ || $r->{ttl} < 0) {
184        die "Record TTL must be an integer 0 or greater";
185    }
186
187    if (!defined $r->{type} || $r->{type} eq '') {
188        die "Record type must be set";
189    }
190
191    if (!$VALID_TYPE->{$r->{type}}) {
192        die "Unsupported record type: $r->{type}";
193    }
194
195    # Lets do some data validation for the records which will cause bind to crash if they're wrong
196    if ($r->{type} eq 'SOA') {
197        my $soa_error = "SOA records must take the form: 'server email refresh retry expire negative_cache_ttl'";
198        my ($server, $email, $version, $refresh, $retry, $expire, $negative_cache_ttl) = split(/\s+/, $r->{data});
199        if (!defined $server || $server eq '') {
200            die "$soa_error, missing server";
201        }
202        if (!defined $email || $email eq '') {
203            die "$soa_error, missing email";
204        }
205        if (!defined $refresh || $refresh eq '') {
206            die "$soa_error, missing refresh";
207        }
208        if ($refresh =~ /\D/ || $refresh <= 0) {
209            die "$soa_error, refresh must be an integer greater than 0";
210        }
211        if (!defined $retry || $retry eq '') {
212            die "$soa_error, missing retry";
213        }
214        if ($retry =~ /\D/ || $retry <= 0) {
215            die "$soa_error, retry must be an integer greater than 0";
216        }
217        if (!defined $expire || $expire eq '') {
218            die "$soa_error, missing expire";
219        }
220        if ($expire =~ /\D/ || $expire <= 0) {
221            die "$soa_error, expire must be an integer greater than 0";
222        }
223        if (!defined $negative_cache_ttl || $negative_cache_ttl eq '') {
224            die "$soa_error, missing negative cache ttl";
225        }
226        if ($negative_cache_ttl =~ /\D/ || $negative_cache_ttl <= 0) {
227            die "$soa_error, negative cache ttl must be an integer greater than 0";
228        }
229    }
230
231    return 1;
232}
233