f220e71544
Quand le code appelle named-checkzone pour le contrôle de syntaxe DNS, les messages renvoyés par cet utilitaire de contrôle sont lus et interprétés, puis remontés à l’utilisateur. Ce n’est pas parfait et ça donne une espèce de franglais, mais ça suffira pour la démo et tant qu’on ne laisse pas les élèves manipuler directement les fichiers de zone. Dans le cas contraire, il faudra améliorer cela.
128 lines
3.2 KiB
Perl
128 lines
3.2 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");
|
||
|
||
# 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;
|