From f220e71544d46ef03e1d6c4d77f83280647685f8 Mon Sep 17 00:00:00 2001 From: Marc van der Wal Date: Wed, 25 Oct 2023 15:50:31 +0200 Subject: [PATCH] =?UTF-8?q?=C3=89diteur=20de=20zone=E2=80=AF:=20meilleurs?= =?UTF-8?q?=20messages=20de=20diagnostic?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- console/Dockerfile | 1 + console/web-api/lib/Email/SpoofingDemo/Web.pm | 21 ++- console/web-api/views/dns/zone-edit.tt | 32 ++++ dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm | 29 +++- .../lib/Email/SpoofingDemo/DNS/ZoneFile.pm | 140 ++++++++++++++---- 5 files changed, 185 insertions(+), 38 deletions(-) diff --git a/console/Dockerfile b/console/Dockerfile index 13aa430..da77dd9 100644 --- a/console/Dockerfile +++ b/console/Dockerfile @@ -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 diff --git a/console/web-api/lib/Email/SpoofingDemo/Web.pm b/console/web-api/lib/Email/SpoofingDemo/Web.pm index d50d069..4dd0972 100644 --- a/console/web-api/lib/Email/SpoofingDemo/Web.pm +++ b/console/web-api/lib/Email/SpoofingDemo/Web.pm @@ -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 { diff --git a/console/web-api/views/dns/zone-edit.tt b/console/web-api/views/dns/zone-edit.tt index f92d7ea..12d221b 100644 --- a/console/web-api/views/dns/zone-edit.tt +++ b/console/web-api/views/dns/zone-edit.tt @@ -1,4 +1,36 @@
+ [% 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 n’ont pas été prises en compte.' + } + } + + outcome_info = outcome_map.item(deferred.status.outcome) + %] +
+

[% outcome_info.message %]

+ [% IF deferred.status.messages.size > 1 %] +
    + [% FOR m IN deferred.status.messages %] +
  • [% m | html %]
    • + [% END %] +
+ [% ELSIF deferred.status.messages.size == 1 %] +

[% deferred.status.messages.first | html %]

+ [% END %] +
+ [% END %]
diff --git a/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm b/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm index b84cfc1..23310a2 100644 --- a/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm +++ b/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm @@ -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 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 "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 { diff --git a/dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm b/dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm index 7235d48..64db9a2 100644 --- a/dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm +++ b/dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm @@ -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" n’ajoute aucune information. + return undef; + } + elsif ($line =~ /^zone [^:]+: (.*)$/) { + my $msg = $1; + + # Ce pattern accompagne parfois des messages d’erreur précédents, mais + # pas toujours. On ne conserve ce message que s’il n’y en a pas eu + # d’autres 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 d’erreur précédents, + # et n’ajoute 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 d’erreur 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 qu’il 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 "Can’t 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;