spf-dkim-dmarc-demo/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm

113 lines
2.7 KiB
Perl

package Email::SpoofingDemo::API::DNS;
use Dancer2;
use Email::SpoofingDemo::DNS::ZoneFile
qw(get_txt get_zone_file import_zone_file remove_txt set_txt
zone_file_path);
our $VERSION = '0.1';
my $base_dir = config->{'zone_directory'};
my $dynamic_zones = config->{'dynamic_zones'};
get '/' => sub { return "Welcome"; };
prefix '/zone/:zone' => sub {
get '/file' => sub {
my $zone = route_parameters->get('zone');
if (zone_file_path($zone, $base_dir)) {
my $contents = get_zone_file($zone, $base_dir, $dynamic_zones);
return { contents => $contents };
}
else {
status 'not_found';
return "$zone: not found";
}
};
put '/file' => sub {
my $zone = route_parameters->get('zone');
my $contents = body_parameters->get("contents");
if (not defined $contents) {
status 'bad_request';
return "missing zone file contents";
}
my $result = import_zone_file($zone, $base_dir, $contents, $dynamic_zones);
if ($result) {
return;
}
else {
status 'bad_request';
return "bad zone file";
}
};
get '/spf' => sub {
my $zone = route_parameters->get('zone');
my @spfs = get_txt($zone, "", qr/v=spf1(\s+|\Z)/i, 1);
my %result;
for my $rec (@spfs) {
$result{$rec->{owner}} = $rec->{txt};
}
return \%result;
};
put '/spf' => sub {
my $zone = route_parameters->get('zone');
my $spf = body_parameters->get('spf');
status (set_txt($zone, "", $spf) ? 'ok' : 'forbidden');
};
del '/spf' => sub {
my $zone = route_parameters->get('zone');
status (remove_txt($zone, "") ? 'ok' : 'not_found');
};
get '/domainkey' => sub {
my $zone = route_parameters->get('zone');
my @dkims = get_txt($zone, "", qr/^v=DKIM1/, 1);
my %domainkeys;
for my $rec (@dkims) {
if ($rec->{owner} =~ /^(.+)\._domainkey\.(.*)$/i) {
my $selector = $1;
my $subzone = $2;
$domainkeys{$subzone}{$selector} = $rec->{txt};
}
}
return \%domainkeys;
};
get '/dmarc' => sub {
my $zone = route_parameters->get('zone');
my @dmarcs = get_txt($zone, "", qr/^v=DMARC1/, 1);
my %result;
for my $rec (@dmarcs) {
if ($rec->{owner} =~ /^_dmarc\.(.*)$/) {
my $domain = $1;
$result{$domain} = $rec->{txt};
}
}
return \%result;
};
};
any qr{.*} => sub { status 'not_found'; return "Invalid route" };
dance;
true;