1 #!/usr/bin/perl
2 
3 package DNS;
4 
5 use strict;
6 use warnings;
7 use OpenBSD::Pledge;
8 use OpenBSD::Unveil;
9 use Data::Dumper;
10 use File::Copy qw(copy);
11 
12 my %conf = %main::conf;
13 my $chans = $conf{chans};
14 my $staff = $conf{staff};
15 my $key = $conf{key};
16 my $hash = $conf{hash};
17 my $hostname = $conf{hostname};
18 my $verbose = $conf{verbose};
19 my $ip4 = $conf{ip4};
20 my $ip6 = $conf{ip6};
21 my $ip6subnet = $conf{ip6subnet};
22 my $zonedir = $conf{zonedir};
23 my $hostnameif = $conf{hostnameif};
24 if (host($hostname) =~ /(\d+\.){3,}\d+/) {
25 	$ip4 = $&;
26 }
27 main::cbind("msg", "-", "setrdns", \&msetrdns);
28 main::cbind("msg", "-", "delrdns", \&mdelrdns);
29 main::cbind("msg", "-", "setdns", \&msetdns);
30 main::cbind("msg", "-", "deldns", \&mdeldns);
31 main::cbind("msg", "-", "host", \&mhost);
32 main::cbind("msg", "-", "nextdns", \&mnextdns);
33 main::cbind("msg", "-", "readip6s", \&mreadip6s);
34 
35 sub init {
36 	unveil("$zonedir", "rwc") or die "Unable to unveil $!";
37 	unveil("/usr/bin/doas", "rx") or die "Unable to unveil $!";
38 	unveil("/usr/bin/host", "rx") or die "Unable to unveil $!";
39 	unveil("$hostnameif", "rwc") or die "Unable to unveil $!";
40 }
41 
42 # !setrdns 2001:bd8:: username.example.com
43 sub msetrdns {
44 	my ($bot, $nick, $host, $hand, $text) = @_;
45 	if (! (main::isstaff($bot, $nick))) { return; }
46 	if ($text =~ /^([0-9A-Fa-f:\.]{3,})\s+([-0-9A-Za-z\.]+)$/) {
47 		my ($ip, $hostname) = ($1, $2);
48 		if (setrdns($ip, $ip6subnet, $hostname)) {
49 			main::putserv($bot, "PRIVMSG $nick :$hostname set to $ip");
50 		} else {
51 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
52 		}
53 	}
54 }
55 
56 # !delrdns 2001:bd8::
57 sub mdelrdns {
58 	my ($bot, $nick, $host, $hand, $text) = @_;
59 	if (! (main::isstaff($bot, $nick))) { return; }
60 	if ($text =~ /^([0-9A-Fa-f:\.]{3,})$/) {
61 		my ($ip) = ($1);
62 		if (delrdns($ip, $ip6subnet)) {
63 			main::putserv($bot, "PRIVMSG $nick :$ip rDNS deleted");
64 		} else {
65 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
66 		}
67 	}
68 }
69 # !setdns username 1.2.3.4
70 sub msetdns {
71 	my ($bot, $nick, $host, $hand, $text) = @_;
72 	if (! (main::isstaff($bot, $nick))) { return; }
73 	if ($text =~ /^([-0-9A-Za-z\.]+)\s+([0-9A-Fa-f:\.]+)/) {
74 		my ($name, $value) = ($1, $2);
75 		if ($value =~ /:/ and setdns($name, $hostname, "AAAA", $value)) {
76 			main::putserv($bot, "PRIVMSG $nick :$name.$hostname AAAA set to $value");
77 		} elsif (setdns($name, $hostname, "A", $value)) {
78 			main::putserv($bot, "PRIVMSG $nick :$name.$hostname A set to $value");
79 		} else {
80 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set DNS");
81 		}
82 	}
83 }
84 
85 # !deldns username
86 sub mdeldns {
87 	my ($bot, $nick, $host, $hand, $text) = @_;
88 	if (! (main::isstaff($bot, $nick))) { return; }
89 	if ($text =~ /^([-0-9A-Za-z\.]+)$/) {
90 		my ($name) = ($1);
91 		if (setdns($name, $hostname)) {
92 			main::putserv($bot, "PRIVMSG $nick :$text deleted");
93 		} else {
94 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to delete DNS records");
95 		}
96 	}
97 }
98 
99 # !host username
100 sub mhost {
101 	my ($bot, $nick, $host, $hand, $text) = @_;
102 	if (! (main::isstaff($bot, $nick))) { return; }
103 	if ($text =~ /^([-0-9A-Za-z:\.]{3,})/) {
104 		my ($hostname) = ($1);
105 		main::putserv($bot, "PRIVMSG $nick :".host($hostname));
106 	}
107 }
108 
109 # !nextdns username
110 sub mnextdns {
111 	my ($bot, $nick, $host, $hand, $text) = @_;
112 	if (! (main::isstaff($bot, $nick))) { return; }
113 	if ($text =~ /^([-0-9a-zA-Z]+)/) {
114 		main::putserv($bot, "PRIVMSG $nick :$text set to ".nextdns($text));
115 	}
116 }
117 
118 # !readip6s
119 sub mreadip6s {
120 	my ($bot, $nick, $host, $hand, $text) = @_;
121 	if (! (main::isstaff($bot, $nick))) { return; }
122 	foreach my $line (readip6s($hostnameif)) {
123 		print "$line\n"
124 	}
125 }
126 
127 # Return list of ipv6 addresses from filename
128 sub readip6s {
129 	my ($filename) = @_;
130 	my @lines = main::readarray($filename);
131 	my @ipv6s;
132 	foreach my $line (@lines) {
133 		if ($line =~ /^\s*inet6\s+(alias\s+)?([0-9a-f:]{4,})\s+[0-9]+\s*$/i) {
134 			push(@ipv6s, $2);
135 		} elsif ($line =~ /^\s*([0-9a-f:]{4,})\s*$/i) {
136 			push(@ipv6s, $1);
137 		}
138 	}
139 	return @ipv6s;
140 }
141 
142 # set rdns of $ip6 to $hostname given $subnet
143 # return true on success; false on failure
144 sub setrdns {
145 	my ($ip6, $subnet, $hostname) = @_;
146 	my $digits = ip6full($ip6);
147 	$digits =~ tr/://d;
148 	my $reversed = reverse($digits);
149 	my $origin = substr($reversed, 32-$subnet/4);
150 	$origin = join('.', split(//, $origin)).".ip6.arpa";
151 	my $name = substr($reversed, 0, 32-$subnet/4);
152 	$name = join('.', split(//, $name));
153 	# delete old PTR records, then set new one
154 	return setdns($name, $origin) && setdns($name, $origin, "PTR", $hostname);
155 }
156 # delete rdns of $ip6 given $subnet
157 # return true on success; false on failure
158 sub delrdns {
159 	my ($ip6, $subnet) = @_;
160 	return setrdns($ip6, $subnet);
161 }
162 
163 # given $origin. create $name RR of $type and set to $value if provided;
164 # if $value is missing, delete $domain
165 # returns true upon success, false upon failure
166 sub setdns {
167 	my ($name, $origin, $type, $value) = @_;
168 	my $filename = "$zonedir/$origin";
169 	my @lines = main::readarray($filename);
170 	foreach my $line (@lines) {
171 		# increment the zone's serial number
172 		if ($line =~ /(\d{8})(\d{2})((\s+\d+){4}\s*\))/) {
173 			my $date = main::date();
174 			my $serial = 0;
175 			if ($date <= $1) { $serial = $2+1; }
176 			$line = $`.$date.sprintf("%02d",$serial).$3.$';
177 		}
178 	}
179 	if (!defined($value)) { # delete records
180 		@lines = grep !/\b$name\s*3600\s*IN/, @lines;
181 	} else {
182         	push(@lines, "$name	3600	IN	$type	$value");
183 	}
184 	# trailing newline necessary
185 	main::writefile("$filename.bak", join("\n", @lines)."\n");
186 	copy "$filename.bak", $filename;
187 	if (system("doas -u _nsd nsd-control reload")) {
188 		return 0;
189 	} else {
190         	return 1;
191 	}
192 }
193 
194 # given hostname, return IP addresses; or given IP address, return hostname
195 sub host {
196 	my ($name) = @_;
197 	my @matches;
198 	my @lines = split /\n/m, `host $name`;
199 	if ($name =~ /^[0-9\.]+$/ or $name =~ /:/) { # IP address
200 		foreach my $line (@lines) {
201 			if ($line =~ /([\d\.]+).(in-addr|ip6).arpa domain name pointer (.*)/) {
202 				push(@matches, $3);
203 			}
204 		}
205 	} else { # hostname
206 		foreach my $line (@lines) {
207 			if ($line =~ /$name has (IPv6 )?address ([0-9a-fA-F\.:]+)/) {
208 				push(@matches, $2);
209 			}
210 		}
211 	}
212 	return join(' ', @matches);
213 }
214 
215 # Return an ipv6 address with all zeroes filled in
216 sub ip6full {
217 	my ($ip6) = @_;
218 	my $left = substr($ip6, 0, index($ip6, "::"));
219 	my $leftcolons = ($left =~ tr/://);
220 	$ip6 =~ s{::}{:};
221 	my @quartets = split(':', $ip6);
222 	my $length = scalar(@quartets);
223 	for (my $n = 1; $n <= 8 - $length; $n++) {
224 		splice(@quartets, $leftcolons+1, 0, "0000");
225 	}
226 	my @newquartets = map(sprintf('%04s', $_), @quartets);
227 	my $full = join(':',@newquartets);
228 	return $full;
229 }
230 # Returns the network part of the first IPv6 address (indicated by subnet)
231 # with the host part of the second IPv6 address
232 sub ip6mask {
233         my ($ip6net, $subnet, $ip6host) = @_;
234         my $netdigits = ip6full($ip6net);
235         $netdigits =~ tr/://d;
236         my $hostdigits = ip6full($ip6host);
237         $hostdigits =~ tr/://d;
238         my $digits = substr($netdigits,0,($subnet/4)).substr($hostdigits,($subnet/4));
239         my $ip6;
240         for (my $n = 0; $n < 32; $n++) {
241                 if ($n > 0 && $n % 4 == 0) {
242                         $ip6 .= ":";
243                 }
244                 $ip6 .= substr($digits,$n,1);
245         }
246         return $ip6;
247 }
248 sub randip6 {
249         return join ':', map { sprintf '%04x', rand 0x10000 } (1 .. 8);
250 }
251 
252 # create A and AAAA records for subdomain, set the rDNS,
253 # and return the new ipv6 address
254 sub nextdns {
255 	my ($subdomain) = @_;
256 	my $newip6 = $ip6;
257 	my @allip6s = readip6s($hostnameif);
258 	while (grep(/$newip6/, @allip6s)) {
259 		$newip6 = ip6mask($ip6, $ip6subnet,randip6());
260 	}
261 	main::appendfile($hostnameif, "inet6 alias $newip6 48\n");
262 	`doas ifconfig vio0 inet6 $newip6/48`;
263 	if (setdns($subdomain, $hostname, "A", $ip4) && setdns($subdomain, $hostname, "AAAA", $newip6) && setrdns($newip6, $ip6subnet, "$subdomain.$hostname")) {
264 		return "$newip6";
265 	}
266 	return "false";
267 }
268 
269 1; # MUST BE LAST STATEMENT IN FILE