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

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");

        # Convertir le fichier de zone aux fins de ligne UNIX et ajouter un
        # retour chariot final s’il y en a pas déjà un, pour éviter des
        # erreurs absconses
        $contents =~ s/\r\n/\n/g;
        $contents =~ s/\n?$/\n/;

        my @lines = split(/\r?\n/, $contents);

        if (not defined $contents) {
            status 'bad_request';
            return {
                outcome => 'failure',
                messages => ['La zone semble être vide.'],
                contents => $contents
            };
        }

        my ($outcome, $messages) = import_zone_file($zone, $base_dir, $contents, $dynamic_zones);

        if ($outcome eq 'failure') {
            status 'bad_request';
        }

        return {
            outcome => $outcome,
            messages => $messages,
            contents => $contents
        };
    };

    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;