247 lines
6.4 KiB
Perl
Executable File
247 lines
6.4 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# Copyright (c) 2023 Mischa Peters <mischa @ openbsd.amsterdam>
|
|
#
|
|
# Permission to use, copy, modify, and distribute this software for any
|
|
# purpose with or without fee is hereby granted, provided that the above
|
|
# copyright notice and this permission notice appear in all copies.
|
|
#
|
|
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
|
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
|
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
|
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
|
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
#
|
|
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));
|
|
my $protected = system("pfctl -qt protected -T test $client_ip 2> /dev/null");
|
|
|
|
if ($ip->overlaps($ipv4_range) or $ip->overlaps($ipv6_range)) {
|
|
|
|
if ($token eq 'token' and $protected) {
|
|
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 ($token eq 'protect') {
|
|
my $protect = qx(pfctl -t protected -T add $client_ip 2>&1);
|
|
chomp $protect;
|
|
qx(pfctl -t protected -T show > /etc/pf.protected);
|
|
|
|
_log("$client_ip $token $protect");
|
|
_http_response($c, {content_type => 'text/plain'}, "Received [$client_ip -> protect] $protect");
|
|
|
|
} 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}$)/) and $protected) {
|
|
|
|
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 ($protected)");
|
|
_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 $!";
|
|
}
|