Initial commit

This commit is contained in:
mischa 2023-04-30 17:15:42 +02:00
commit c49bbc503c
8 changed files with 1880 additions and 0 deletions

6
.gitignore vendored Normal file
View File

@ -0,0 +1,6 @@
change.pl
#records/*
#records-archive/*
#tokens/*
#zonefiles/*
#zonefiles-archive/*

38
clean.pl Executable file
View File

@ -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/ptrd.log';
flock $fh, LOCK_EX;
print $fh sprintf("%s %s: %s \n", strftime("%b %d %H:%M:%S", localtime), basename($0), $msg);
close $fh;
}

2
fetch-tlds.sh Executable file
View File

@ -0,0 +1,2 @@
#!/bin/sh
ftp -MV https://data.iana.org/TLD/tlds-alpha-by-domain.txt

105
parse.pl Executable file
View File

@ -0,0 +1,105 @@
#!/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/reverse";
my $v6_zone = "2a03.6000";
my $workdir = dirname($0);
my $serial;
my $serial_prev;
my $zonefile;
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 ($match, $rest) = split(' ', $replace, 2);
close $fh_ptr;
my $ip = new Net::IP($file);
if ($ip->overlaps($ipv4_range)) {
($zonefile = $file) =~ s/^((\d{1,3}\.){3})\d+$/${1}0/;
} elsif ($ip->overlaps($ipv6_range)) {
$zonefile = $v6_zone;
}
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/^${match}\s+IN\s+PTR\s+\S+( ;.*)?$/) {
if ($1) {
my $comment = $1;
$row =~ s/^${match}\s+.*$/${replace}${comment}/;
} else {
$row =~ s/^${match}\s+.*$/${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(rcctl reload nsd);
qx(rdist -f /etc/Distfile) if (-r '/etc/Distfile');
open my $fh_email, '|-', '/usr/sbin/sendmail -t';
print $fh_email "To: ptrd\@openbsd.amsterdam\n";
print $fh_email "From: ptrd\@openbsd.amsterdam\n";
print $fh_email "Subject: OpenBSD Amsterdam PTR $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/ptrd.log';
flock $fh, LOCK_EX;
print $fh sprintf("%s %s: %s \n", strftime("%b %d %H:%M:%S", localtime), basename($0), $msg);
close $fh;
}

223
ptrd.pl Executable file
View File

@ -0,0 +1,223 @@
#!/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;
GetOptions(
"listen=s" => \(my $LISTEN = "ptr4.openbsd.amsterdam"),
"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 ptr4.openbsd.amsterdam.
=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 PTR records of OpenBSD Amsterdam VMs.
A token needs to be requested before the PTR 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;
open my $fh_tlds, '<', "${workdir}/tlds-alpha-by-domain.txt";
chomp(my @tlds = <$fh_tlds>);
close $fh_tlds;
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);
my $tld = (defined($hostname) ? substr($hostname, rindex($hostname, '.')+1) : '');
$hostname = (!defined($hostname) ? $token : lc($hostname));
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 grep(/^${tld}$/i, @tlds) and ($hostname =~ /(?=^.{4,253}$)(^((?!-)[a-zA-Z0-9-]{1,63}(?<!-)\.)+[a-zA-Z]{2,63}$)/)) {
open my $fh, '>', "${workdir}/records/${client_ip}";
if ($ip->overlaps($ipv4_range)) {
my $ptr = substr($client_ip, rindex($client_ip, '.')+1);
print $fh sprintf("%s\t\tIN\tPTR\t%s.\n", $ptr, $hostname);
} elsif ($ip->overlaps($ipv6_range)) {
my $dig = qx(dig +short \@46.23.80.23 -x ${client_ip});
if (!$dig) {
$error = 1;
} else {
my $ptr = substr($ip->reverse_ip(), 0, 47);
print $fh sprintf("%s\tIN\tPTR\t%s.\n", $ptr, $hostname);
}
}
close $fh;
if ($error == 1) {
_log("$client_ip $token $hostname - PTR doesn't exist");
_http_response($c, {content_type => 'text/plain'}, "Error PTR [$client_ip] doesn't exist, please contact the administrator.");
$error = 0;
} else {
_log("$client_ip $token $hostname");
_http_response($c, {content_type => 'text/plain'}, "Received PTR [$client_ip -> $hostname] 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/ptrd.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 $!";
}

13
rc.d/ptrd4 Executable file
View File

@ -0,0 +1,13 @@
#!/bin/ksh
daemon="/home/runbsd/api/ptrd.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

13
rc.d/ptrd6 Executable file
View File

@ -0,0 +1,13 @@
#!/bin/ksh
daemon="/home/runbsd/api2/ptrd.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

1480
tlds-alpha-by-domain.txt Normal file

File diff suppressed because it is too large Load Diff