From 31f08bb3294f55a7745dcaa5c86a79ded02f7f8e Mon Sep 17 00:00:00 2001 From: Marc van der Wal Date: Wed, 25 Oct 2023 15:50:22 +0200 Subject: [PATCH] API REST pour le conteneur DNS --- dns/Dockerfile | 50 ++++ dns/etc/s6-overlay/s6-rc.d/api/run | 2 + dns/etc/s6-overlay/s6-rc.d/api/type | 1 + .../s6-overlay/s6-rc.d/user/contents.d/api | 0 dns/web-api/.dancer | 0 dns/web-api/MANIFEST | 24 ++ dns/web-api/MANIFEST.SKIP | 17 ++ dns/web-api/Makefile.PL | 26 ++ dns/web-api/bin/app.psgi | 9 + dns/web-api/config.yml | 13 + dns/web-api/cpanfile | 11 + dns/web-api/environments/development.yml | 15 ++ dns/web-api/environments/production.yml | 16 ++ dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm | 112 ++++++++ .../lib/Email/SpoofingDemo/DNS/ZoneFile.pm | 239 ++++++++++++++++++ dns/web-api/public/dispatch.cgi | 16 ++ dns/web-api/public/dispatch.fcgi | 18 ++ 17 files changed, 569 insertions(+) create mode 100644 dns/etc/s6-overlay/s6-rc.d/api/run create mode 100644 dns/etc/s6-overlay/s6-rc.d/api/type create mode 100644 dns/etc/s6-overlay/s6-rc.d/user/contents.d/api create mode 100644 dns/web-api/.dancer create mode 100644 dns/web-api/MANIFEST create mode 100644 dns/web-api/MANIFEST.SKIP create mode 100644 dns/web-api/Makefile.PL create mode 100644 dns/web-api/bin/app.psgi create mode 100644 dns/web-api/config.yml create mode 100644 dns/web-api/cpanfile create mode 100644 dns/web-api/environments/development.yml create mode 100644 dns/web-api/environments/production.yml create mode 100644 dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm create mode 100644 dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm create mode 100644 dns/web-api/public/dispatch.cgi create mode 100644 dns/web-api/public/dispatch.fcgi diff --git a/dns/Dockerfile b/dns/Dockerfile index 471d9cc..6b3411d 100644 --- a/dns/Dockerfile +++ b/dns/Dockerfile @@ -11,10 +11,60 @@ RUN apk add \ s6-overlay \ vim +# Dependencies for REST API +RUN apk add \ + gcc \ + libc-dev \ + make \ + perl-app-cpanminus \ + perl-clone \ + perl-config-any \ + perl-data-optlist \ + perl-dev \ + perl-exporter-tiny \ + perl-extutils-config \ + perl-extutils-helpers \ + perl-extutils-installpaths \ + perl-file-sharedir \ + perl-file-sharedir-install \ + perl-file-slurp \ + perl-file-which \ + perl-hash-merge-simple \ + perl-hash-multivalue \ + perl-http-date \ + perl-http-headers-fast \ + perl-import-into \ + perl-json-maybexs \ + perl-module-build \ + perl-module-build-tiny \ + perl-module-implementation \ + perl-module-runtime \ + perl-moo \ + perl-params-util \ + perl-params-validate \ + perl-path-tiny \ + perl-plack \ + perl-readonly \ + perl-ref-util \ + perl-role-tiny \ + perl-safe-isa \ + perl-sub-exporter \ + perl-sub-install \ + perl-sub-quote \ + perl-template-toolkit \ + perl-type-tiny \ + perl-yaml + +RUN cpanm -n -v \ + Dancer2 \ + Module::Pluggable::Object + RUN install -o named -g root -m 0755 -d /var/db/bind COPY --chown=named:root etc/bind/named.conf /etc/bind/named.conf COPY --chown=named:root zones /etc/bind/zones +COPY web-api /src/api + COPY etc/s6-overlay /etc/s6-overlay ENTRYPOINT ["/init"] diff --git a/dns/etc/s6-overlay/s6-rc.d/api/run b/dns/etc/s6-overlay/s6-rc.d/api/run new file mode 100644 index 0000000..2d9058d --- /dev/null +++ b/dns/etc/s6-overlay/s6-rc.d/api/run @@ -0,0 +1,2 @@ +#!/bin/execlineb -P +/usr/bin/env perl /src/api/bin/app.psgi \ No newline at end of file diff --git a/dns/etc/s6-overlay/s6-rc.d/api/type b/dns/etc/s6-overlay/s6-rc.d/api/type new file mode 100644 index 0000000..1780f9f --- /dev/null +++ b/dns/etc/s6-overlay/s6-rc.d/api/type @@ -0,0 +1 @@ +longrun \ No newline at end of file diff --git a/dns/etc/s6-overlay/s6-rc.d/user/contents.d/api b/dns/etc/s6-overlay/s6-rc.d/user/contents.d/api new file mode 100644 index 0000000..e69de29 diff --git a/dns/web-api/.dancer b/dns/web-api/.dancer new file mode 100644 index 0000000..e69de29 diff --git a/dns/web-api/MANIFEST b/dns/web-api/MANIFEST new file mode 100644 index 0000000..aada075 --- /dev/null +++ b/dns/web-api/MANIFEST @@ -0,0 +1,24 @@ +MANIFEST +MANIFEST.SKIP +.dancer +Makefile.PL +config.yml +cpanfile +views/index.tt +views/layouts/main.tt +lib/Email/SpoofingDemo/API/DNS.pm +t/002_index_route.t +t/001_base.t +environments/production.yml +environments/development.yml +bin/app.psgi +public/500.html +public/dispatch.cgi +public/dispatch.fcgi +public/favicon.ico +public/404.html +public/javascripts/jquery.js +public/css/error.css +public/css/style.css +public/images/perldancer-bg.jpg +public/images/perldancer.jpg diff --git a/dns/web-api/MANIFEST.SKIP b/dns/web-api/MANIFEST.SKIP new file mode 100644 index 0000000..bbfb365 --- /dev/null +++ b/dns/web-api/MANIFEST.SKIP @@ -0,0 +1,17 @@ +^\.git\/ +maint +^tags$ +.last_cover_stats +Makefile$ +^blib +^pm_to_blib +^.*.bak +^.*.old +^t.*sessions +^cover_db +^.*\.log +^.*\.swp$ +MYMETA.* +^.gitignore +^.svn\/ +^Email-SpoofingDemo-API-DNS- diff --git a/dns/web-api/Makefile.PL b/dns/web-api/Makefile.PL new file mode 100644 index 0000000..ba7d937 --- /dev/null +++ b/dns/web-api/Makefile.PL @@ -0,0 +1,26 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +# Normalize version strings like 6.30_02 to 6.3002, +# so that we can do numerical comparisons on it. +my $eumm_version = $ExtUtils::MakeMaker::VERSION; +$eumm_version =~ s/_//; + +WriteMakefile( + NAME => 'Email::SpoofingDemo::API::DNS', + AUTHOR => q{Marc van der Wal }, + VERSION_FROM => 'lib/Email/SpoofingDemo/API/DNS.pm', + ABSTRACT => 'Email spoofing demo: REST API for DNS', + ($eumm_version >= 6.3001 + ? ('LICENSE'=> 'all-rights-reserved') + : ()), + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'YAML' => 0, + 'Dancer2' => 0.300000, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Email-SpoofingDemo-API-DNS-*' }, +); diff --git a/dns/web-api/bin/app.psgi b/dns/web-api/bin/app.psgi new file mode 100644 index 0000000..ec13ad1 --- /dev/null +++ b/dns/web-api/bin/app.psgi @@ -0,0 +1,9 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Email::SpoofingDemo::API::DNS; +Email::SpoofingDemo::API::DNS->to_app; diff --git a/dns/web-api/config.yml b/dns/web-api/config.yml new file mode 100644 index 0000000..bb2bdfc --- /dev/null +++ b/dns/web-api/config.yml @@ -0,0 +1,13 @@ + +appname: "Email::SpoofingDemo::API::DNS" +charset: "UTF-8" +serializer: JSON + +# App-specific configuration + +# Directory in where zone files reside +zone_directory: "/etc/bind/zones" + +# List of dynamic zones, requiring special treatment +dynamic_zones: + - "expediteur.example" diff --git a/dns/web-api/cpanfile b/dns/web-api/cpanfile new file mode 100644 index 0000000..28436b4 --- /dev/null +++ b/dns/web-api/cpanfile @@ -0,0 +1,11 @@ +requires "Dancer2" => "0.300000"; + +recommends "YAML" => "0"; +recommends "URL::Encode::XS" => "0"; +recommends "CGI::Deurl::XS" => "0"; +recommends "HTTP::Parser::XS" => "0"; + +on "test" => sub { + requires "Test::More" => "0"; + requires "HTTP::Request::Common" => "0"; +}; diff --git a/dns/web-api/environments/development.yml b/dns/web-api/environments/development.yml new file mode 100644 index 0000000..fe8dc03 --- /dev/null +++ b/dns/web-api/environments/development.yml @@ -0,0 +1,15 @@ +# configuration file for development environment + +logger: "console" +log: "core" + +# should Dancer2 consider warnings as critical errors? +warnings: 1 + +# should Dancer2 show a stacktrace when an 5xx error is caught? +# if set to yes, public/500.html will be ignored and either +# views/500.tt, 'error_template' template, or a default error template will be used. +show_errors: 1 + +# print the banner +startup_info: 1 diff --git a/dns/web-api/environments/production.yml b/dns/web-api/environments/production.yml new file mode 100644 index 0000000..41b436f --- /dev/null +++ b/dns/web-api/environments/production.yml @@ -0,0 +1,16 @@ +# configuration file for production environment + +# only log warning and error messsages +log: "warning" + +# log message to a file in logs/ +logger: "file" + +# don't consider warnings critical +warnings: 0 + +# hide errors +show_errors: 0 + +# disable server tokens in production environments +no_server_tokens: 1 diff --git a/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm b/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm new file mode 100644 index 0000000..b84cfc1 --- /dev/null +++ b/dns/web-api/lib/Email/SpoofingDemo/API/DNS.pm @@ -0,0 +1,112 @@ +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"); + + if (not defined $contents) { + status 'bad_request'; + return "missing zone file contents"; + } + + my $result = import_zone_file($zone, $base_dir, $contents, $dynamic_zones); + if ($result) { + return; + } + else { + status 'bad_request'; + return "bad zone file"; + } + }; + + 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; diff --git a/dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm b/dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm new file mode 100644 index 0000000..7235d48 --- /dev/null +++ b/dns/web-api/lib/Email/SpoofingDemo/DNS/ZoneFile.pm @@ -0,0 +1,239 @@ + +package Email::SpoofingDemo::DNS::ZoneFile; + +use strict; +use warnings; +use utf8; +use v5.10; + +use Exporter qw(import); + +use File::Slurp; +use Try::Tiny; + +our @EXPORT_OK = qw(get_txt get_zone_file import_zone_file remove_txt set_txt + zone_file_path); + +sub safe_system { + my @argv = @_; + my $retval = system @argv; + die $! if ($retval == -1); + if ($retval != 0) { + my $status = $retval >> 8; + die join(" ", @argv) . " exited with status $status\n"; + }; + return 1; +} + +sub is_dynamic_zone { + my ($zone, $dynamic_zones) = @_; + + return grep { $_ eq $zone } @$dynamic_zones; +} + +sub rndc_freeze { + my ($zone) = @_; + + safe_system('rndc', 'freeze', $zone); +} + +sub rndc_thaw { + my ($zone) = @_; + + safe_system('rndc', 'thaw', $zone); +} + +sub rndc_reload { + my ($zone) = @_; + + safe_system('rndc', 'reload', $zone); +} + +sub encode_txt { + my ($text) = @_; + + my $chunk_length = 255; + my $text_bytes = $text; + utf8::encode($text_bytes); + + my @parts; + for (my $i = 0; $i < length($text_bytes); $i += $chunk_length) { + my $part = substr($text_bytes, $i, 255); + $part =~ s/[\x00-\x1f"\x7f-\xff]/sprintf('\\%03d', ord($0))/eg; + push @parts, qq{"$part"}; + } + + return join(" ", @parts); +} + +sub relative_to_absolute { + my ($zone, $relative_owner) = @_; + + if ($relative_owner eq '') { + return $zone; + } + else { + return "$relative_owner.$zone"; + } +} + +sub nsupdate { + my ($zone, @instructions) = @_; + + open(my $pipe, '|-', 'nsupdate') or die "Can’t fork: $!"; + say $pipe qq{zone $zone}; + say $pipe $_ foreach (@instructions); + close($pipe); + + return (($? >> 8) == 0); +} + +sub get_txt { + my ($zone, $relative_owner, $filter, $sublabels_ok) = @_; + + $filter //= qr{.*}; + $sublabels_ok //= 0; + + my @dig_opts = qw(+nottlid +noclass +norecurse +noall +answer @127.0.0.1); + + my $owner_suffix = relative_to_absolute($zone, $relative_owner); + my $qname = ($sublabels_ok ? $zone : $owner_suffix); + my $qtype = ($sublabels_ok ? 'AXFR' : 'TXT'); + my $owner_match_re = ($sublabels_ok ? qr/^([^.]+\.)*$owner_suffix\.$/i : qr/^$qname\.$/i); + + my @result; + + open(my $pipe, '-|', 'dig', @dig_opts, $qtype, $qname) or die "Can’t fork: $!"; + + while (<$pipe>) { + chomp; + + next if /^;/; + next if /^\s*$/; + + my ($owner, $type, $data) = split(" ", $_, 3); + + unless ($type eq 'TXT') { + next; + } + unless ($owner =~ $owner_match_re) { + next; + } + + my $concat_data = ($data =~ s/"((?:[^\\"]|\\"|\\\d{3})*)"\s*/$1/gr); + unless ($concat_data =~ $filter) { + next; + } + + push @result, { owner => ($owner =~ s/\.$//r), txt => $concat_data }; + } + + close($pipe); + + if (wantarray) { + return @result; + } + else { + return $result[0]; + } +} + +sub set_txt { + my ($zone, $relative_owner, $txt) = @_; + my $owner = relative_to_absolute($zone, $relative_owner); + my $txt_encoded = encode_txt($txt); + + nsupdate( + $zone, + "update delete $owner 0 IN TXT", + "update add $owner IN TXT $txt_encoded", + "send"); +} + +sub remove_txt { + my ($zone, $relative_owner) = @_; + my $owner = relative_to_absolute($zone, $relative_owner); + + nsupdate( + $zone, + "update delete $owner 0 IN TXT", + "send"); +} + +sub check_zone { + my ($zone_contents, $origin) = @_; + + open(my $pipe, '|-', 'named-checkzone', $origin, '-') or die "Can’t fork: $!"; + print $pipe $zone_contents; + close($pipe); + + return (($? >> 8) == 0); +} + +sub zone_file_path { + my ($zone, $base_dir, $force) = @_; + + my @components = reverse(split(/\./, $zone)); + my $path = $base_dir . '/' . (join('/', @components)) . ".zone"; + + if (not -f $path and not $force) { + return undef; + } + return $path; +} + +sub get_zone_file { + my ($zone, $base_dir, $dynamic_zones) = @_; + + my $path = zone_file_path($zone, $base_dir); + return undef if not defined $path; + + rndc_freeze($zone) if is_dynamic_zone($zone, $dynamic_zones); + + my $contents; + try { + $contents = read_file($path); + } + finally { + rndc_thaw($zone) if is_dynamic_zone($zone, $dynamic_zones); + }; + + return $contents; +} + +sub import_zone_file { + my ($zone, $base_dir, $contents, $dynamic_zones) = @_; + + if ($contents =~ /^\s*$/) { + warn "Zone to import is empty"; + return undef; + } + + my $path = zone_file_path($zone, $base_dir); + if (not defined $path) { + warn "No zone file for $zone in $base_dir"; + return undef; + } + + if (not check_zone($contents, $zone)) { + warn "Zone file contents do not pass syntax check"; + return undef; + } + + 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; +} + +1; diff --git a/dns/web-api/public/dispatch.cgi b/dns/web-api/public/dispatch.cgi new file mode 100644 index 0000000..706ba0c --- /dev/null +++ b/dns/web-api/public/dispatch.cgi @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';} +use Dancer2; +use FindBin '$RealBin'; +use Plack::Runner; + +# For some reason Apache SetEnv directives don't propagate +# correctly to the dispatchers, so forcing PSGI and env here +# is safer. +set apphandler => 'PSGI'; +set environment => 'production'; + +my $psgi = path($RealBin, '..', 'bin', 'app.psgi'); +die "Unable to read startup script: $psgi" unless -r $psgi; + +Plack::Runner->run($psgi); diff --git a/dns/web-api/public/dispatch.fcgi b/dns/web-api/public/dispatch.fcgi new file mode 100644 index 0000000..ad42deb --- /dev/null +++ b/dns/web-api/public/dispatch.fcgi @@ -0,0 +1,18 @@ +#!/usr/bin/env perl +BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';} +use Dancer2; +use FindBin '$RealBin'; +use Plack::Handler::FCGI; + +# For some reason Apache SetEnv directives don't propagate +# correctly to the dispatchers, so forcing PSGI and env here +# is safer. +set apphandler => 'PSGI'; +set environment => 'production'; + +my $psgi = path($RealBin, '..', 'bin', 'app.psgi'); +my $app = do($psgi); +die "Unable to read startup script: $@" if $@; +my $server = Plack::Handler::FCGI->new(nproc => 5, detach => 1); + +$server->run($app);