===================================================================
RCS file: /cvs/botnow/DNS.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- botnow/DNS.pm	2021/05/15 15:12:32	1.1
+++ botnow/DNS.pm	2021/07/20 17:40:08	1.2
@@ -16,21 +16,13 @@ my $key = $conf{key};
 my $hash = $conf{hash};
 my $hostname = $conf{hostname};
 my $verbose = $conf{verbose};
-my $ipv4 = $conf{ipv4};
+my $ip4 = $conf{ip4};
+my $ip6 = $conf{ip6};
+my $ip6subnet = $conf{ip6subnet};
 my $zonedir = $conf{zonedir};
-my $ipv6path = $conf{ipv6path};
 my $hostnameif = $conf{hostnameif};
-# Validate ipv6s if it exists, otherwise load addresses from /etc/hostname.if
-my @ipv6s;
-if (!(-s "$ipv6path")) {
-	print "No IPv6 addresses in $ipv6path, loading from $hostnameif...\n";
-	@ipv6s = readipv6s($hostnameif);
-} else {
-	@ipv6s = readipv6s($ipv6path);
-}
-if (!@ipv6s) { die "No IPv6 addresses in $ipv6path or $hostnameif!"; }
 if (host($hostname) =~ /(\d+\.){3,}\d+/) {
-	$ipv4 = $&;
+	$ip4 = $&;
 }
 main::cbind("msg", "-", "setrdns", \&msetrdns);
 main::cbind("msg", "-", "delrdns", \&mdelrdns);
@@ -38,73 +30,83 @@ main::cbind("msg", "-", "setdns", \&msetdns);
 main::cbind("msg", "-", "deldns", \&mdeldns);
 main::cbind("msg", "-", "host", \&mhost);
 main::cbind("msg", "-", "nextdns", \&mnextdns);
+main::cbind("msg", "-", "readip6s", \&mreadip6s);
 
 sub init {
-	unveil("$ipv6path", "rwc") or die "Unable to unveil $!";
 	unveil("$zonedir", "rwc") or die "Unable to unveil $!";
-	#dependencies for doas
 	unveil("/usr/bin/doas", "rx") or die "Unable to unveil $!";
-	#dependencies for host
 	unveil("/usr/bin/host", "rx") or die "Unable to unveil $!";
+	unveil("$hostnameif", "rwc") or die "Unable to unveil $!";
 }
 
+# !setrdns 2001:bd8:: username.example.com
 sub msetrdns {
 	my ($bot, $nick, $host, $hand, $text) = @_;
 	if (! (main::isstaff($bot, $nick))) { return; }
-	if ($text =~ /^([0-9A-Fa-f:\.]{3,})\s+([-0-9A-Za-z\.]+)/) {
+	if ($text =~ /^([0-9A-Fa-f:\.]{3,})\s+([-0-9A-Za-z\.]+)$/) {
 		my ($ip, $hostname) = ($1, $2);
-		if (setrdns($ip, $hostname)) {
+		if (setrdns($ip, $ip6subnet, $hostname)) {
 			main::putserv($bot, "PRIVMSG $nick :$hostname set to $ip");
 		} else {
 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
 		}
 	}
 }
+
+# !delrdns 2001:bd8::
 sub mdelrdns {
 	my ($bot, $nick, $host, $hand, $text) = @_;
 	if (! (main::isstaff($bot, $nick))) { return; }
 	if ($text =~ /^([0-9A-Fa-f:\.]{3,})$/) {
-		my $ip = $1;
-		my $hostname = "notset";
-		if (setrdns($ip, $hostname)) {
+		my ($ip) = ($1);
+		if (delrdns($ip, $ip6subnet)) {
 			main::putserv($bot, "PRIVMSG $nick :$ip rDNS deleted");
 		} else {
 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set rDNS");
 		}
 	}
 }
+# !setdns username 1.2.3.4
 sub msetdns {
 	my ($bot, $nick, $host, $hand, $text) = @_;
 	if (! (main::isstaff($bot, $nick))) { return; }
 	if ($text =~ /^([-0-9A-Za-z\.]+)\s+([0-9A-Fa-f:\.]+)/) {
-		my ($hostname, $ip) = ($1, $2);
-		if (setdns($hostname, $ip)) {
-			main::putserv($bot, "PRIVMSG $nick :$hostname set to $ip");
+		my ($name, $value) = ($1, $2);
+		if ($value =~ /:/ and setdns($name, $hostname, "AAAA", $value)) {
+			main::putserv($bot, "PRIVMSG $nick :$name.$hostname AAAA set to $value");
+		} elsif (setdns($name, $hostname, "A", $value)) {
+			main::putserv($bot, "PRIVMSG $nick :$name.$hostname A set to $value");
 		} else {
 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to set DNS");
 		}
 	}
 }
+
+# !deldns username
 sub mdeldns {
 	my ($bot, $nick, $host, $hand, $text) = @_;
 	if (! (main::isstaff($bot, $nick))) { return; }
-	if ($text =~ /^([-0-9A-Za-z\.]+)/) {
-		if (setdns($text)) {
+	if ($text =~ /^([-0-9A-Za-z\.]+)$/) {
+		my ($name) = ($1);
+		if (setdns($name, $hostname)) {
 			main::putserv($bot, "PRIVMSG $nick :$text deleted");
 		} else {
 			main::putserv($bot, "PRIVMSG $nick :ERROR: failed to delete DNS records");
 		}
 	}
 }
+
+# !host username
 sub mhost {
 	my ($bot, $nick, $host, $hand, $text) = @_;
 	if (! (main::isstaff($bot, $nick))) { return; }
 	if ($text =~ /^([-0-9A-Za-z:\.]{3,})/) {
-		my ($hostname, $version) = ($1, $2);
+		my ($hostname) = ($1);
 		main::putserv($bot, "PRIVMSG $nick :".host($hostname));
 	}
 }
 
+# !nextdns username
 sub mnextdns {
 	my ($bot, $nick, $host, $hand, $text) = @_;
 	if (! (main::isstaff($bot, $nick))) { return; }
@@ -113,13 +115,22 @@ sub mnextdns {
 	}
 }
 
-# Given filename, return a list of ipv6 addresses
-sub readipv6s {
+# !readip6s
+sub mreadip6s {
+	my ($bot, $nick, $host, $hand, $text) = @_;
+	if (! (main::isstaff($bot, $nick))) { return; }
+	foreach my $line (readip6s($hostnameif)) {
+		print "$line\n"
+	}
+}
+
+# Return list of ipv6 addresses from filename
+sub readip6s {
 	my ($filename) = @_;
 	my @lines = main::readarray($filename);
 	my @ipv6s;
 	foreach my $line (@lines) {
-		if ($line =~ /^\s*inet6 (alias )?([0-9a-f:]{4,}) [0-9]+\s*$/i) {
+		if ($line =~ /^\s*inet6\s+(alias\s+)?([0-9a-f:]{4,})\s+[0-9]+\s*$/i) {
 			push(@ipv6s, $2);
 		} elsif ($line =~ /^\s*([0-9a-f:]{4,})\s*$/i) {
 			push(@ipv6s, $1);
@@ -128,27 +139,33 @@ sub readipv6s {
 	return @ipv6s;
 }
 
-# TODO: fix rdns request with buyvm's api, the ips must not skip 0s
-# returns true upon success, false upon failure
+# set rdns of $ip6 to $hostname given $subnet
+# return true on success; false on failure
 sub setrdns {
-	my ($ip, $hostname) = @_;
-	my $stdout = `curl -d \"key=$key&hash=$hash&action=rdns&ip=$ip&rdns=$hostname\" https://manage.buyvm.net/api/client/command.php`;
-	if ($stdout !~ /success/) {
-		return 0;
-	}
-        return 1;
+	my ($ip6, $subnet, $hostname) = @_;
+	my $digits = ip6full($ip6);
+	$digits =~ tr/://d;
+	my $reversed = reverse($digits);
+	my $origin = substr($reversed, 32-$subnet/4);
+	$origin = join('.', split(//, $origin)).".ip6.arpa";
+	my $name = substr($reversed, 0, 32-$subnet/4);
+	$name = join('.', split(//, $name));
+	# delete old PTR records, then set new one
+	return setdns($name, $origin) && setdns($name, $origin, "PTR", $hostname);
 }
-# set $domain to $ip if provided; otherwise, delete $domain
+# delete rdns of $ip6 given $subnet
+# return true on success; false on failure
+sub delrdns {
+	my ($ip6, $subnet) = @_;
+	return setrdns($ip6, $subnet);
+}
+
+# given $origin. create $name RR of $type and set to $value if provided;
+# if $value is missing, delete $domain
 # returns true upon success, false upon failure
 sub setdns {
-	my ($domain, $ip) = @_;
-	my $filename = "$zonedir/$hostname";
-	my $subdomain;
-	if ($domain =~ /^([a-zA-Z][-\.a-zA-Z0-9]+)\.$hostname$/) {
-		$subdomain = $1;
-	} else {
-		return 0;
-	}
+	my ($name, $origin, $type, $value) = @_;
+	my $filename = "$zonedir/$origin";
 	my @lines = main::readarray($filename);
 	foreach my $line (@lines) {
 		# increment the zone's serial number
@@ -159,12 +176,10 @@ sub setdns {
 			$line = $`.$date.sprintf("%02d",$serial).$3.$';
 		}
 	}
-	if ($ip =~ /^([0-9\.]+)$/) { # if IPv4
-        	push(@lines, "$subdomain	3600	IN	A	$ip");
-	} elsif ($ip =~ /:/) { # if IPv6
-        	push(@lines, "$subdomain	3600	IN	AAAA	$ip");
-	} elsif (!defined($ip)) { # delete records
-		@lines = grep !/\b$subdomain\s*3600\s*IN/, @lines;
+	if (!defined($value)) { # delete records
+		@lines = grep !/\b$name\s*3600\s*IN/, @lines;
+	} else {
+        	push(@lines, "$name	3600	IN	$type	$value");
 	}
 	# trailing newline necessary
 	main::writefile("$filename.bak", join("\n", @lines)."\n");
@@ -197,15 +212,56 @@ sub host {
 	return join(' ', @matches);
 }
 
+# Return an ipv6 address with all zeroes filled in
+sub ip6full {
+	my ($ip6) = @_;
+	my $left = substr($ip6, 0, index($ip6, "::"));
+	my $leftcolons = ($left =~ tr/://);
+	$ip6 =~ s{::}{:};
+	my @quartets = split(':', $ip6);
+	my $length = scalar(@quartets);
+	for (my $n = 1; $n <= 8 - $length; $n++) {
+		splice(@quartets, $leftcolons+1, 0, "0000");
+	}
+	my @newquartets = map(sprintf('%04s', $_), @quartets);
+	my $full = join(':',@newquartets);
+	return $full;
+}
+# Returns the network part of the first IPv6 address (indicated by subnet)
+# with the host part of the second IPv6 address
+sub ip6mask {
+        my ($ip6net, $subnet, $ip6host) = @_;
+        my $netdigits = ip6full($ip6net);
+        $netdigits =~ tr/://d;
+        my $hostdigits = ip6full($ip6host);
+        $hostdigits =~ tr/://d;
+        my $digits = substr($netdigits,0,($subnet/4)).substr($hostdigits,($subnet/4));
+        my $ip6;
+        for (my $n = 0; $n < 32; $n++) {
+                if ($n > 0 && $n % 4 == 0) {
+                        $ip6 .= ":";
+                }
+                $ip6 .= substr($digits,$n,1);
+        }
+        return $ip6;
+}
+sub randip6 {
+        return join ':', map { sprintf '%04x', rand 0x10000 } (1 .. 8);
+}
+
 # create A and AAAA records for subdomain, set the rDNS,
 # and return the new ipv6 address
 sub nextdns {
 	my ($subdomain) = @_;
-	my $ipv6 = shift(@ipv6s);
-	my $fqdn = "$subdomain.$hostname";
-	main::writefile($ipv6path, join("\n", @ipv6s));
-	if (setdns($fqdn, $ipv4) && setdns($fqdn, $ipv6) && setrdns($ipv6, $fqdn)) {
-		return "$ipv6";
+	my $newip6 = $ip6;
+	my @allip6s = readip6s($hostnameif);
+	while (grep(/$newip6/, @allip6s)) {
+		$newip6 = ip6mask($ip6, $ip6subnet,randip6());
+	}
+	main::appendfile($hostnameif, "inet6 alias $newip6 48\n");
+	`doas ifconfig vio0 inet6 $newip6/48`;
+	if (setdns($subdomain, $hostname, "A", $ip4) && setdns($subdomain, $hostname, "AAAA", $newip6) && setrdns($newip6, $ip6subnet, "$subdomain.$hostname")) {
+		return "$newip6";
 	}
 	return "false";
 }