Initial commit

.gitignore

@@ -0,0 +1 @@
+change.pl

ard.pl

@@ -0,0 +1,208 @@
+#!/usr/bin/perl
+#
+use 5.024;
+use strict;
+use warnings;
+use autodie;
+use Digest::SHA qw(sha1_hex);
+use Fcntl qw(:flock);
+use File::Basename;
+use Getopt::Long;
+use POSIX qw(strftime WNOHANG);
+use Pod::Usage;
+use HTTP::Daemon;
+use HTTP::Response;
+use HTTP::Status;
+use Net::IP;
+
+my $domain = "high5.nl";
+
+GetOptions(
+	"listen=s" => \(my $LISTEN = "ar4.high5.nl"),
+	"port=i" => \(my $PORT = "80"),
+	"help" => \(my $HELP),
+	"man" => \(my $MAN),
+) or pod2usage(2);
+pod2usage(1) if $HELP; 
+pod2usage(-verbose => 2) if $MAN; 
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+ptrd.pl [options]
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-l> | --listen
+
+Address or hostname to listen on, default ar4.high5.nl.
+
+=item B<-p> | --port
+
+Port to listen on, default 80
+
+=back
+
+=head1 DESCRIPTION
+
+B<This program> is a Perl HTTP Daemon designed to listen for incoming A(AAA) records of High5! VMs.
+
+A token needs to be requested before the A(AAA) record can be set.
+
+=cut
+
+my %O = (
+	'listen-host' => $LISTEN,
+	'listen-port' => $PORT,
+	'listen-clients' => 10,
+	'listen-max-req-per-child' => 10000,
+);
+
+my $d = HTTP::Daemon->new(
+	LocalAddr => $O{'listen-host'},
+	LocalPort => $O{'listen-port'},
+	Reuse => 1,
+) or die "Can't start http listener at $O{'listen-host'}:$O{'listen-port'}";
+_log("Started HTTP listener at $LISTEN from " . dirname($0));
+
+my %chld;
+my $workdir = dirname($0);
+my $error = 0;
+
+$SIG{INT}  = \&signal_handler;
+$SIG{TERM} = \&signal_handler;
+
+if ($O{'listen-clients'}) {
+	$SIG{CHLD} = sub {
+		# checkout finished children
+		while ((my $kid = waitpid(-1, WNOHANG)) > 0) {
+			delete $chld{$kid};
+		}
+	};
+}
+
+while (1) {
+	if ($O{'listen-clients'}) {
+		# prefork all at once
+		for (scalar(keys %chld) .. $O{'listen-clients'} - 1 ) {
+			my $pid = fork;
+
+			if (!defined $pid) { # error
+				die "Can't fork for http child $_: $!";
+			}
+			if ($pid) { # parent
+				$chld{$pid} = 1;
+			} else { # child
+				$_ = 'DEFAULT' for @SIG{qw/ INT TERM CHLD /};
+				http_child($d);
+				exit;
+			}
+		}
+		sleep 1;
+	} else {
+		http_child($d);
+	}
+}
+
+sub http_child {
+	my $d = shift;
+	my $i;
+
+	while (++$i < $O{'listen-max-req-per-child'}) {
+		my $c = $d->accept or last;
+		my $r = $c->get_request(1) or last;
+		$c->autoflush(1);
+	
+		my $ipv4_range = new Net::IP("46.23.80.0/20");
+		my $ipv6_range = new Net::IP("2a03:6000::/29");
+
+		my $client_ip = $c->peerhost;
+		my $ip = new Net::IP($client_ip);
+		my ($first, $token, $hostname) = split(/\//, $r->uri->as_string);
+		$hostname = (!defined($hostname) ? $token : lc($hostname));
+		my $fqdn = "${hostname}.${domain}";
+
+		if ($ip->overlaps($ipv4_range) or $ip->overlaps($ipv6_range)) {
+
+			if ($token eq 'token') {
+				my $token = sha1_hex(int(rand(32)));
+				open my $fh_token, '>', "${workdir}/tokens/${token}";
+				print $fh_token "$client_ip\n";
+				close $fh_token;
+
+				_log("$client_ip $token");
+				_http_response($c, {content_type => 'text/plain'}, "$token");
+
+			} elsif (-e  "${workdir}/tokens/$token" and ($hostname =~ /^[a-zA-Z0-9-]{1,20}$/)) {
+
+				open my $fh, '>', "${workdir}/records/${client_ip}";
+				if ($ip->overlaps($ipv4_range)) {
+					print $fh sprintf("%s\t\tIN\tA\t%s\n", $hostname, $client_ip);
+
+				} elsif ($ip->overlaps($ipv6_range)) {
+					print $fh sprintf("%s\t\tIN\tAAAA\t%s\n", $hostname, $client_ip);
+				}
+				close $fh;
+
+				_log("$client_ip $token $hostname");
+				_http_response($c, {content_type => 'text/plain'}, "Received A(AAA) [$hostname -> $client_ip] will be processed asap.");
+
+			} elsif (!-e "${workdir}/tokens/$token" and defined($token)and $token ne 'token') {
+				_log("$client_ip RC_REQUEST_TIMEOUT $hostname");
+				_http_error($c, RC_REQUEST_TIMEOUT);
+
+			} else {
+				_log("$client_ip RC_BAD_REQUEST $hostname");
+				_http_error($c, RC_BAD_REQUEST);
+			}
+
+		} else {
+			#print sprintf("%s %s: %s RC_FORBIDDEN\n", $date, $0, $client_ip);
+			_log("$client_ip RC_FORBIDDEN");
+			_http_error($c, RC_FORBIDDEN);
+		}
+
+		$c->close();
+		undef $c;
+	}
+}
+
+sub _http_error {
+	my ($c, $code, $msg) = @_;
+	$c->send_error($code, $msg);
+}
+
+sub _http_response {
+	my $c = shift;
+	my $header = shift;
+	my $content = shift;
+	$c->send_response(
+		HTTP::Response->new(
+			RC_OK,
+			undef,
+			[
+				'Content-Type' => $header->{content_type},
+				'Cache-Control' => 'no-store, no-cache, must-revalidate, post-check=0, pre-check=0',
+				'Pragma' => 'no-cache',
+				'Expires' => 'Wed, 29 Feb 1984 13:37:00 GMT',
+			],
+			"$content\r\n",
+		)
+	);
+}
+
+sub _log {
+	my ($msg) = @_;
+	open my $fh, '>>', '/var/log/ard.log';
+	flock $fh, LOCK_EX;
+	print $fh sprintf("%s %s: %s \n", strftime("%b %d %H:%M:%S", localtime), basename($0), $msg);
+	close $fh;
+}
+
+sub signal_handler {
+	_log("Caught a signal $!");
+	die "Caught a signal $!";
+}

clean.pl

@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+#
+use 5.024;
+use strict;
+use warnings;
+use autodie;
+use Fcntl qw(:flock);
+use File::Basename;
+use File::stat;
+use POSIX qw(strftime);
+
+my $ttl = "300";
+my $workdir = dirname($0);
+
+opendir my $dh, "${workdir}/tokens";
+while (my $file = readdir $dh) {
+	chomp $file;
+	next if $file =~ /^\./;
+
+	open my $fh, '<', "${workdir}/tokens/$file";
+	my $client_ip = <$fh>;
+	chomp $client_ip;
+	close $fh;
+
+	my $mtime = stat("${workdir}/tokens/${file}")->mtime();
+	if ((time() - $mtime) > $ttl) {
+		_log("$client_ip $file removed");
+		unlink("${workdir}/tokens/${file}");
+	}
+}
+
+sub _log {
+	my ($msg) = @_;
+	open my $fh, '>>', '/var/log/ard.log';
+	flock $fh, LOCK_EX;
+	print $fh sprintf("%s %s: %s \n", strftime("%b %d %H:%M:%S", localtime), basename($0), $msg);
+	close $fh;
+}

parse.pl

@@ -0,0 +1,98 @@
+#!/usr/bin/env perl
+#
+use 5.024;
+use strict;
+use warnings;
+use autodie;
+use Fcntl qw(:flock);
+use File::Basename;
+use File::Copy;
+use POSIX qw(strftime);
+use Net::IP;
+
+my $ipv4_range = new Net::IP("46.23.80.0/20");
+my $ipv6_range = new Net::IP("2a03:6000::/29");
+my $nsd = "/var/nsd/zones/master";
+my $zonefile = "high5.nl";
+my $workdir = dirname($0);
+my $serial;
+my $serial_prev;
+
+opendir my $dh, "${workdir}/records";
+while (my $file = readdir $dh) {
+	chomp $file;
+	next if $file =~ /^\./;
+
+	open my $fh_ptr, '<', "${workdir}/records/$file";
+	my $replace = <$fh_ptr>;
+	chomp $replace;
+	my ($_hostname, $_in, $_a, $match) = split(' ', $replace, 4);
+	close $fh_ptr;
+
+	if (qx(rlog ${nsd}/${zonefile} | grep 'locked by') =~ m/locked by/) {
+		_log("$file zone file locked, trying again later...");
+		next;
+	} else {
+		open my $fh_in, '<', "${nsd}/$zonefile";
+		open my $fh_out, '>', "${workdir}/zonefiles/$zonefile";
+		while (my $row = <$fh_in>) {
+			chomp $row; 
+			if ($row =~ m/^\s*(\d+)\s*; serial$/) {
+				$serial = $serial_prev = $1;
+				my $timestamp = strftime ("%Y%m%d", localtime()) . "01";
+				if ($serial < $timestamp) {
+					$serial = $timestamp;
+				} else {
+					$serial++;
+				}
+				$row =~ s/${serial_prev}/${serial}/;
+			}
+
+			if ($row =~ m/^[0-9a-z-]+\s+IN\s+A{1,4}\s+${match}( ;.*)?$/) {
+				if ($1) {
+					my $comment = $1;
+					$row =~ s/^.*\s+${match}.*$/${replace}${comment}/;
+				} else {
+					$row =~ s/^.*\s+${match}.*$/${replace}/;
+				}
+			}
+			print $fh_out "$row\n";
+		}
+		close $fh_in;
+		close $fh_out;
+
+		(my $diff = qx(diff ${nsd}/${zonefile} ${workdir}/zonefiles/${zonefile} | wc -l)) =~ s/^\s*(.*?)\s*$/$1/;
+		if ($diff == 8) {
+			_log("$file diff within limits ($diff), $serial_prev -> $serial");
+			copy("${nsd}/${zonefile}", "${workdir}/zonefiles-archive/${zonefile}-${serial}");
+			qx(co -q -l ${nsd}/${zonefile});
+			copy("${workdir}/zonefiles/${zonefile}", "${nsd}/${zonefile}");
+			qx(ci -q -u -m"updated for ${file}" ${nsd}/${zonefile});
+			move("${workdir}/records/${file}", "${workdir}/records-archive/${file}-${serial}");
+
+			qx(${workdir}/../bin/auto-sign.sh ${zonefile});
+			qx(rcctl reload nsd);
+			qx(rdist -f /etc/Distfile) if (-r '/etc/Distfile');
+
+			open my $fh_email, '|-', '/usr/sbin/sendmail -t';
+			print $fh_email "To: ard\@high5.nl\n";
+			print $fh_email "From: ard\@high5.nl\n";
+			print $fh_email "Subject: High5! A(AAA) $zonefile\n";
+			print $fh_email "Content-Type: text/plain; charset=utf-8\n\n";
+			print $fh_email "$serial_prev -> $serial\n$file\n$replace\n";
+			close $fh_email;
+		} else {
+			_log("$file diff is outside limits ($diff), cleaning up");
+			unlink("${workdir}/records/${file}", "${workdir}/zonefiles/${zonefile}");
+		}
+	}
+}
+
+sub _log {
+	my ($msg) = @_;
+	open my $fh, '>>', '/var/log/ard.log';
+	flock $fh, LOCK_EX;
+	print $fh sprintf("%s %s: %s \n", strftime("%b %d %H:%M:%S", localtime), basename($0), $msg);
+	close $fh;
+}
+

rc.d/ard4

@@ -0,0 +1,13 @@
+#!/bin/ksh
+
+daemon="/home/runbsd/ard/ard.pl"
+
+. /etc/rc.d/rc.subr
+
+pexp="$(eval echo ${daemon}${daemon_flags:+ ${daemon_flags}})"
+rc_bg="YES" 
+rc_reload="NO"
+
+pexp="/usr/bin/perl ${daemon}${daemon_flags:+ ${daemon_flags}}"
+
+rc_cmd $1

records-archive/.gitignore

@@ -0,0 +1,4 @@
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore

records/.gitignore

@@ -0,0 +1,4 @@
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore

tokens/.gitignore

@@ -0,0 +1,4 @@
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore

zonefiles-archive/.gitignore

@@ -0,0 +1,4 @@
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore

zonefiles/.gitignore

@@ -0,0 +1,4 @@
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore