commit - /dev/null
commit + 178ebd8a074bdc2986f2cc10ddf3c69fe4058d33
blob - /dev/null
blob + 24a3b593cc1b0c987a56a4ce5bac1fac4eaffd8f (mode 644)
--- /dev/null
+++ .gitignore
+change.pl
blob - /dev/null
blob + de09fcea1171a044591f0bdc0a08e28675aa389b (mode 755)
--- /dev/null
+++ ard.pl
+#!/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 $!";
+}
blob - /dev/null
blob + 36f7784f6f86e351bc52094e02caa47053e41152 (mode 755)
--- /dev/null
+++ clean.pl
+#!/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;
+}
blob - /dev/null
blob + 2fbadcbaf15e959a332f594eccb691f5d040f837 (mode 755)
--- /dev/null
+++ parse.pl
+#!/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;
+}
+
blob - /dev/null
blob + e23c8a24ef5d57c757d9c840e7a7a1228d7a91b8 (mode 755)
--- /dev/null
+++ rc.d/ard4
+#!/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
blob - /dev/null
blob + 5e7d2734cfc60289debf74293817c0a8f572ff32 (mode 644)
--- /dev/null
+++ records/.gitignore
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore
blob - /dev/null
blob + 5e7d2734cfc60289debf74293817c0a8f572ff32 (mode 644)
--- /dev/null
+++ records-archive/.gitignore
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore
blob - /dev/null
blob + 5e7d2734cfc60289debf74293817c0a8f572ff32 (mode 644)
--- /dev/null
+++ tokens/.gitignore
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore
blob - /dev/null
blob + 5e7d2734cfc60289debf74293817c0a8f572ff32 (mode 644)
--- /dev/null
+++ zonefiles/.gitignore
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore
blob - /dev/null
blob + 5e7d2734cfc60289debf74293817c0a8f572ff32 (mode 644)
--- /dev/null
+++ zonefiles-archive/.gitignore
+# Ignore everything in this directory
+*
+# Except this file
+!.gitignore
