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 %] + + [% 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;