CloudHost/zonemaster.es
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
eaaa8f6a111314d9944202a51708f67210616a4e
zonemaster.es/zonemaster-backend/script/zmb
Malin 8d4eaa1489 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>
2026-04-21 08:19:24 +02:00

751 lines
17 KiB
Perl
Executable File
Raw Blame History

#!/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 );
Reference in New Issue View Git Blame Copy Permalink