Éditeur de zone : meilleurs messages de diagnostic

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.
This commit is contained in:
Marc van der Wal 2023-10-25 15:50:31 +02:00
parent 9c18d03852
commit f220e71544
5 changed files with 185 additions and 38 deletions

View File

@ -71,6 +71,7 @@ RUN apk add perl-io-socket-ssl perl-lwp-protocol-https
RUN cpanm -n -v \
Dancer2 \
Dancer2::Plugin::Deferred \
REST::Client \
Module::Pluggable::Object

View File

@ -1,5 +1,6 @@
package Email::SpoofingDemo::Web;
use Dancer2;
use Dancer2::Plugin::Deferred;
use JSON;
use REST::Client;
@ -43,13 +44,13 @@ get '/' => sub {
get '/dns/zone-edit/:zone' => sub {
my $zone = route_parameters->get('zone');
if (defined $zone and not (grep { $_ eq $zone } @{config->{'editable_zones'}})) {
if (not (grep { $_ eq $zone } @{config->{'editable_zones'}})) {
pass;
}
my $zone_contents;
my $zone_contents = deferred 'zone_contents';
if (defined $zone) {
if (not defined $zone_contents) {
my ($response, $status) = call_api(GET => 'dns', "/zone/${zone}/file");
$zone_contents = $response->{contents};
}
@ -68,10 +69,18 @@ post '/dns/zone-edit/:zone' => sub {
}
my $contents = body_parameters->{'zone-contents'};
my (undef, $status) = call_api(PUT => 'dns', "/zone/${zone}/file", { contents => $contents });
my $success = ($status eq '200') ? 'success' : 'failure';
my ($data, $status) = call_api(PUT => 'dns', "/zone/${zone}/file", { contents => $contents });
redirect "/dns/zone-edit/$zone?success=$success", 303;
if ($status ne '200') {
$data = decode_json($data);
}
deferred status => {
outcome => $data->{outcome},
messages => $data->{messages},
};
deferred zone_contents => $data->{contents};
redirect "/dns/zone-edit/$zone", 303;
};
get '/sender/dkim-keys' => sub {

View File

@ -1,4 +1,36 @@
<div class="container">
[% IF deferred.status %]
[%
outcome_map = {
ok => {
color => 'success',
message => 'Les modifications ont été prises en compte.'
},
ok_with_warnings => {
color => 'warning',
message => 'Les modifications ont été prises en compte, mais avec les réserves suivantes:'
},
failure => {
color => 'danger',
message => 'La zone contient des erreurs ; les modifications nont pas été prises en compte.'
}
}
outcome_info = outcome_map.item(deferred.status.outcome)
%]
<div class="alert alert-[% outcome_info.color %] pb-1">
<p>[% outcome_info.message %]</p>
[% IF deferred.status.messages.size > 1 %]
<ul>
[% FOR m IN deferred.status.messages %]
<li>[% m | html %]</li>
[% END %]
</ul>
[% ELSIF deferred.status.messages.size == 1 %]
<p>[% deferred.status.messages.first | html %]</p>
[% END %]
</div>
[% END %]
<div class="row mt-3 mb-4">
<main class="col">
<form id="edit-form" method="POST">

View File

@ -30,19 +30,34 @@ prefix '/zone/:zone' => 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 sil 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 "missing zone file contents";
return {
outcome => 'failure',
messages => ['La zone semble être vide.'],
contents => $contents
};
}
my $result = import_zone_file($zone, $base_dir, $contents, $dynamic_zones);
if ($result) {
return;
}
else {
my ($outcome, $messages) = import_zone_file($zone, $base_dir, $contents, $dynamic_zones);
if ($outcome eq 'failure') {
status 'bad_request';
return "bad zone file";
}
return {
outcome => $outcome,
messages => $messages,
contents => $contents
};
};
get '/spf' => sub {

View File

@ -7,6 +7,7 @@ use utf8;
use v5.10;
use Exporter qw(import);
use IPC::Open2;
use File::Slurp;
use Try::Tiny;
@ -160,14 +161,102 @@ sub remove_txt {
"send");
}
sub parse_named_checkzone_output {
my ($line, $previous_messages) = @_;
chomp $line;
if ($line =~ /^OK$/) {
# On regarde déjà le code de sortie de la commande named-checkzone,
# donc un message "OK" najoute aucune information.
return undef;
}
elsif ($line =~ /^zone [^:]+: (.*)$/) {
my $msg = $1;
# Ce pattern accompagne parfois des messages derreur précédents, mais
# pas toujours. On ne conserve ce message que sil ny en a pas eu
# dautres avant.
if ($msg =~ /loading from master file \(null\) failed: (.*)$/) {
my $zone_error = $1;
if (grep { $_ =~ qr/\Q$zone_error\E$/ } @$previous_messages) {
return undef;
}
else {
return $zone_error;
}
}
# Ce pattern accompagne des messages derreur précédents,
# et najoute donc aucune information.
return undef if ($msg eq 'not loaded due to errors.');
# Renvoyé en cas de réussite
return undef if ($msg =~ /loaded serial \d+/);
# Cas de tout autre message
return $line;
}
elsif ($line =~ /stream-0x[0-9a-f]+/) {
# named-checkzone préfixe parfois ses messages derreur par des noms
# de fonctions internes. On ne les conserve pas, car ce sont des
# détails internes pas très user-friendly.
$line =~ s/^dns_(?:master_load|rdata_fromtext): //;
# Comme named-checkzone a lu le fichier de zones à travers un pipe,
# named-checkzone rapporte en guise de nom de fichier un truc opaque
# pas très user-friendly quil vaut mieux supprimer. Mais on conserve
# bien entendu le numéro de la ligne !
$line =~ s/stream-0x[0-9a-f]+:(\d+):/Ligne $1:/;
$line =~ s/stream-0x[0-9a-f]+:\s*//;
# Est-ce si grave si le fichier ne finit pas par une fin de ligne ?
return undef if $line =~ /file does not end with newline/;
return $line;
}
else {
return $line;
}
}
sub check_zone {
my ($zone_contents, $origin) = @_;
open(my $pipe, '|-', 'named-checkzone', $origin, '-') or die "Cant fork: $!";
print $pipe $zone_contents;
close($pipe);
if ($zone_contents =~ /^\$INCLUDE\s+/ms) {
return 'failure', ['Refusing to load zone file containing $INCLUDE'];
}
return (($? >> 8) == 0);
my $pid = open2(my $pipe_out, my $pipe_in,
'named-checkzone', $origin, '-');
print $pipe_in $zone_contents;
close($pipe_in);
my @messages;
while (<$pipe_out>)
{
chomp;
my $line = parse_named_checkzone_output($_, \@messages);
push @messages, $line if defined $line;
}
waitpid($pid, 0);
my $exit_status = ($? >> 8);
my $outcome;
if ($exit_status != 0) {
$outcome = 'failure';
}
elsif (scalar @messages) {
$outcome = 'ok_with_warnings';
}
else {
$outcome = 'ok';
}
return ($outcome, \@messages);
}
sub zone_file_path {
@ -205,35 +294,36 @@ sub import_zone_file {
my ($zone, $base_dir, $contents, $dynamic_zones) = @_;
if ($contents =~ /^\s*$/) {
warn "Zone to import is empty";
return undef;
return "failure", ["Zone to import is empty"];
}
my $path = zone_file_path($zone, $base_dir);
if (not defined $path) {
warn "No zone file for $zone in $base_dir";
return undef;
return "failure", ["No zone file for $zone in $base_dir"];
}
if (not check_zone($contents, $zone)) {
warn "Zone file contents do not pass syntax check";
return undef;
my ($outcome, $messages) = check_zone($contents, $zone);
if ($outcome ne 'failure') {
rndc_freeze($zone) if is_dynamic_zone($zone, $dynamic_zones);
try {
write_file($path, $contents);
unless (is_dynamic_zone($zone, $dynamic_zones)) {
rndc_reload($zone);
}
}
catch {
return 'failure', [$_];
}
finally {
if (is_dynamic_zone($zone, $dynamic_zones)) {
rndc_thaw($zone);
}
};
}
rndc_freeze($zone) if is_dynamic_zone($zone, $dynamic_zones);
try {
write_file($path, $contents);
rndc_reload($zone) unless is_dynamic_zone($zone, $dynamic_zones);
}
catch {
die $_;
}
finally {
rndc_thaw($zone) if is_dynamic_zone($zone, $dynamic_zones);
};
return 1;
return $outcome, $messages;
}
1;