feat: add full Zonemaster stack with Docker and Spanish UI

- Clone all 5 Zonemaster component repos (LDNS, Engine, CLI, Backend, GUI)
- Dockerfile.backend: 8-stage multi-stage build LDNS→Engine→CLI→Backend
- Dockerfile.gui: Astro static build served via nginx
- docker-compose.yml: backend (internal) + frontend (port 5353)
- nginx.conf: root redirects to /es/, /api/ proxied to backend
- zonemaster-gui/config.ts: defaultLanguage set to 'es' (Spanish)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-21 08:19:24 +02:00
commit 8d4eaa1489
1567 changed files with 204155 additions and 0 deletions

View File

@@ -0,0 +1,42 @@
#!/usr/bin/env perl
# This script is for testing purpose only.
use 5.14.2;
use warnings;
use Data::Dumper;
use Encode qw[decode_utf8];
use Zonemaster::Backend::RPCAPI;
use Digest::MD5 qw(md5_hex);
binmode STDOUT, ':utf8';
my $e = Zonemaster::Backend::RPCAPI->new;
say "Starting add_batch_job";
my @domains;
for (my $i = 0; $i < 100; $i++) {
push(@domains, substr(md5_hex(rand(10000)), 0, 5).".fr");
}
#die Dumper(\@domains);
$e->add_api_user({ username => 'test_user', api_key => 'API_KEY_01'});
$e->add_batch_job(
{
client_id => 'Add Script',
client_version => '1.0',
username => 'test_user',
api_key => 'API_KEY_01',
test_params => {
client_id => 'Add Script',
client_version => '1.0',
ipv4 => 1, # 0 or 1, is the ipv4 checkbox checked
ipv6 => 1, # 0 or 1, is the ipv6 checkbox checked
profile => 'default', # the id if the Test profile listbox (unused)
},
domains => \@domains,
}
);

750
zonemaster-backend/script/zmb Executable file
View File

@@ -0,0 +1,750 @@
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Encode qw( decode_utf8 FB_CROAK );
use Getopt::Long qw( GetOptionsFromArray :config require_order );
use JSON::PP qw( encode_json );
use LWP::UserAgent;
use Pod::Usage;
=head1 NAME
B<zmb> - Shell bindings for the Zonemaster::Backend RPC API
Zmb is meant to be pronounced I<Zimba>.
=head1 SYNOPSIS
zmb [GLOBAL OPTIONS] COMMAND [OPTIONS]
=head1 GLOBAL OPTIONS
--help Show usage
--verbose Show RPC query
--server URL The server to connect to. Default is http://localhost:5000/.
=cut
sub main {
my @argv = @_;
@argv = map { decode_utf8( $_, FB_CROAK ) } @argv;
my $opt_help;
my $opt_verbose;
my $opt_server = 'http://localhost:5000/';
GetOptionsFromArray(
\@argv,
'help' => \$opt_help,
'verbose' => \$opt_verbose,
'server=s' => \$opt_server,
) or pod2usage( 2 );
if ( !@argv ) {
pod2usage( -verbose => 99, -sections => ['SYNOPSIS', 'GLOBAL OPTIONS'], -exitval => 'NOEXIT' );
show_commands();
exit 1;
}
my $cmd = shift @argv;
pod2usage( 1 ) if !defined $cmd;
my $cmd_sub = \&{ "cmd_" . $cmd };
pod2usage( "'$cmd' is not a command" ) if !defined &$cmd_sub;
pod2usage( -verbose => 99, -sections => ["COMMANDS/$cmd"] ) if $opt_help;
my $json = &$cmd_sub( @argv );
if ( $json ) {
say $json if $opt_verbose;
my $request = to_request( $opt_server, $json );
my $response = submit( $request );
say $response;
}
}
=head1 COMMANDS
=head2 man
Show the full manual page.
zmb [GLOBAL OPTIONS] man
=cut
sub cmd_man {
pod2usage( -verbose => 2 );
}
=head2 non_existing_method
Call a non-existing RPC method.
zmb [GLOBAL OPTIONS] non_existing_method
=cut
sub cmd_non_existing_method {
return to_jsonrpc(
id => 1,
method => 'non_existing_method',
);
}
=head2 version_info
zmb [GLOBAL OPTIONS] version_info
=cut
sub cmd_version_info {
return to_jsonrpc(
id => 1,
method => 'version_info',
);
}
=head2 profile_names
zmb [GLOBAL OPTIONS] profile_names
=cut
sub cmd_profile_names {
return to_jsonrpc(
id => 1,
method => 'profile_names',
);
}
=head2 get_language_tags
zmb [GLOBAL OPTIONS] get_language_tags
=cut
sub cmd_get_language_tags {
return to_jsonrpc(
id => 1,
method => 'get_language_tags',
);
}
=head2 start_domain_test
zmb [GLOBAL OPTIONS] start_domain_test [OPTIONS]
Options:
--domain DOMAIN_NAME
--ipv4 true|false|null
--ipv6 true|false|null
--nameserver DOMAIN_NAME:IP_ADDRESS
--nameserver DOMAIN_NAME # Trailing colon is optional when not specifing IP_ADDRESS
--ds-info DS_INFO
--client-id CLIENT_ID
--client-version CLIENT_VERSION
--profile PROFILE_NAME
--queue QUEUE
--language LANGUAGE
DS_INFO is a comma separated list of key-value pairs. The expected pairs are:
keytag=NON_NEGATIVE_INTEGER
algorithm=NON_NEGATIVE_INTEGER
digtype=NON_NEGATIVE_INTEGER
digest=HEX_STRING
=cut
sub cmd_start_domain_test {
my @opts = @_;
my @opt_nameserver;
my $opt_domain;
my $opt_client_id;
my $opt_client_version;
my @opt_ds_info;
my $opt_ipv4;
my $opt_ipv6;
my $opt_profile;
my $opt_queue;
my $opt_language;
GetOptionsFromArray(
\@opts,
'domain|d=s' => \$opt_domain,
'nameserver|n=s' => \@opt_nameserver,
'client-id=s' => \$opt_client_id,
'client-version=s' => \$opt_client_version,
'ds-info=s' => \@opt_ds_info,
'ipv4=s' => \$opt_ipv4,
'ipv6=s' => \$opt_ipv6,
'profile=s' => \$opt_profile,
'queue=s' => \$opt_queue,
'language=s' => \$opt_language,
) or pod2usage( 2 );
my %params = ( domain => $opt_domain, );
if ( $opt_client_id ) {
$params{client_id} = $opt_client_id;
}
if ( $opt_client_version ) {
$params{client_version} = $opt_client_version;
}
if ( @opt_ds_info ) {
my @info_objects;
for my $property_value_pairs ( @opt_ds_info ) {
my %info_object;
for my $pair ( split /,/, $property_value_pairs ) {
my ( $property, $value ) = split /=/, $pair;
if ( $property =~ /^(?:keytag|algorithm|digtype)$/ ) {
$value = 0 + $value;
}
$info_object{$property} = $value;
}
push @info_objects, \%info_object;
}
$params{ds_info} = \@info_objects;
}
if ( @opt_nameserver ) {
my @nameserver_objects;
for my $domain_ip_pair ( @opt_nameserver ) {
my ( $domain, $ip ) = split /:/, $domain_ip_pair, 2;
if ($ip) {
push @nameserver_objects, { ns => $domain, ip => $ip };
} else {
push @nameserver_objects, { ns => $domain };
}
}
$params{nameservers} = \@nameserver_objects;
}
if ( $opt_ipv4 ) {
$params{ipv4} = json_tern( $opt_ipv4 );
}
if ( $opt_ipv6 ) {
$params{ipv6} = json_tern( $opt_ipv6 );
}
if ( $opt_profile ) {
$params{profile} = $opt_profile;
}
if ( $opt_queue ) {
$params{queue} = $opt_queue;
}
if ( $opt_language ) {
$params{language} = $opt_language;
}
return to_jsonrpc(
id => 1,
method => 'start_domain_test',
params => \%params,
);
}
=head2 test_progress
zmb [GLOBAL OPTIONS] test_progress [OPTIONS]
Options:
--test-id TEST_ID
=cut
sub cmd_test_progress {
my @opts = @_;
my $opt_test_id;
GetOptionsFromArray(
\@opts,
'test-id|t=s' => \$opt_test_id,
) or pod2usage( 2 );
return to_jsonrpc(
id => 1,
method => 'test_progress',
params => {
test_id => $opt_test_id,
},
);
}
=head2 get_test_params
zmb [GLOBAL OPTIONS] get_test_params [OPTIONS]
Options:
--test-id TEST_ID
=cut
sub cmd_get_test_params {
my @opts = @_;
my $opt_test_id;
GetOptionsFromArray( #
\@opts,
'test-id|t=s' => \$opt_test_id,
) or pod2usage( 2 );
return to_jsonrpc(
id => 1,
method => 'get_test_params',
params => {
test_id => $opt_test_id,
},
);
}
=head2 get_test_results
zmb [GLOBAL OPTIONS] get_test_results [OPTIONS]
Options:
--test-id TEST_ID
--lang LANGUAGE
=cut
sub cmd_get_test_results {
my @opts = @_;
my $opt_lang;
my $opt_test_id;
GetOptionsFromArray(
\@opts,
'test-id|t=s' => \$opt_test_id,
'lang|l=s' => \$opt_lang,
) or pod2usage( 2 );
return to_jsonrpc(
id => 1,
method => 'get_test_results',
params => {
id => $opt_test_id,
language => $opt_lang,
},
);
}
=head2 get_test_history
zmb [GLOBAL OPTIONS] get_test_history [OPTIONS]
Options:
--domain DOMAIN_NAME
--filter all|delegated|undelegated
--offset COUNT
--limit COUNT
=cut
sub cmd_get_test_history {
my @opts = @_;
my $opt_filter;
my $opt_domain;
my $opt_offset;
my $opt_limit;
GetOptionsFromArray(
\@opts,
'domain|d=s' => \$opt_domain,
'filter|n=s' => \$opt_filter,
'offset|o=i' => \$opt_offset,
'limit|l=i' => \$opt_limit,
) or pod2usage( 2 );
my %params = (
frontend_params => {
domain => $opt_domain,
},
);
if ( $opt_filter ) {
unless ( $opt_filter =~ /^(?:all|delegated|undelegated)$/ ) {
die 'Illegal filter value. Expects "all", "delegated" or "undelegated" ';
}
$params{filter} = $opt_filter;
}
if ( defined $opt_offset ) {
$params{offset} = $opt_offset;
}
if ( defined $opt_limit ) {
$params{limit} = $opt_limit;
}
return to_jsonrpc(
id => 1,
method => 'get_test_history',
params => \%params,
);
}
=head2 add_api_user
zmb [GLOBAL OPTIONS] add_api_user [OPTIONS]
Options:
--username USERNAME
--api-key API_KEY
=cut
sub cmd_add_api_user {
my @opts = @_;
my $opt_username;
my $opt_api_key;
GetOptionsFromArray(
\@opts,
'username|u=s' => \$opt_username,
'api-key|a=s' => \$opt_api_key,
) or pod2usage( 2 );
return to_jsonrpc(
id => 1,
method => 'add_api_user',
params => {
username => $opt_username,
api_key => $opt_api_key,
},
);
}
=head2 add_batch_job
zmb [GLOBAL OPTIONS] add_batch_job [OPTIONS]
Options:
--username USERNAME
--api-key API_KEY
--domain DOMAIN_NAME
--ipv4 true|false|null
--ipv6 true|false|null
--nameserver DOMAIN_NAME:IP_ADDRESS
--nameserver DOMAIN_NAME # Trailing colon is optional when not specifing IP_ADDRESS
--ds-info DS_INFO
--client-id CLIENT_ID
--client-version CLIENT_VERSION
--profile PROFILE_NAME
--queue QUEUE
--file FILENAME
"--domain" is repeated for each domain to be tested.
"--nameserver" can be repeated for each name server.
"--ds-info" can be repeated for each DS record.
"--file" points at a file with a list of domain names
to test, one name per line. Lines starting with "#",
empty lines and lines with white space only are
ignored. Trailing white space is ignored.
"--file" and "--domain" can be combined. Domains specified
by any "--domain" are added before those specified in the
file, if any.
DS_INFO is a comma separated list of key-value pairs. The expected pairs are:
keytag=NON_NEGATIVE_INTEGER
algorithm=NON_NEGATIVE_INTEGER
digtype=NON_NEGATIVE_INTEGER
digest=HEX_STRING
=cut
sub cmd_add_batch_job {
my @opts = @_;
my $opt_username;
my $opt_api_key;
my @opt_nameserver;
my @opt_domains;
my $opt_file;
my $opt_client_id;
my $opt_client_version;
my @opt_ds_info;
my $opt_ipv4;
my $opt_ipv6;
my $opt_profile;
my $opt_queue;
GetOptionsFromArray(
\@opts,
'username|u=s' => \$opt_username,
'api-key|a=s' => \$opt_api_key,
'domain|d=s' => \@opt_domains,
'nameserver|n=s' => \@opt_nameserver,
'client-id=s' => \$opt_client_id,
'client-version=s' => \$opt_client_version,
'ds-info=s' => \@opt_ds_info,
'ipv4=s' => \$opt_ipv4,
'ipv6=s' => \$opt_ipv6,
'profile=s' => \$opt_profile,
'queue=s' => \$opt_queue,
'file=s' => \$opt_file,
) or pod2usage( 2 );
if ($opt_file) {
open( my $fh, "<", $opt_file ) or die "Can't open < $opt_file: $!";
while( <$fh> ) {
chomp;
s/\s+$//;
s/^\s+//;
next if /^#/ or /^$/;
push( @opt_domains, decode_utf8( $_ ) );
};
};
my %params = ( domains => \@opt_domains );
$params{username} = $opt_username;
$params{api_key} = $opt_api_key;
if ( $opt_client_id ) {
$params{test_params}{client_id} = $opt_client_id;
}
if ( $opt_client_version ) {
$params{test_params}{client_version} = $opt_client_version;
}
if ( @opt_ds_info ) {
my @info_objects;
for my $property_value_pairs ( @opt_ds_info ) {
my %info_object;
for my $pair ( split /,/, $property_value_pairs ) {
my ( $property, $value ) = split /=/, $pair;
if ( $property =~ /^(?:keytag|algorithm|digtype)$/ ) {
$value = 0 + $value;
}
$info_object{$property} = $value;
}
push @info_objects, \%info_object;
}
$params{test_params}{ds_info} = \@info_objects;
}
if ( @opt_nameserver ) {
my @nameserver_objects;
for my $domain_ip_pair ( @opt_nameserver ) {
my ( $domain, $ip ) = split /:/, $domain_ip_pair, 2;
$ip //= "";
push @nameserver_objects,
{
ns => $domain,
ip => $ip,
};
}
$params{test_params}{nameservers} = \@nameserver_objects;
}
if ( $opt_ipv4 ) {
$params{test_params}{ipv4} = json_tern( $opt_ipv4 );
}
if ( $opt_ipv6 ) {
$params{test_params}{ipv6} = json_tern( $opt_ipv6 );
}
if ( $opt_profile ) {
$params{test_params}{profile} = $opt_profile;
}
if ( $opt_queue ) {
$params{test_params}{queue} = $opt_queue;
}
return to_jsonrpc(
id => 1,
method => 'add_batch_job',
params => \%params,
);
}
=head2 batch_status
zmb [GLOBAL OPTIONS] batch_status [OPTIONS]
Options:
--batch-id BATCH-ID|--bi BATCH-ID
--list-waiting-tests true|false|null
--list-running-tests true|false|null
--list-finished-tests true|false|null
--lw # Same as "--list-waiting-tests true"
--lr # Same as "--list-running-tests true"
--lf # Same as "--list-finished-tests true"
"--batch-id" is mandatory.
The command provides the number of tests waiting to be run, tests running and
test finished, respectively, for the batch.
"--list-waiting-tests", "--list-running-tests" and "--list-finished-tests" are
optional. If given the test IDs of tests waiting to be run, tests running
and test finished, respectively, are listed.
"--lw", "--lr" and "--lf" are option.
"--lw" must not be combined with "--list-waiting-tests". "--lr" must not be
combined with "--list-running-tests". "--lf" must not be combined with
"--list-finished-tests".
=cut
sub cmd_batch_status {
my @opts = @_;
my $opt_batch_id;
my $opt_list_waiting_tests;
my $opt_lw;
my $opt_list_running_tests;
my $opt_lr;
my $opt_list_finished_tests;
my $opt_lf;
GetOptionsFromArray(
\@opts,
'batch-id|bi=s' => \$opt_batch_id,
'list-waiting-tests=s' => \$opt_list_waiting_tests,
'lw' => \$opt_lw,
'list-running-tests=s' => \$opt_list_running_tests,
'lr' => \$opt_lr,
'list-finished-tests=s' => \$opt_list_finished_tests,
'lf' => \$opt_lf,
) or pod2usage( 2 );
pod2usage( "'--lw' and '--list-waiting-test' must not be combined" ) if defined $opt_list_waiting_tests and $opt_lw;
pod2usage( "'--lr' and '--list-running-test' must not be combined" ) if defined $opt_list_running_tests and $opt_lr;
pod2usage( "'--lf' and '--list-finished-test' must not be combined" ) if defined $opt_list_finished_tests and $opt_lf;
my %params;
$params{batch_id} = $opt_batch_id;
$params{list_waiting_tests} = json_tern( $opt_list_waiting_tests ) if $opt_list_waiting_tests and json_tern( $opt_list_waiting_tests );
$params{list_running_tests} = json_tern( $opt_list_running_tests ) if $opt_list_running_tests and json_tern( $opt_list_running_tests );
$params{list_finished_tests} = json_tern( $opt_list_finished_tests ) if $opt_list_finished_tests and json_tern( $opt_list_finished_tests );
$params{list_waiting_tests} = JSON::PP::true if $opt_lw;
$params{list_running_tests} = JSON::PP::true if $opt_lr;
$params{list_finished_tests} = JSON::PP::true if $opt_lf;
return to_jsonrpc(
id => 1,
method => 'batch_status',
params => \%params,
);
}
sub show_commands {
my %specials = (
man => 'Show the full manual page.',
non_existing_method => 'Call a non-existing RPC method.',
);
my @commands = get_commands();
my $max_width = 0;
for my $command ( @commands ) {
$max_width = length $command if length $command > $max_width;
}
say "Commands:";
for my $command ( @commands ) {
if ( exists $specials{$command} ) {
printf " %-*s %s\n", $max_width, $command, $specials{$command};
}
else {
say " ", $command;
}
}
}
sub get_commands {
no strict 'refs';
return sort
map { $_ =~ s/^cmd_//r }
grep { $_ =~ /^cmd_/ } grep { defined &{"main\::$_"} } keys %{"main\::"};
}
sub json_tern {
my $value = shift;
if ( $value eq 'true' ) {
return JSON::PP::true;
}
elsif ( $value eq 'false' ) {
return JSON::PP::false;
}
elsif ( $value eq 'null' ) {
return undef;
}
else {
die 'Illegal value. Expects "true", "false" or "null" ';
}
}
sub to_jsonrpc {
my %args = @_;
my $id = $args{id};
my $method = $args{method};
my $request = {
jsonrpc => "2.0",
method => $method,
id => $id,
};
if ( exists $args{params} ) {
$request->{params} = $args{params};
}
return encode_json( $request );
}
sub to_request {
my $server = shift;
my $json = shift;
my $req = HTTP::Request->new( POST => $server );
$req->content_type( 'application/json' );
$req->content( $json );
return $req;
}
sub submit {
my $req = shift;
my $ua = LWP::UserAgent->new;
my $res = $ua->request( $req );
if ( $res->is_success ) {
return $res->decoded_content;
}
else {
die $res->status_line;
}
}
main( @ARGV );

View File

@@ -0,0 +1,87 @@
#!/bin/sh
bindir="$(dirname "$0")"
ZMB="${bindir}/zmb"
JQ="$(which jq)"
usage () {
status="$1"
message="$2"
[ -n "$message" ] && printf "%s\n" "${message}" >&2
echo "Usage: zmtest [OPTIONS] DOMAIN" >&2
echo >&2
echo "Options:" >&2
echo " -h --help Show usage (this documentation)." >&2
echo " -s URL --server URL Zonemaster Backend to query. Default is http://localhost:5000/" >&2
echo " --noipv4 Run the test with IPv4 disabled." >&2
echo " --noipv6 Run the test with IPv6 disabled." >&2
echo " IPv4 and IPv6 follow the profile setting unless disabled by option." >&2
echo " --lang LANG A language tag. Default is \"en\"." >&2
echo " Valid values are determined by backend_config.ini." >&2
echo " --profile PROFILE The name of a profile. Default is \"default\"." >&2
echo " Valid values are determined by backend_config.ini except that" >&2
echo " \"default\" is always a valid value." >&2
exit "${status}"
}
error () {
status="$1"
message="$2"
printf "error: %s\n" "${message}" >&2
exit "${status}"
}
zmb () {
server_url="$1"; shift
output="$("${ZMB}" --server="${server_url}" "$@" 2>&1)" || error 1 "method $1: ${output}"
json="$(printf "%s" "${output}" | "${JQ}" -S . 2>/dev/null)" || error 1 "method $1 did not return valid JSON output: ${output}"
error="$(printf "%s" "${json}" | "${JQ}" -e .error 2>/dev/null)" && error 1 "method $1: ${error}"
printf "%s" "${json}"
}
[ -n "${JQ}" ] || error 2 "Dependency not found: jq"
domain=""
server_url="http://localhost:5000/"
ipv4=""
ipv6=""
lang="en"
profile="default"
while [ $# -gt 0 ] ; do
case "$1" in
-h|--help) usage 2; shift 1;;
-s|--server) server_url="$2"; shift 2;;
--noipv4) ipv4='--ipv4 false'; shift 1;;
--noipv6) ipv6='--ipv6 false'; shift 1;;
--lang) lang="$2"; shift 2;;
--profile) profile="$2"; shift 2;;
*) domain="$1" ; shift 1;;
esac
done
[ -n "${domain}" ] || usage 2 "No domain specified"
# Start test
output="$(zmb "${server_url}" start_domain_test --domain "${domain}" ${ipv4} ${ipv6} --profile "${profile}")" || exit $?
testid="$(printf "%s" "${output}" | "${JQ}" -r .result)" || exit $?
printf "testid: %s\n" "${testid}" >&2
if echo "${testid}" | grep -qE '[^0-9a-fA-F]' ; then
error 1 "start_domain_test did not return a testid: ${testid}"
fi
# Wait for test to finish
while true
do
output="$(zmb "${server_url}" test_progress --test-id "${testid}")" || exit $?
progress="$(printf "%s" "${output}" | "${JQ}" -r .result)" || exit $?
printf "\r${progress}%% done" >&2
if [ "${progress}" -eq 100 ] ; then
echo >&2
break
fi
sleep 1
done
# Get test results
zmb "${server_url}" get_test_results --test-id "${testid}" --lang "${lang}"

View File

@@ -0,0 +1,252 @@
#!/usr/bin/env perl
use strict;
use warnings;
our $VERSION = '1.1.0';
use 5.14.2;
use English qw( $PID );
use JSON::PP;
use JSON::RPC::Dispatch;
use Log::Any qw( $log );
use Log::Any::Adapter;
use POSIX;
use Plack::Builder;
use Plack::Response;
use Router::Simple::Declare;
use Try::Tiny;
BEGIN {
$ENV{PERL_JSON_BACKEND} = 'JSON::PP';
undef $ENV{LANGUAGE};
};
use Zonemaster::Backend::RPCAPI;
use Zonemaster::Backend::Config;
use Zonemaster::Backend::Metrics;
local $| = 1;
Log::Any::Adapter->set(
'+Zonemaster::Backend::Log',
log_level => $ENV{ZM_BACKEND_RPCAPI_LOGLEVEL},
json => $ENV{ZM_BACKEND_RPCAPI_LOGJSON},
stderr => 1
);
$SIG{__WARN__} = sub {
$log->warning(map s/^\s+|\s+$//gr, map s/\n/ /gr, @_);
};
my $config = Zonemaster::Backend::Config->load_config();
Zonemaster::Backend::Metrics->setup($config->METRICS_statsd_host, $config->METRICS_statsd_port);
Zonemaster::Engine::init_engine();
builder {
enable sub {
my $app = shift;
# Make sure we can connect to the database
$config->new_DB();
return $app;
};
};
my $handler = Zonemaster::Backend::RPCAPI->new( { config => $config } );
my $router = router {
############## FRONTEND ####################
connect "version_info" => {
handler => $handler,
action => "version_info"
};
# Experimental
connect "system_versions" => {
handler => $handler,
action => "system_versions"
};
connect "profile_names" => {
handler => $handler,
action => "profile_names"
};
# Experimental
connect "conf_profiles" => {
handler => $handler,
action => "conf_profiles"
};
connect "get_language_tags" => {
handler => $handler,
action => "get_language_tags"
};
# Experimental
connect "conf_languages" => {
handler => $handler,
action => "conf_languages"
};
connect "get_host_by_name" => {
handler => $handler,
action => "get_host_by_name"
};
# Experimental
connect "lookup_address_records" => {
handler => $handler,
action => "lookup_address_records"
};
connect "get_data_from_parent_zone" => {
handler => $handler,
action => "get_data_from_parent_zone"
};
# Experimental
connect "lookup_delegation_data" => {
handler => $handler,
action => "lookup_delegation_data"
};
connect "start_domain_test" => {
handler => $handler,
action => "start_domain_test"
};
# Experimental
connect "job_create" => {
handler => $handler,
action => "job_create"
};
connect "test_progress" => {
handler => $handler,
action => "test_progress"
};
# Experimental
connect "job_status" => {
handler => $handler,
action => "job_status"
};
connect "get_test_params" => {
handler => $handler,
action => "get_test_params"
};
# Experimental
connect "job_params" => {
handler => $handler,
action => "job_params"
};
connect "get_test_results" => {
handler => $handler,
action => "get_test_results"
};
# Experimental
connect "job_results" => {
handler => $handler,
action => "job_results"
};
connect "get_test_history" => {
handler => $handler,
action => "get_test_history"
};
# Experimental
connect "domain_history" => {
handler => $handler,
action => "domain_history"
};
connect "batch_status" => {
handler => $handler,
action => "batch_status"
};
};
if ( $config->RPCAPI_enable_user_create or $config->RPCAPI_enable_add_api_user ) {
$log->info('Enabling add_api_user method');
$router->connect("add_api_user", {
handler => $handler,
action => "add_api_user"
});
$router->connect("user_create", {
handler => $handler,
action => "user_create"
});
}
if ( $config->RPCAPI_enable_batch_create or $config->RPCAPI_enable_add_batch_job ) {
$log->info('Enabling add_batch_job method');
$router->connect("add_batch_job", {
handler => $handler,
action => "add_batch_job"
});
$router->connect("batch_create", {
handler => $handler,
action => "batch_create"
});
}
my $dispatch = JSON::RPC::Dispatch->new(
router => $router,
);
my $rpcapi_app = sub {
my $env = shift;
my $req = Plack::Request->new($env);
my $res = {};
my $content = {};
my $json_error = '';
try {
my $json = $req->content;
$content = decode_json($json);
} catch {
$json_error = (split /at \//, $_)[0];
};
if ($json_error eq '') {
my $errors = $handler->jsonrpc_validate($content);
if ($errors ne '') {
$res = Plack::Response->new(200);
$res->content_type('application/json');
$res->body( encode_json($errors) );
$res->finalize;
} else {
local $log->context->{rpc_method} = $content->{method};
$res = $dispatch->handle_psgi($env, $env->{REMOTE_ADDR});
my $status = Zonemaster::Backend::Metrics->code_to_status(decode_json(@{@$res[2]}[0])->{error}->{code});
Zonemaster::Backend::Metrics::increment("zonemaster.rpcapi.requests.$content->{method}.$status");
$res;
}
} else {
$res = Plack::Response->new(200);
$res->content_type('application/json');
$res->body( encode_json({
jsonrpc => '2.0',
id => undef,
error => {
code => '-32700',
message => 'Invalid JSON was received by the server.',
data => "$json_error"
}}) );
$res->finalize;
}
};
builder {
enable "Plack::Middleware::ReverseProxy";
mount "/" => $rpcapi_app;
};

View File

@@ -0,0 +1,293 @@
#!/usr/bin/env perl
use 5.14.2;
use warnings;
use Zonemaster::Backend::TestAgent;
use Zonemaster::Backend::Config;
use Zonemaster::Backend::Metrics;
use Parallel::ForkManager;
use Daemon::Control;
use Log::Any qw( $log );
use Log::Any::Adapter;
use English;
use Pod::Usage;
use Getopt::Long;
use POSIX;
use Time::HiRes qw[time sleep gettimeofday tv_interval];
use sigtrap qw(die normal-signals);
###
### Compile-time stuff.
###
BEGIN {
$ENV{PERL_JSON_BACKEND} = 'JSON::PP';
undef $ENV{LANGUAGE};
}
# Enable immediate flush to stdout and stderr
$|++;
###
### More global variables, and initialization.
###
my $pidfile;
my $user;
my $group;
my $logfile;
my $loglevel;
my $logjson;
my $opt_outfile;
my $opt_help;
GetOptions(
'help!' => \$opt_help,
'pidfile=s' => \$pidfile,
'user=s' => \$user,
'group=s' => \$group,
'logfile=s' => \$logfile,
'loglevel=s' => \$loglevel,
'logjson!' => \$logjson,
'outfile=s' => \$opt_outfile,
) or pod2usage( "Try '$0 --help' for more information." );
pod2usage( -verbose => 1 ) if $opt_help;
$pidfile //= '/tmp/zonemaster_backend_testagent.pid';
$logfile //= '/var/log/zonemaster/zonemaster_backend_testagent.log';
$opt_outfile //= '/var/log/zonemaster/zonemaster_backend_testagent.out';
$loglevel //= 'info';
$loglevel = lc $loglevel;
Log::Any::Adapter->set(
'+Zonemaster::Backend::Log',
log_level => $loglevel,
json => $logjson,
file => $logfile,
);
$SIG{__WARN__} = sub {
$log->warning(map s/^\s+|\s+$//gr, map s/\n/ /gr, @_);
};
###
### Actual functionality
###
sub main {
my $self = shift;
my $caught_sigterm = 0;
my $catch_sigterm;
$catch_sigterm = sub {
$SIG{TERM} = $catch_sigterm;
$caught_sigterm = 1;
$log->notice( "Daemon caught SIGTERM" );
return;
};
local $SIG{TERM} = $catch_sigterm;
my $agent = Zonemaster::Backend::TestAgent->new( { config => $self->config } );
while ( !$caught_sigterm ) {
my $cleanup_timer = [ gettimeofday ];
$self->pm->reap_finished_children(); # Reaps terminated child processes
$self->pm->on_wait(); # Sends SIGKILL to overdue child processes
Zonemaster::Backend::Metrics::gauge("zonemaster.testagent.maximum_processes", $self->pm->max_procs);
Zonemaster::Backend::Metrics::gauge("zonemaster.testagent.running_processes", scalar($self->pm->running_procs));
Zonemaster::Backend::Metrics::timing("zonemaster.testagent.cleanup_duration_seconds", tv_interval($cleanup_timer) * 1000);
my $fetch_test_timer = [ gettimeofday ];
my ( $test_id, $batch_id );
eval {
$self->db->process_unfinished_tests(
$self->config->ZONEMASTER_lock_on_queue,
$self->config->ZONEMASTER_max_zonemaster_execution_time,
);
( $test_id, $batch_id ) = $self->db->get_test_request( $self->config->ZONEMASTER_lock_on_queue );
Zonemaster::Backend::Metrics::timing("zonemaster.testagent.fetchtests_duration_seconds", tv_interval($fetch_test_timer) * 1000);
};
if ( $@ ) {
$log->error( $@ );
}
my $show_progress = defined $batch_id ? 0 : 1;
if ( $test_id ) {
$log->infof( "Test found: %s", $test_id );
if ( $self->pm->start( $test_id ) == 0 ) { # Forks off child process
$log->infof( "Test starting: %s", $test_id );
Zonemaster::Backend::Metrics::increment("zonemaster.testagent.tests_started");
my $start_time = [ gettimeofday ];
eval { $agent->run( $test_id, $show_progress ) };
if ( $@ ) {
chomp $@;
Zonemaster::Backend::Metrics::increment("zonemaster.testagent.tests_died");
$log->errorf( "Test died: %s: %s", $test_id, $@ );
$self->db->process_dead_test( $test_id )
}
else {
Zonemaster::Backend::Metrics::increment("zonemaster.testagent.tests_completed");
$log->infof( "Test completed: %s", $test_id );
}
Zonemaster::Backend::Metrics::timing("zonemaster.testagent.tests_duration_seconds", tv_interval($start_time) * 1000);
$agent->reset();
$self->pm->finish; # Terminates child process
}
}
else {
sleep $self->config->DB_polling_interval;
}
}
$log->notice( "Daemon entered graceful shutdown" );
$self->pm->wait_all_children(); # Includes SIGKILLing overdue child processes
return;
}
sub preflight_checks {
# Make sure we can load the configuration file
$log->debug("Starting pre-flight check");
my $initial_config = Zonemaster::Backend::Config->load_config();
Zonemaster::Backend::Metrics->setup($initial_config->METRICS_statsd_host, $initial_config->METRICS_statsd_port);
# Validate the Zonemaster-Engine profile
Zonemaster::Backend::TestAgent->new( { config => $initial_config } );
# Connect to the database
$initial_config->new_DB();
$log->debug("Completed pre-flight check");
return $initial_config;
}
my $initial_config;
# Make sure the environment is alright before forking (only on startup)
if ( grep /^foreground$|^restart$|^start$/, @ARGV ) {
eval {
$initial_config = preflight_checks();
};
if ( $@ ) {
$log->critical( "Aborting startup: $@" );
print STDERR "Aborting startup: $@";
exit 1;
}
}
###
### Daemon Control stuff.
###
my $daemon = Daemon::Control->with_plugins( qw( +Zonemaster::Backend::Config::DCPlugin ) )->new(
{
name => 'zonemaster-testagent',
program => sub {
my $self = shift;
$log->notice( "Daemon spawned" );
$self->init_backend_config( $initial_config );
undef $initial_config;
eval { main( $self ) };
if ( $@ ) {
chomp $@;
$log->critical( $@ );
}
$log->notice( "Daemon terminating" );
},
pid_file => $pidfile,
stderr_file => $opt_outfile,
stdout_file => $opt_outfile,
}
);
$daemon->init_config( $ENV{PERLBREW_ROOT} . '/etc/bashrc' ) if ( $ENV{PERLBREW_ROOT} );
$daemon->user($user) if $user;
$daemon->group($group) if $group;
exit $daemon->run;
=head1 NAME
zonemaster_backend_testagent - Init script for Zonemaster Test Agent.
=head1 SYNOPSIS
zonemaster_backend_testagent [OPTIONS] [COMMAND]
=head1 OPTIONS
=over 4
=item B<--help>
Print a brief help message and exits.
=item B<--user=USER>
When specified the daemon will drop to the user with this username when forked.
=item B<--group=GROUP>
When specified the daemon will drop to the group with this groupname when forked.
=item B<--pidfile=FILE>
The location of the PID file to use.
=item B<--logfile=FILE>
The location of the log file to use.
When FILE is -, the log is written to standard output.
=item B<--loglevel=LEVEL>
The location of the log level to use.
The allowed values are specified at L<Log::Any/LOG-LEVELS>.
=item B<--logjson>
Enable JSON logging when specified.
=item B<COMMAND>
One of the following:
=over 4
=item start
=item foreground
=item stop
=item restart
=item reload
=item status
=item get_init_file
=back
=back
=cut