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:
928
zonemaster-backend/lib/Zonemaster/Backend/Config.pm
Normal file
928
zonemaster-backend/lib/Zonemaster/Backend/Config.pm
Normal file
@@ -0,0 +1,928 @@
|
||||
package Zonemaster::Backend::Config;
|
||||
use strict;
|
||||
use warnings;
|
||||
use 5.14.2;
|
||||
|
||||
our $VERSION = '1.1.0';
|
||||
|
||||
use Carp qw( confess croak );
|
||||
use Config::IniFiles;
|
||||
use Config;
|
||||
use File::ShareDir qw[dist_file];
|
||||
use File::Slurp qw( read_file );
|
||||
use Log::Any qw( $log );
|
||||
use Readonly;
|
||||
use Zonemaster::Backend::Validator qw( :untaint );
|
||||
use Zonemaster::Backend::DB;
|
||||
|
||||
Readonly my @SIG_NAME => split ' ', $Config{sig_name};
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=head2 get_default_path
|
||||
|
||||
Determine the path for the default backend_config.ini file.
|
||||
A list of values and locations are checked and the first match is returned.
|
||||
If all places are checked and no file is found, an exception is thrown.
|
||||
|
||||
This procedure is idempotent - i.e. if you call this procedure multiple times
|
||||
the same value is returned no matter if environment variables or the file system
|
||||
have changed.
|
||||
|
||||
The following checks are made in order:
|
||||
|
||||
=over 4
|
||||
|
||||
=item $ZONEMASTER_BACKEND_CONFIG_FILE
|
||||
|
||||
If this environment variable is set ot a truthy value, that path is returned.
|
||||
|
||||
=item /etc/zonemaster/backend_config.ini
|
||||
|
||||
If a file exists at this path, it is returned.
|
||||
|
||||
=item /usr/local/etc/zonemaster/backend_config.ini
|
||||
|
||||
If a file exists at such a path, it is returned.
|
||||
|
||||
=item DIST_DIR/backend_config.ini
|
||||
|
||||
If a file exists at this path, it is returned.
|
||||
DIST_DIR is wherever File::ShareDir installs the Zonemaster-Backend dist.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub get_default_path {
|
||||
state $path =
|
||||
$ENV{ZONEMASTER_BACKEND_CONFIG_FILE} ? $ENV{ZONEMASTER_BACKEND_CONFIG_FILE}
|
||||
: -e '/etc/zonemaster/backend_config.ini' ? '/etc/zonemaster/backend_config.ini'
|
||||
: -e '/usr/local/etc/zonemaster/backend_config.ini' ? '/usr/local/etc/zonemaster/backend_config.ini'
|
||||
: eval { dist_file( 'Zonemaster-Backend', 'backend_config.ini' ) };
|
||||
return $path // croak "File not found: backend_config.ini\n";
|
||||
}
|
||||
|
||||
=head2 load_profiles
|
||||
|
||||
Loads and returns a set of named profiles.
|
||||
|
||||
my %all_profiles = (
|
||||
$config->PUBLIC_PROFILES,
|
||||
$config->PRIVATE_PROFILES,
|
||||
);
|
||||
my %profiles = %{ Zonemaster::Backend::Config->load_profiles( %all_profiles ) };
|
||||
|
||||
Takes a hash mapping profile names to profile paths.
|
||||
An `undef` path value means the default profile.
|
||||
|
||||
Returns a hashref mapping profile names to profile objects.
|
||||
|
||||
The returned profiles have omitted values filled in with defaults from the
|
||||
default profile.
|
||||
|
||||
Dies if any of the given paths cannot be read or their contents cannot be parsed
|
||||
as JSON.
|
||||
|
||||
=cut
|
||||
|
||||
sub load_profiles {
|
||||
my ( $class, %profile_paths ) = @_;
|
||||
|
||||
my %profiles;
|
||||
foreach my $name ( keys %profile_paths ) {
|
||||
my $path = $profile_paths{$name};
|
||||
|
||||
my $full_profile = Zonemaster::Engine::Profile->default;
|
||||
if ( defined $path ) {
|
||||
my $json = eval { read_file( $path, err_mode => 'croak' ) } #
|
||||
// die "Error loading profile '$name': $@";
|
||||
my $named_profile = eval { Zonemaster::Engine::Profile->from_json( $json ) } #
|
||||
// die "Error loading profile '$name' at '$path': $@";
|
||||
$full_profile->merge( $named_profile );
|
||||
}
|
||||
$profiles{$name} = $full_profile;
|
||||
}
|
||||
|
||||
return \%profiles;
|
||||
}
|
||||
|
||||
=head1 CONSTRUCTORS
|
||||
|
||||
=head2 load_config
|
||||
|
||||
A wrapper around L<parse> that also determines where the config file is located
|
||||
in the file system and reads it.
|
||||
|
||||
Throws an exception if the determined configuration file cannot be read.
|
||||
See L<parse> for details on additional parsing-related error modes.
|
||||
|
||||
=cut
|
||||
|
||||
sub load_config {
|
||||
my ( $class ) = @_;
|
||||
|
||||
my $path = get_default_path();
|
||||
$log->notice( "Loading config: $path" );
|
||||
my $text = read_file $path;
|
||||
|
||||
my $obj = eval { $class->parse( $text ) };
|
||||
if ( $@ ) {
|
||||
die "File $path: $@";
|
||||
}
|
||||
|
||||
return $obj;
|
||||
}
|
||||
|
||||
=head2 parse
|
||||
|
||||
Construct a new Zonemaster::Backend::Config based on a given configuration.
|
||||
|
||||
my $config = Zonemaster::Backend::Config->parse(
|
||||
q{
|
||||
[DB]
|
||||
engine = SQLite
|
||||
|
||||
[SQLITE]
|
||||
database_file = /var/db/zonemaster.sqlite
|
||||
}
|
||||
);
|
||||
|
||||
The configuration is interpreted according to the
|
||||
L<configuration format specification|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md>.
|
||||
|
||||
Returns a new Zonemaster::Backend::Config instance with its properties set to
|
||||
normalized and untainted values according to the given configuration with
|
||||
defaults according to the configuration format.
|
||||
|
||||
Emits a log warning with a deprecation message for each deprecated property that
|
||||
is present.
|
||||
|
||||
Throws an exception if the given configuration contains errors.
|
||||
|
||||
In a valid config file:
|
||||
|
||||
=over 4
|
||||
|
||||
=item
|
||||
|
||||
all required properties are present, and
|
||||
|
||||
=item
|
||||
|
||||
all sections and properties are recognized.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub parse {
|
||||
my ( $class, $text ) = @_;
|
||||
|
||||
my $obj = bless( {}, $class );
|
||||
$obj->{_public_profiles} = {};
|
||||
$obj->{_private_profiles} = {};
|
||||
|
||||
my $ini = Config::IniFiles->new( -file => \$text )
|
||||
or die "Failed to parse config: " . join( '; ', @Config::IniFiles::errors ) . "\n";
|
||||
|
||||
my $get_and_clear = sub { # Read and clear a property from a Config::IniFiles object.
|
||||
my ( $section, $param ) = @_;
|
||||
my ( $value, @extra ) = $ini->val( $section, $param );
|
||||
if ( @extra ) {
|
||||
die "Property not unique: $section.$param\n";
|
||||
}
|
||||
$ini->delval( $section, $param );
|
||||
return $value;
|
||||
};
|
||||
|
||||
# Validate section names
|
||||
{
|
||||
my %sections = map { $_ => 1 } ( 'DB', 'MYSQL', 'POSTGRESQL', 'SQLITE', 'LANGUAGE', 'PUBLIC PROFILES', 'PRIVATE PROFILES', 'ZONEMASTER', 'METRICS', 'RPCAPI' );
|
||||
for my $section ( $ini->Sections ) {
|
||||
if ( !exists $sections{$section} ) {
|
||||
die "config: unrecognized section: $section\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Assign default values
|
||||
$obj->_set_DB_polling_interval( '0.5' );
|
||||
$obj->_set_MYSQL_port( '3306' );
|
||||
$obj->_set_POSTGRESQL_port( '5432' );
|
||||
$obj->_set_ZONEMASTER_max_zonemaster_execution_time( '600' );
|
||||
$obj->_set_ZONEMASTER_number_of_processes_for_frontend_testing( '20' );
|
||||
$obj->_set_ZONEMASTER_number_of_processes_for_batch_testing( '20' );
|
||||
$obj->_set_ZONEMASTER_lock_on_queue( '0' );
|
||||
$obj->_set_ZONEMASTER_age_reuse_previous_test( '600' );
|
||||
$obj->_set_RPCAPI_enable_user_create( 'no' ); # experimental
|
||||
$obj->_set_RPCAPI_enable_batch_create( 'yes' ); # experimental
|
||||
$obj->_set_RPCAPI_enable_add_api_user( 'no' );
|
||||
$obj->_set_RPCAPI_enable_add_batch_job( 'yes' );
|
||||
$obj->_set_locales( 'en_US' );
|
||||
$obj->_add_public_profile( 'default', undef );
|
||||
$obj->_set_METRICS_statsd_port( '8125' );
|
||||
|
||||
# Assign property values (part 1/2)
|
||||
if ( defined( my $value = $get_and_clear->( 'DB', 'engine' ) ) ) {
|
||||
$obj->_set_DB_engine( $value );
|
||||
}
|
||||
|
||||
# Check required properties (part 1/2)
|
||||
if ( !defined $obj->DB_engine ) {
|
||||
die "config: missing required property DB.engine\n";
|
||||
}
|
||||
|
||||
# Check deprecated properties and assign fallback values
|
||||
my @warnings;
|
||||
#currently no deprecation warnings
|
||||
|
||||
# Assign property values (part 2/2)
|
||||
if ( defined( my $value = $get_and_clear->( 'DB', 'polling_interval' ) ) ) {
|
||||
$obj->_set_DB_polling_interval( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'MYSQL', 'host' ) ) ) {
|
||||
$obj->_set_MYSQL_host( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'MYSQL', 'port' ) ) ) {
|
||||
if ( $obj->MYSQL_host eq 'localhost' ) {
|
||||
push @warnings, "MYSQL.port is disregarded if MYSQL.host is set to 'localhost'";
|
||||
}
|
||||
$obj->{_MYSQL_port} = $value;
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'MYSQL', 'user' ) ) ) {
|
||||
$obj->_set_MYSQL_user( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'MYSQL', 'password' ) ) ) {
|
||||
$obj->_set_MYSQL_password( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'MYSQL', 'database' ) ) ) {
|
||||
$obj->_set_MYSQL_database( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'POSTGRESQL', 'host' ) ) ) {
|
||||
$obj->_set_POSTGRESQL_host( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'POSTGRESQL', 'port' ) ) ) {
|
||||
$obj->{_POSTGRESQL_port} = $value;
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'POSTGRESQL', 'user' ) ) ) {
|
||||
$obj->_set_POSTGRESQL_user( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'POSTGRESQL', 'password' ) ) ) {
|
||||
$obj->_set_POSTGRESQL_password( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'POSTGRESQL', 'database' ) ) ) {
|
||||
$obj->_set_POSTGRESQL_database( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'SQLITE', 'database_file' ) ) ) {
|
||||
$obj->_set_SQLITE_database_file( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'ZONEMASTER', 'max_zonemaster_execution_time' ) ) ) {
|
||||
$obj->_set_ZONEMASTER_max_zonemaster_execution_time( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'ZONEMASTER', 'number_of_processes_for_frontend_testing' ) ) ) {
|
||||
$obj->_set_ZONEMASTER_number_of_processes_for_frontend_testing( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'ZONEMASTER', 'number_of_processes_for_batch_testing' ) ) ) {
|
||||
$obj->_set_ZONEMASTER_number_of_processes_for_batch_testing( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'ZONEMASTER', 'lock_on_queue' ) ) ) {
|
||||
$obj->_set_ZONEMASTER_lock_on_queue( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'ZONEMASTER', 'age_reuse_previous_test' ) ) ) {
|
||||
$obj->_set_ZONEMASTER_age_reuse_previous_test( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'METRICS', 'statsd_host' ) ) ) {
|
||||
$obj->_set_METRICS_statsd_host( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'METRICS', 'statsd_port' ) ) ) {
|
||||
$obj->_set_METRICS_statsd_port( $value );
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'RPCAPI', 'enable_user_create' ) ) ) {
|
||||
if ( defined( $get_and_clear->( 'RPCAPI', 'enable_add_api_user' ) ) ) {
|
||||
die "Error: cannot specify both RPCAPI.enable_add_api_user and RPCAPI.enable_user_create\n";
|
||||
}
|
||||
$obj->_set_RPCAPI_enable_add_api_user( $value );
|
||||
$obj->_set_RPCAPI_enable_user_create( $value );
|
||||
} else {
|
||||
if ( defined( my $value = $get_and_clear->( 'RPCAPI', 'enable_add_api_user' ) ) ) {
|
||||
$obj->_set_RPCAPI_enable_add_api_user( $value );
|
||||
$obj->_set_RPCAPI_enable_user_create( $value );
|
||||
}
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'RPCAPI', 'enable_batch_create' ) ) ) {
|
||||
if ( defined( $get_and_clear->( 'RPCAPI', 'enable_add_batch_job' ) ) ) {
|
||||
die "Error: cannot specify both RPCAPI.enable_add_batch_job and RPCAPI.enable_batch_create\n";
|
||||
}
|
||||
$obj->_set_RPCAPI_enable_add_batch_job( $value );
|
||||
$obj->_set_RPCAPI_enable_batch_create( $value );
|
||||
} else {
|
||||
if ( defined( my $value = $get_and_clear->( 'RPCAPI', 'enable_add_batch_job' ) ) ) {
|
||||
$obj->_set_RPCAPI_enable_add_batch_job( $value );
|
||||
$obj->_set_RPCAPI_enable_batch_create( $value );
|
||||
}
|
||||
}
|
||||
if ( defined( my $value = $get_and_clear->( 'LANGUAGE', 'locale' ) ) ) {
|
||||
$obj->_set_locales( $value );
|
||||
}
|
||||
|
||||
for my $name ( $ini->Parameters( 'PUBLIC PROFILES' ) ) {
|
||||
my $path = $get_and_clear->( 'PUBLIC PROFILES', $name );
|
||||
$obj->_add_public_profile( $name, $path );
|
||||
}
|
||||
|
||||
for my $name ( $ini->Parameters( 'PRIVATE PROFILES' ) ) {
|
||||
my $path = $get_and_clear->( 'PRIVATE PROFILES', $name );
|
||||
$obj->_add_private_profile( $name, $path );
|
||||
}
|
||||
|
||||
# Check required propertys (part 2/2)
|
||||
if ( $obj->DB_engine eq 'MySQL' ) {
|
||||
die "config: missing required property MYSQL.host (required when DB.engine = MySQL)\n"
|
||||
if !defined $obj->MYSQL_host;
|
||||
|
||||
die "config: missing required property MYSQL.user (required when DB.engine = MySQL)\n"
|
||||
if !defined $obj->MYSQL_user;
|
||||
|
||||
die "config: missing required property MYSQL.password (required when DB.engine = MySQL)\n"
|
||||
if !defined $obj->MYSQL_password;
|
||||
|
||||
die "config: missing required property MYSQL.database (required when DB.engine = MySQL)\n"
|
||||
if !defined $obj->MYSQL_database;
|
||||
}
|
||||
elsif ( $obj->DB_engine eq 'PostgreSQL' ) {
|
||||
die "config: missing required property POSTGRESQL.host (required when DB.engine = PostgreSQL)\n"
|
||||
if !defined $obj->POSTGRESQL_host;
|
||||
|
||||
die "config: missing required property POSTGRESQL.user (required when DB.engine = PostgreSQL)\n"
|
||||
if !defined $obj->POSTGRESQL_user;
|
||||
|
||||
die "config: missing required property POSTGRESQL.password (required when DB.engine = PostgreSQL)\n"
|
||||
if !defined $obj->POSTGRESQL_password;
|
||||
|
||||
die "config: missing required property POSTGRESQL.database (required when DB.engine = PostgreSQL)\n"
|
||||
if !defined $obj->POSTGRESQL_database;
|
||||
}
|
||||
elsif ( $obj->DB_engine eq 'SQLite' ) {
|
||||
die "config: missing required property SQLITE.database_file (required when DB.engine = SQLite)\n"
|
||||
if !defined $obj->SQLITE_database_file;
|
||||
}
|
||||
|
||||
# Check unknown property names
|
||||
{
|
||||
my @unrecognized;
|
||||
for my $section ( $ini->Sections ) {
|
||||
for my $param ( $ini->Parameters( $section ) ) {
|
||||
push @unrecognized, "$section.$param";
|
||||
}
|
||||
}
|
||||
if ( @unrecognized ) {
|
||||
die "config: unrecognized property(s): " . join( ", ", sort @unrecognized ) . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Emit deprecation warnings
|
||||
for my $message ( @warnings ) {
|
||||
$log->warning( $message );
|
||||
}
|
||||
|
||||
return $obj;
|
||||
}
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 check_db
|
||||
|
||||
Returns a normalized string based on the supported databases.
|
||||
|
||||
=head3 EXCEPTION
|
||||
|
||||
Dies if the value is not one of SQLite, PostgreSQL or MySQL.
|
||||
|
||||
=cut
|
||||
|
||||
sub check_db {
|
||||
my ( $self, $db ) = @_;
|
||||
|
||||
$db = untaint_engine_type( $db ) #
|
||||
// die "Unknown database '$db', should be one of SQLite, MySQL or PostgreSQL\n";
|
||||
|
||||
return _normalize_engine_type( $db );
|
||||
}
|
||||
|
||||
|
||||
=head2 DB_engine
|
||||
|
||||
Get the value of L<DB.engine|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#engine>.
|
||||
|
||||
Returns one of C<"SQLite">, C<"PostgreSQL"> or C<"MySQL">.
|
||||
|
||||
=cut
|
||||
|
||||
sub DB_engine {
|
||||
my ( $self ) = @_;
|
||||
return $self->{_DB_engine};
|
||||
}
|
||||
|
||||
sub _set_DB_engine {
|
||||
my ( $self, $value ) = @_;
|
||||
|
||||
$value = untaint_engine_type( $value ) #
|
||||
// die "Invalid value for DB.engine: $value\n";
|
||||
|
||||
$self->{_DB_engine} = _normalize_engine_type( $value );
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 DB_polling_interval
|
||||
|
||||
Get the value of L<DB.polling_interval|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#polling_interval>.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 MYSQL_database
|
||||
|
||||
Get the value of L<MYSQL.database|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#database>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 MYSQL_host
|
||||
|
||||
Get the value of L<MYSQL.host|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#host>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 MYSQL_port
|
||||
|
||||
Returns the L<MYSQL.port|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#port>
|
||||
property from the loaded config.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 MYSQL_password
|
||||
|
||||
Get the value of L<MYSQL.password|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#password>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 MYSQL_user
|
||||
|
||||
Get the value of L<MYSQL.user|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#user>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 POSTGRESQL_database
|
||||
|
||||
Get the value of L<POSTGRESQL.database|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#database-1>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 POSTGRESQL_host
|
||||
|
||||
Get the value of L<POSTGRESQL.host|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#host-1>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 POSTGRESQL_port
|
||||
|
||||
Returns the L<POSTGRESQL.port|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#port-1>
|
||||
property from the loaded config.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 POSTGRESQL_password
|
||||
|
||||
Get the value of L<POSTGRESQL.password|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#password-1>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 POSTGRESQL_user
|
||||
|
||||
Get the value of L<POSTGRESQL.user|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#user-1>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 SQLITE_database_file
|
||||
|
||||
Get the value of L<SQLITE.database_file|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#database_file>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 LANGUAGE_locale
|
||||
|
||||
Get the value of L<LANGUAGE.locale|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#locale>.
|
||||
|
||||
Returns a mapping from two-letter locale tag prefixes to full locale tags.
|
||||
This is represented by a hash mapping prefix to full locale tag.
|
||||
|
||||
E.g.:
|
||||
|
||||
(
|
||||
en => "en_US",
|
||||
sv => "sv_SE",
|
||||
)
|
||||
|
||||
|
||||
=head2 PUBLIC_PROFILES
|
||||
|
||||
Get the set of L<PUBLIC PROFILES|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#public-profiles-and-private-profiles-sections>.
|
||||
|
||||
Returns a hash mapping profile names to profile paths.
|
||||
The profile names are normalized to lowercase.
|
||||
Profile paths are either strings or C<undef>.
|
||||
C<undef> means that the Zonemaster Engine default profile should be used.
|
||||
|
||||
|
||||
=head2 PRIVATE_PROFILES
|
||||
|
||||
Get the set of L<PRIVATE PROFILES|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#public-profiles-and-private-profiles-sections>.
|
||||
|
||||
Returns a hash mapping profile names to profile paths.
|
||||
The profile names are normalized to lowercase.
|
||||
Profile paths are always strings (contrast with L<PUBLIC_PROFILES>).
|
||||
|
||||
|
||||
=head2 ZONEMASTER_max_zonemaster_execution_time
|
||||
|
||||
Get the value of L<ZONEMASTER.max_zonemaster_execution_time|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#max_zonemaster_execution_time>.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 ZONEMASTER_number_of_processes_for_frontend_testing
|
||||
|
||||
Get the value of
|
||||
L<ZONEMASTER.number_of_processes_for_frontend_testing|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#number_of_processes_for_frontend_testing>.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 ZONEMASTER_number_of_processes_for_batch_testing
|
||||
|
||||
Get the value of
|
||||
L<ZONEMASTER.number_of_processes_for_batch_testing|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#number_of_processes_for_batch_testing>.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 ZONEMASTER_lock_on_queue
|
||||
|
||||
Get the value of
|
||||
L<ZONEMASTER.lock_on_queue|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#lock_on_queue>.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 ZONEMASTER_age_reuse_previous_test
|
||||
|
||||
Get the value of
|
||||
L<ZONEMASTER.age_reuse_previous_test|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#age_reuse_previous_test>.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 METRICS_statsd_host
|
||||
|
||||
Get the value of
|
||||
L<METRICS.statsd_host|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#statsd_host>.
|
||||
|
||||
Returns a string.
|
||||
|
||||
|
||||
=head2 METRICS_statsd_port
|
||||
|
||||
Get the value of
|
||||
L<METRICS.statsd_host|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#statsd_port>.
|
||||
|
||||
Returns a number.
|
||||
|
||||
|
||||
=head2 RPCAPI_enable_user_create
|
||||
|
||||
Experimental.
|
||||
Get the value of
|
||||
L<RPCAPI.enable_user_create|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#enable_user_create>.
|
||||
|
||||
Return 0 or 1
|
||||
|
||||
|
||||
=head2 RPCAPI_enable_batch_create
|
||||
|
||||
Experimental.
|
||||
Get the value of
|
||||
L<RPCAPI.enable_batch_create|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#enable_batch_create>.
|
||||
|
||||
Return 0 or 1
|
||||
|
||||
|
||||
=head2 RPCAPI_enable_add_api_user
|
||||
|
||||
Get the value of
|
||||
L<RPCAPI.enable_add_api_user|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#enable_add_api_user>.
|
||||
|
||||
Return 0 or 1
|
||||
|
||||
|
||||
=head2 RPCAPI_enable_add_batch_job
|
||||
|
||||
Get the value of
|
||||
L<RPCAPI.enable_add_batch_job|https://github.com/zonemaster/zonemaster/blob/master/docs/public/configuration/backend.md#enable_add_batch_job>.
|
||||
|
||||
Return 0 or 1
|
||||
|
||||
=cut
|
||||
|
||||
# Getters for the properties documented above
|
||||
sub DB_polling_interval { return $_[0]->{_DB_polling_interval}; }
|
||||
sub MYSQL_host { return $_[0]->{_MYSQL_host}; }
|
||||
sub MYSQL_port { return $_[0]->{_MYSQL_port}; }
|
||||
sub MYSQL_user { return $_[0]->{_MYSQL_user}; }
|
||||
sub MYSQL_password { return $_[0]->{_MYSQL_password}; }
|
||||
sub MYSQL_database { return $_[0]->{_MYSQL_database}; }
|
||||
sub POSTGRESQL_host { return $_[0]->{_POSTGRESQL_host}; }
|
||||
sub POSTGRESQL_port { return $_[0]->{_POSTGRESQL_port}; }
|
||||
sub POSTGRESQL_user { return $_[0]->{_POSTGRESQL_user}; }
|
||||
sub POSTGRESQL_password { return $_[0]->{_POSTGRESQL_password}; }
|
||||
sub POSTGRESQL_database { return $_[0]->{_POSTGRESQL_database}; }
|
||||
sub SQLITE_database_file { return $_[0]->{_SQLITE_database_file}; }
|
||||
sub LANGUAGE_locale { return %{ $_[0]->{_LANGUAGE_locale} }; }
|
||||
sub PUBLIC_PROFILES { return %{ $_[0]->{_public_profiles} }; }
|
||||
sub PRIVATE_PROFILES { return %{ $_[0]->{_private_profiles} }; }
|
||||
sub ZONEMASTER_max_zonemaster_execution_time { return $_[0]->{_ZONEMASTER_max_zonemaster_execution_time}; }
|
||||
sub ZONEMASTER_lock_on_queue { return $_[0]->{_ZONEMASTER_lock_on_queue}; }
|
||||
sub ZONEMASTER_number_of_processes_for_frontend_testing { return $_[0]->{_ZONEMASTER_number_of_processes_for_frontend_testing}; }
|
||||
sub ZONEMASTER_number_of_processes_for_batch_testing { return $_[0]->{_ZONEMASTER_number_of_processes_for_batch_testing}; }
|
||||
sub ZONEMASTER_age_reuse_previous_test { return $_[0]->{_ZONEMASTER_age_reuse_previous_test}; }
|
||||
sub METRICS_statsd_host { return $_[0]->{_METRICS_statsd_host}; }
|
||||
sub METRICS_statsd_port { return $_[0]->{_METRICS_statsd_port}; }
|
||||
sub RPCAPI_enable_user_create { return $_[0]->{_RPCAPI_enable_user_create}; } # experimental
|
||||
sub RPCAPI_enable_batch_create { return $_[0]->{_RPCAPI_enable_batch_create}; } # experimental
|
||||
sub RPCAPI_enable_add_api_user { return $_[0]->{_RPCAPI_enable_add_api_user}; }
|
||||
sub RPCAPI_enable_add_batch_job { return $_[0]->{_RPCAPI_enable_add_batch_job}; }
|
||||
|
||||
# Compile time generation of setters for the properties documented above
|
||||
UNITCHECK {
|
||||
_create_setter( '_set_DB_polling_interval', '_DB_polling_interval', \&untaint_strictly_positive_millis );
|
||||
_create_setter( '_set_MYSQL_host', '_MYSQL_host', \&untaint_host );
|
||||
_create_setter( '_set_MYSQL_port', '_MYSQL_port', \&untaint_strictly_positive_int );
|
||||
_create_setter( '_set_MYSQL_user', '_MYSQL_user', \&untaint_mariadb_user );
|
||||
_create_setter( '_set_MYSQL_password', '_MYSQL_password', \&untaint_password );
|
||||
_create_setter( '_set_MYSQL_database', '_MYSQL_database', \&untaint_mariadb_database );
|
||||
_create_setter( '_set_POSTGRESQL_host', '_POSTGRESQL_host', \&untaint_host );
|
||||
_create_setter( '_set_POSTGRESQL_port', '_POSTGRESQL_port', \&untaint_strictly_positive_int );
|
||||
_create_setter( '_set_POSTGRESQL_user', '_POSTGRESQL_user', \&untaint_postgresql_ident );
|
||||
_create_setter( '_set_POSTGRESQL_password', '_POSTGRESQL_password', \&untaint_password );
|
||||
_create_setter( '_set_POSTGRESQL_database', '_POSTGRESQL_database', \&untaint_postgresql_ident );
|
||||
_create_setter( '_set_SQLITE_database_file', '_SQLITE_database_file', \&untaint_abs_path );
|
||||
_create_setter( '_set_ZONEMASTER_max_zonemaster_execution_time', '_ZONEMASTER_max_zonemaster_execution_time', \&untaint_strictly_positive_int );
|
||||
_create_setter( '_set_ZONEMASTER_lock_on_queue', '_ZONEMASTER_lock_on_queue', \&untaint_non_negative_int );
|
||||
_create_setter( '_set_ZONEMASTER_number_of_processes_for_frontend_testing', '_ZONEMASTER_number_of_processes_for_frontend_testing', \&untaint_strictly_positive_int );
|
||||
_create_setter( '_set_ZONEMASTER_number_of_processes_for_batch_testing', '_ZONEMASTER_number_of_processes_for_batch_testing', \&untaint_non_negative_int );
|
||||
_create_setter( '_set_ZONEMASTER_age_reuse_previous_test', '_ZONEMASTER_age_reuse_previous_test', \&untaint_strictly_positive_int );
|
||||
_create_setter( '_set_METRICS_statsd_host', '_METRICS_statsd_host', \&untaint_host );
|
||||
_create_setter( '_set_METRICS_statsd_port', '_METRICS_statsd_port', \&untaint_strictly_positive_int );
|
||||
_create_setter( '_set_RPCAPI_enable_user_create', '_RPCAPI_enable_user_create', \&untaint_bool ); # experimental
|
||||
_create_setter( '_set_RPCAPI_enable_batch_create', '_RPCAPI_enable_batch_create', \&untaint_bool ); # experimental
|
||||
_create_setter( '_set_RPCAPI_enable_add_api_user', '_RPCAPI_enable_add_api_user', \&untaint_bool );
|
||||
_create_setter( '_set_RPCAPI_enable_add_batch_job', '_RPCAPI_enable_add_batch_job', \&untaint_bool );
|
||||
}
|
||||
|
||||
=head2 new_DB
|
||||
|
||||
Create a new database adapter object according to configuration.
|
||||
|
||||
The adapter connects to the database before it is returned.
|
||||
|
||||
=head3 INPUT
|
||||
|
||||
The database adapter class is selected based on the return value of
|
||||
L<DB_engine>.
|
||||
The database adapter class constructor is called without arguments and is
|
||||
expected to configure itself according to available global configuration.
|
||||
|
||||
=head3 RETURNS
|
||||
|
||||
A configured L<Zonemaster::Backend::DB> object.
|
||||
|
||||
=head3 EXCEPTIONS
|
||||
|
||||
=over 4
|
||||
|
||||
=item Dies if no adapter for the configured database engine can be loaded.
|
||||
|
||||
=item Dies if the adapter is unable to connect to the database.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new_DB {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $dbtype = $self->DB_engine;
|
||||
my $dbclass = Zonemaster::Backend::DB->get_db_class( $dbtype );
|
||||
my $db = $dbclass->from_config( $self );
|
||||
|
||||
return $db;
|
||||
}
|
||||
|
||||
=head2 new_PM
|
||||
|
||||
Create a new processing manager object according to configuration.
|
||||
|
||||
=head3 INPUT
|
||||
|
||||
The values of the following attributes affect the construction of the returned object:
|
||||
|
||||
=over
|
||||
|
||||
=item ZONEMASTER_max_zonemaster_execution_time
|
||||
|
||||
=item ZONEMASTER_number_of_processes_for_batch_testing
|
||||
|
||||
=item ZONEMASTER_number_of_processes_for_frontend_testing
|
||||
|
||||
=back
|
||||
|
||||
=head3 RETURNS
|
||||
|
||||
A configured L<Parallel::ForkManager> object.
|
||||
|
||||
=cut
|
||||
|
||||
sub new_PM {
|
||||
my $self = shift;
|
||||
|
||||
my $maximum_processes = $self->ZONEMASTER_number_of_processes_for_frontend_testing + $self->ZONEMASTER_number_of_processes_for_batch_testing;
|
||||
|
||||
my $timeout = $self->ZONEMASTER_max_zonemaster_execution_time;
|
||||
|
||||
my %times;
|
||||
|
||||
my $pm = Parallel::ForkManager->new( $maximum_processes );
|
||||
$pm->set_waitpid_blocking_sleep( 0 ) if $pm->can( 'set_waitpid_blocking_sleep' );
|
||||
|
||||
$pm->run_on_wait(
|
||||
sub {
|
||||
foreach my $pid ( $pm->running_procs ) {
|
||||
my $diff = time() - $times{$pid}[0];
|
||||
my $id = $times{$pid}[1];
|
||||
|
||||
if ( $diff > $timeout ) {
|
||||
$log->warning( "Worker process (pid $pid, testid $id): Timeout, sending SIGKILL" );
|
||||
kill 9, $pid;
|
||||
}
|
||||
}
|
||||
},
|
||||
1
|
||||
);
|
||||
|
||||
$pm->run_on_start(
|
||||
sub {
|
||||
my ( $pid, $id ) = @_;
|
||||
|
||||
$times{$pid} = [ time(), $id ];
|
||||
}
|
||||
);
|
||||
|
||||
$pm->run_on_finish(
|
||||
sub {
|
||||
my ( $pid, $exitcode, $id, $signal ) = @_;
|
||||
|
||||
delete $times{$pid};
|
||||
|
||||
my $message =
|
||||
( $signal )
|
||||
? "Terminated by signal $signal (SIG$SIG_NAME[$signal])"
|
||||
: "Terminated with exit code $exitcode";
|
||||
|
||||
$log->notice( "Worker process (pid $pid, testid $id): $message" );
|
||||
}
|
||||
);
|
||||
|
||||
return $pm;
|
||||
}
|
||||
|
||||
sub _set_locales {
|
||||
my ( $self, $value ) = @_;
|
||||
|
||||
my @locale_tags = split / +/, $value;
|
||||
|
||||
if ( !@locale_tags ) {
|
||||
die "config: Use of empty LANGUAGE.locale property is not permitted. Remove the LANGUAGE.locale entry or specify LANGUAGE.locale = en_US instead.";
|
||||
}
|
||||
|
||||
my %locales;
|
||||
|
||||
for my $locale_tag ( @locale_tags ) {
|
||||
$locale_tag = untaint_locale_tag( $locale_tag ) #
|
||||
// die "Illegal locale tag in LANGUAGE.locale: $locale_tag\n";
|
||||
|
||||
my $lang_code = $locale_tag =~ s/_..$//r;
|
||||
|
||||
if ( exists $locales{$lang_code} ) {
|
||||
die "Repeated language code in LANGUAGE.locale: $lang_code\n";
|
||||
}
|
||||
|
||||
$locales{$lang_code} = $locale_tag;
|
||||
}
|
||||
|
||||
$self->{_LANGUAGE_locale} = \%locales;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _add_public_profile {
|
||||
my ( $self, $name, $path ) = @_;
|
||||
|
||||
$name = untaint_profile_name( $name ) #
|
||||
// die "Invalid profile name in PUBLIC PROFILES section: $name\n";
|
||||
|
||||
$name = lc $name;
|
||||
|
||||
if ( defined $self->{_public_profiles}{$name} || exists $self->{_private_profiles}{$name} ) {
|
||||
die "Profile name not unique: $name\n";
|
||||
}
|
||||
|
||||
if ( defined $path ) {
|
||||
$path = untaint_abs_path( $path ) #
|
||||
// die "Path must be absolute for profile: $name\n";
|
||||
}
|
||||
|
||||
$self->{_public_profiles}{$name} = $path;
|
||||
return;
|
||||
}
|
||||
|
||||
sub _add_private_profile {
|
||||
my ( $self, $name, $path ) = @_;
|
||||
|
||||
$name = untaint_profile_name( $name ) #
|
||||
// die "Invalid profile name in PRIVATE PROFILES section: $name\n";
|
||||
|
||||
$name = lc $name;
|
||||
|
||||
if ( $name eq 'default' ) {
|
||||
die "Profile name must not be present in PRIVATE PROFILES section: $name\n";
|
||||
}
|
||||
|
||||
if ( exists $self->{_public_profiles}{$name} || exists $self->{_private_profiles}{$name} ) {
|
||||
die "Profile name not unique: $name\n";
|
||||
}
|
||||
|
||||
$path = untaint_abs_path( $path ) #
|
||||
// die "Path must be absolute for profile: $name\n";
|
||||
|
||||
$self->{_private_profiles}{$name} = $path;
|
||||
return;
|
||||
}
|
||||
|
||||
# Create a setter method with a given name using the given field and validator
|
||||
sub _create_setter {
|
||||
my ( $setter, $field, $validate ) = @_;
|
||||
|
||||
$setter =~ /^_set_([A-Z_]*)_([a-z_]*)$/
|
||||
or confess "Invalid setter name";
|
||||
my $section = $1;
|
||||
my $property = $2;
|
||||
|
||||
my $setter_impl = sub {
|
||||
my ( $self, $value ) = @_;
|
||||
|
||||
$self->{$field} = $validate->( $value ) #
|
||||
// die "Invalid value for $section.$property: $value\n";
|
||||
|
||||
return;
|
||||
};
|
||||
|
||||
no strict 'refs';
|
||||
*$setter = $setter_impl;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _normalize_engine_type {
|
||||
my ( $value ) = @_;
|
||||
|
||||
# Normalized to camel case to match the database engine Perl module name, e.g. "SQLite.pm".
|
||||
state $db_module_names = {
|
||||
mysql => 'MySQL',
|
||||
postgresql => 'PostgreSQL',
|
||||
sqlite => 'SQLite',
|
||||
};
|
||||
|
||||
return $db_module_names->{ lc $value };
|
||||
}
|
||||
|
||||
1;
|
||||
155
zonemaster-backend/lib/Zonemaster/Backend/Config/DCPlugin.pm
Normal file
155
zonemaster-backend/lib/Zonemaster/Backend/Config/DCPlugin.pm
Normal file
@@ -0,0 +1,155 @@
|
||||
package Zonemaster::Backend::Config::DCPlugin;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Zonemaster::Backend::Config::DCPlugin - Daemon::Control plugin that
|
||||
loads the backend configuration.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Provides validated and sanity-checked backend configuration through the
|
||||
L<config>, L<db> and L<pm> properties.
|
||||
|
||||
my $daemon = Daemon::Control
|
||||
->with_plugins('+Zonemaster::Backend::Config::DCPlugin')
|
||||
->new({
|
||||
program => sub {
|
||||
my $self = shift;
|
||||
|
||||
$self->init_backend_config();
|
||||
|
||||
my $config = $self->config;
|
||||
my $db = $self->db;
|
||||
my $pm = $self->pm;
|
||||
...
|
||||
},
|
||||
});
|
||||
|
||||
No configuration is loaded automatically.
|
||||
Instead a successful call to init_backend_config() is required.
|
||||
|
||||
On restart the reload_config() method is called automatically.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mattias P, C<< <mattias.paivarinta@iis.se> >>
|
||||
|
||||
=cut
|
||||
|
||||
use parent 'Daemon::Control';
|
||||
use Role::Tiny; # Must be loaded before Class::Method::Modifiers or it will warn
|
||||
|
||||
use Carp;
|
||||
use Class::Method::Modifiers;
|
||||
use Hash::Util::FieldHash qw( fieldhash );
|
||||
use Log::Any qw( $log );
|
||||
use Zonemaster::Backend::Config;
|
||||
|
||||
before do_restart => \&init_backend_config;
|
||||
|
||||
# Using the inside-out technique to avoid collisions with other instance
|
||||
# variables.
|
||||
fieldhash my %config;
|
||||
fieldhash my %db;
|
||||
fieldhash my %pm;
|
||||
|
||||
=head1 INSTANCE METHODS
|
||||
|
||||
=head2 init_backend_config
|
||||
|
||||
Initializes or reinitializes the L<config>, L<db> and L<pm> properties.
|
||||
|
||||
A candidate for the L<config> property is either accepted as an argument,
|
||||
or L<Zonemaster::Backend::Config::load_config> is invoked to provide one.
|
||||
Candidates for the L<db> and L<pm> properties are constructed according to the
|
||||
L<config> candidate.
|
||||
|
||||
Returns 1 if all candidates are successfully constructed.
|
||||
In this case all properties are assigned their respective candidate values.
|
||||
|
||||
Returns 0 if the construction of any one of the candidates fails.
|
||||
Details about the construction failure are logged.
|
||||
None of the properties are updated.
|
||||
|
||||
=cut
|
||||
|
||||
sub init_backend_config {
|
||||
my ( $self, $config_candidate ) = @_;
|
||||
|
||||
eval {
|
||||
$config_candidate //= Zonemaster::Backend::Config->load_config();
|
||||
my $db_candidate = $config_candidate->new_DB();
|
||||
my $pm_candidate = $config_candidate->new_PM();
|
||||
|
||||
$config{$self} = $config_candidate;
|
||||
$db{$self} = $db_candidate;
|
||||
$pm{$self} = $pm_candidate;
|
||||
};
|
||||
|
||||
if ( $@ ) {
|
||||
$log->warn( "Failed to load the configuration: $@" );
|
||||
return 0;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=head1 PROPERTIES
|
||||
|
||||
=head2 config
|
||||
|
||||
Getter for the currently loaded configuration.
|
||||
|
||||
Throws an exception if no successful call to init_backend_config() has been
|
||||
made prior to this call.
|
||||
|
||||
=cut
|
||||
|
||||
sub config {
|
||||
my ( $self ) = @_;
|
||||
|
||||
exists $config{$self} or croak "Not initialized";
|
||||
|
||||
return $config{$self};
|
||||
}
|
||||
|
||||
=head2 db
|
||||
|
||||
Getter for a database adapter constructed according to the current
|
||||
configuration.
|
||||
|
||||
Throws an exception if no successful call to init_backend_config() has been
|
||||
made prior to this call.
|
||||
|
||||
=cut
|
||||
|
||||
sub db {
|
||||
my ( $self ) = @_;
|
||||
|
||||
exists $db{$self} or croak "Not initialized";
|
||||
|
||||
return $db{$self};
|
||||
}
|
||||
|
||||
=head2 pm
|
||||
|
||||
Getter for a processing manager constructed according to the current
|
||||
configuration.
|
||||
|
||||
Throws an exception if no successful call to init_backend_config() has been
|
||||
made prior to this call.
|
||||
|
||||
=cut
|
||||
|
||||
sub pm {
|
||||
my ( $self ) = @_;
|
||||
|
||||
exists $pm{$self} or croak "Not initialized";
|
||||
|
||||
return $pm{$self};
|
||||
}
|
||||
|
||||
1;
|
||||
1056
zonemaster-backend/lib/Zonemaster/Backend/DB.pm
Normal file
1056
zonemaster-backend/lib/Zonemaster/Backend/DB.pm
Normal file
File diff suppressed because it is too large
Load Diff
344
zonemaster-backend/lib/Zonemaster/Backend/DB/MySQL.pm
Normal file
344
zonemaster-backend/lib/Zonemaster/Backend/DB/MySQL.pm
Normal file
@@ -0,0 +1,344 @@
|
||||
package Zonemaster::Backend::DB::MySQL;
|
||||
|
||||
our $VERSION = '1.1.0';
|
||||
|
||||
use Moose;
|
||||
use 5.14.2;
|
||||
|
||||
use DBI qw(:utils);
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use JSON::PP;
|
||||
|
||||
use Zonemaster::Backend::Validator qw( untaint_ipv6_address );
|
||||
use Zonemaster::Backend::Errors;
|
||||
|
||||
with 'Zonemaster::Backend::DB';
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=head2 from_config
|
||||
|
||||
Construct a new instance from a Zonemaster::Backend::Config.
|
||||
|
||||
my $db = Zonemaster::Backend::DB::MySQL->from_config( $config );
|
||||
|
||||
=cut
|
||||
|
||||
sub from_config {
|
||||
my ( $class, $config ) = @_;
|
||||
|
||||
my $database = $config->MYSQL_database;
|
||||
my $host = $config->MYSQL_host;
|
||||
my $port = $config->MYSQL_port;
|
||||
my $user = $config->MYSQL_user;
|
||||
my $password = $config->MYSQL_password;
|
||||
|
||||
if ( untaint_ipv6_address( $host ) ) {
|
||||
$host = "[$host]";
|
||||
}
|
||||
|
||||
my $data_source_name = "DBI:mysql:database=$database;host=$host;port=$port";
|
||||
|
||||
return $class->new(
|
||||
{
|
||||
data_source_name => $data_source_name,
|
||||
user => $user,
|
||||
password => $password,
|
||||
dbhandle => undef,
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
sub get_dbh_specific_attributes {
|
||||
return {};
|
||||
}
|
||||
|
||||
sub create_schema {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $dbh = $self->dbh;
|
||||
|
||||
####################################################################
|
||||
# TEST RESULTS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS test_results (
|
||||
id BIGINT AUTO_INCREMENT PRIMARY KEY,
|
||||
hash_id VARCHAR(16) NOT NULL,
|
||||
domain varchar(255) NOT NULL,
|
||||
batch_id integer NULL,
|
||||
created_at DATETIME NOT NULL,
|
||||
started_at DATETIME DEFAULT NULL,
|
||||
ended_at DATETIME DEFAULT NULL,
|
||||
priority integer DEFAULT 10,
|
||||
queue integer DEFAULT 0,
|
||||
progress integer DEFAULT 0,
|
||||
fingerprint character varying(32),
|
||||
params blob NOT NULL,
|
||||
results mediumblob DEFAULT NULL,
|
||||
undelegated integer NOT NULL DEFAULT 0,
|
||||
|
||||
UNIQUE (hash_id)
|
||||
) ENGINE=InnoDB
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "MySQL error, could not create 'test_results' table", data => $dbh->errstr() );
|
||||
|
||||
# Manually create the index if it does not exist
|
||||
# the clause IF NOT EXISTS is not available for MySQL (used with FreeBSD)
|
||||
|
||||
# retrieve all indexes by key name
|
||||
my $indexes = $dbh->selectall_hashref( 'SHOW INDEXES FROM test_results', 'Key_name' );
|
||||
|
||||
if ( not exists($indexes->{test_results__hash_id}) ) {
|
||||
$dbh->do(
|
||||
'CREATE INDEX test_results__hash_id ON test_results (hash_id)'
|
||||
);
|
||||
}
|
||||
if ( not exists($indexes->{test_results__fingerprint}) ) {
|
||||
$dbh->do(
|
||||
'CREATE INDEX test_results__fingerprint ON test_results (fingerprint)'
|
||||
);
|
||||
}
|
||||
if ( not exists($indexes->{test_results__batch_id_progress}) ) {
|
||||
$dbh->do(
|
||||
'CREATE INDEX test_results__batch_id_progress ON test_results (batch_id, progress)'
|
||||
);
|
||||
}
|
||||
if ( not exists($indexes->{test_results__progress}) ) {
|
||||
$dbh->do(
|
||||
'CREATE INDEX test_results__progress ON test_results (progress)'
|
||||
);
|
||||
}
|
||||
if ( not exists($indexes->{test_results__domain_undelegated}) ) {
|
||||
$dbh->do(
|
||||
'CREATE INDEX test_results__domain_undelegated ON test_results (domain, undelegated)'
|
||||
);
|
||||
}
|
||||
|
||||
####################################################################
|
||||
# LOG LEVEL
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
"CREATE TABLE IF NOT EXISTS log_level (
|
||||
value INT,
|
||||
level VARCHAR(15),
|
||||
|
||||
UNIQUE (value)
|
||||
) ENGINE=InnoDB
|
||||
"
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "MySQL error, could not create 'log_level' table", data => $dbh->errstr() );
|
||||
|
||||
my ( $c ) = $dbh->selectrow_array( "SELECT count(*) FROM log_level" );
|
||||
if ( $c == 0 ) {
|
||||
$dbh->do(
|
||||
"INSERT INTO log_level (value, level)
|
||||
VALUES
|
||||
(-2, 'DEBUG3'),
|
||||
(-1, 'DEBUG2'),
|
||||
( 0, 'DEBUG'),
|
||||
( 1, 'INFO'),
|
||||
( 2, 'NOTICE'),
|
||||
( 3, 'WARNING'),
|
||||
( 4, 'ERROR'),
|
||||
( 5, 'CRITICAL')
|
||||
"
|
||||
);
|
||||
}
|
||||
|
||||
####################################################################
|
||||
# RESULT ENTRIES
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
"CREATE TABLE IF NOT EXISTS result_entries (
|
||||
hash_id VARCHAR(16) NOT NULL,
|
||||
level INT NOT NULL,
|
||||
module VARCHAR(255) NOT NULL,
|
||||
testcase VARCHAR(255) NOT NULL,
|
||||
tag VARCHAR(255) NOT NULL,
|
||||
timestamp REAL NOT NULL,
|
||||
args BLOB NOT NULL,
|
||||
|
||||
CONSTRAINT fk_hash_id FOREIGN KEY (hash_id) REFERENCES test_results(hash_id),
|
||||
CONSTRAINT fk_level FOREIGN KEY (level) REFERENCES log_level(value)
|
||||
) ENGINE=InnoDB
|
||||
"
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "MySQL error, could not create 'result_entries' table", data => $dbh->errstr() );
|
||||
|
||||
$indexes = $dbh->selectall_hashref( 'SHOW INDEXES FROM result_entries', 'Key_name' );
|
||||
if ( not exists($indexes->{result_entries__hash_id}) ) {
|
||||
$dbh->do(
|
||||
'CREATE INDEX result_entries__hash_id ON result_entries (hash_id)'
|
||||
);
|
||||
}
|
||||
|
||||
if ( not exists($indexes->{result_entries__level}) ) {
|
||||
$dbh->do(
|
||||
'CREATE INDEX result_entries__level ON result_entries (level)'
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
####################################################################
|
||||
# BATCH JOBS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS batch_jobs (
|
||||
id integer AUTO_INCREMENT PRIMARY KEY,
|
||||
username character varying(50) NOT NULL,
|
||||
created_at DATETIME NOT NULL
|
||||
) ENGINE=InnoDB;
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "MySQL error, could not create 'batch_jobs' table", data => $dbh->errstr() );
|
||||
|
||||
|
||||
####################################################################
|
||||
# USERS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS users (
|
||||
id integer AUTO_INCREMENT primary key,
|
||||
username varchar(128),
|
||||
api_key varchar(512),
|
||||
|
||||
UNIQUE (username)
|
||||
) ENGINE=InnoDB;
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "MySQL error, could not create 'users' table", data => $dbh->errstr() );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 drop_tables
|
||||
|
||||
Drop all the tables if they exist.
|
||||
|
||||
=cut
|
||||
|
||||
sub drop_tables {
|
||||
my ( $self ) = @_;
|
||||
|
||||
# remove any FOREIGN KEY before droping the table
|
||||
# MariaDB <10.4 and MySQL do not support the IF EXISTS syntax
|
||||
# on ALTER TABLE and DROP FOREIGN KEY
|
||||
# MariaDB 10.3 is used on Ubuntu 20.04 LTS (eol 2023-04)
|
||||
# MySQL is used on FreeBSD
|
||||
my $tables = $self->dbh->selectall_hashref( 'SHOW TABLE STATUS', 'Name' );
|
||||
if ( exists $tables->{result_entries} ) {
|
||||
my @fk = $self->dbh->selectall_array( 'SELECT constraint_name FROM information_schema.referential_constraints' );
|
||||
@fk = map { ref eq 'ARRAY' ? @$_ : $_ } @fk;
|
||||
if ( grep( /^fk_hash_id$/, @fk ) ) {
|
||||
$self->dbh->do( "ALTER TABLE result_entries DROP FOREIGN KEY fk_hash_id" );
|
||||
}
|
||||
if ( grep( /^fk_level$/, @fk ) ) {
|
||||
$self->dbh->do( "ALTER TABLE result_entries DROP FOREIGN KEY fk_level" );
|
||||
}
|
||||
}
|
||||
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS test_results" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS result_entries" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS log_level" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS users" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS batch_jobs" );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub add_batch_job {
|
||||
my ( $self, $params ) = @_;
|
||||
my $batch_id;
|
||||
|
||||
my $dbh = $self->dbh;
|
||||
|
||||
if ( $self->user_authorized( $params->{username}, $params->{api_key} ) ) {
|
||||
$batch_id = $self->create_new_batch_job( $params->{username} );
|
||||
|
||||
my $test_params = $params->{test_params};
|
||||
my $priority = $test_params->{priority};
|
||||
my $queue_label = $test_params->{queue};
|
||||
|
||||
$dbh->{AutoCommit} = 0;
|
||||
eval {$dbh->do( "DROP INDEX test_results__hash_id ON test_results" );};
|
||||
eval {$dbh->do( "DROP INDEX test_results__fingerprint ON test_results" );};
|
||||
eval {$dbh->do( "DROP INDEX test_results__batch_id_progress ON test_results" );};
|
||||
eval {$dbh->do( "DROP INDEX test_results__progress ON test_results" );};
|
||||
eval {$dbh->do( "DROP INDEX test_results__domain_undelegated ON test_results" );};
|
||||
|
||||
my $sth = $dbh->prepare(
|
||||
q[
|
||||
INSERT INTO test_results (
|
||||
hash_id,
|
||||
domain,
|
||||
batch_id,
|
||||
created_at,
|
||||
priority,
|
||||
queue,
|
||||
fingerprint,
|
||||
params,
|
||||
undelegated
|
||||
) VALUES (?,?,?,?,?,?,?,?,?)
|
||||
],
|
||||
);
|
||||
foreach my $domain ( @{$params->{domains}} ) {
|
||||
$test_params->{domain} = _normalize_domain( $domain );
|
||||
|
||||
my $fingerprint = $self->generate_fingerprint( $test_params );
|
||||
my $encoded_params = $self->encode_params( $test_params );
|
||||
my $undelegated = $self->undelegated ( $test_params );
|
||||
|
||||
my $hash_id = substr(md5_hex(time().rand()), 0, 16);
|
||||
$sth->execute(
|
||||
$hash_id,
|
||||
$test_params->{domain},
|
||||
$batch_id,
|
||||
$self->format_time( time() ),
|
||||
$priority,
|
||||
$queue_label,
|
||||
$fingerprint,
|
||||
$encoded_params,
|
||||
$undelegated,
|
||||
);
|
||||
}
|
||||
$dbh->do( "CREATE INDEX test_results__hash_id ON test_results (hash_id, created_at)" );
|
||||
$dbh->do( "CREATE INDEX test_results__fingerprint ON test_results (fingerprint)" );
|
||||
$dbh->do( "CREATE INDEX test_results__batch_id_progress ON test_results (batch_id, progress)" );
|
||||
$dbh->do( "CREATE INDEX test_results__progress ON test_results (progress)" );
|
||||
$dbh->do( "CREATE INDEX test_results__domain_undelegated ON test_results (domain, undelegated)" );
|
||||
|
||||
$dbh->commit();
|
||||
$dbh->{AutoCommit} = 1;
|
||||
}
|
||||
else {
|
||||
die Zonemaster::Backend::Error::PermissionDenied->new( message => 'User not authorized to use batch mode', data => { username => $params->{username}} );
|
||||
}
|
||||
|
||||
return $batch_id;
|
||||
}
|
||||
|
||||
sub get_relative_start_time {
|
||||
my ( $self, $hash_id ) = @_;
|
||||
|
||||
return $self->dbh->selectrow_array(
|
||||
q[
|
||||
SELECT ? - started_at
|
||||
FROM test_results
|
||||
WHERE hash_id = ?
|
||||
],
|
||||
undef,
|
||||
$self->format_time( time() ),
|
||||
$hash_id,
|
||||
);
|
||||
}
|
||||
|
||||
sub is_duplicate {
|
||||
my ( $self ) = @_;
|
||||
|
||||
# for the list of codes see:
|
||||
# https://mariadb.com/kb/en/mariadb-error-codes/
|
||||
# https://dev.mysql.com/doc/mysql-errors/8.0/en/server-error-reference.html
|
||||
return ( $self->dbh->err == 1062 );
|
||||
}
|
||||
|
||||
no Moose;
|
||||
__PACKAGE__->meta()->make_immutable();
|
||||
|
||||
1;
|
||||
315
zonemaster-backend/lib/Zonemaster/Backend/DB/PostgreSQL.pm
Normal file
315
zonemaster-backend/lib/Zonemaster/Backend/DB/PostgreSQL.pm
Normal file
@@ -0,0 +1,315 @@
|
||||
package Zonemaster::Backend::DB::PostgreSQL;
|
||||
|
||||
our $VERSION = '1.1.0';
|
||||
|
||||
use Moose;
|
||||
use 5.14.2;
|
||||
|
||||
use DBI qw(:utils);
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use JSON::PP;
|
||||
use Try::Tiny;
|
||||
|
||||
use Zonemaster::Backend::DB;
|
||||
use Zonemaster::Backend::Errors;
|
||||
|
||||
with 'Zonemaster::Backend::DB';
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=head2 from_config
|
||||
|
||||
Construct a new instance from a Zonemaster::Backend::Config.
|
||||
|
||||
my $db = Zonemaster::Backend::DB::PostgreSQL->from_config( $config );
|
||||
|
||||
=cut
|
||||
|
||||
sub from_config {
|
||||
my ( $class, $config ) = @_;
|
||||
|
||||
my $database = $config->POSTGRESQL_database;
|
||||
my $host = $config->POSTGRESQL_host;
|
||||
my $port = $config->POSTGRESQL_port;
|
||||
my $user = $config->POSTGRESQL_user;
|
||||
my $password = $config->POSTGRESQL_password;
|
||||
|
||||
my $data_source_name = "DBI:Pg:dbname=$database;host=$host;port=$port";
|
||||
|
||||
return $class->new(
|
||||
{
|
||||
data_source_name => $data_source_name,
|
||||
user => $user,
|
||||
password => $password,
|
||||
dbhandle => undef,
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
sub get_dbh_specific_attributes {
|
||||
return { pg_enable_utf8 => 0 };
|
||||
}
|
||||
|
||||
sub create_schema {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $dbh = $self->dbh;
|
||||
|
||||
####################################################################
|
||||
# TEST RESULTS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS test_results (
|
||||
id BIGSERIAL PRIMARY KEY,
|
||||
hash_id VARCHAR(16) NOT NULL,
|
||||
domain VARCHAR(255) NOT NULL,
|
||||
batch_id integer,
|
||||
created_at TIMESTAMP NOT NULL,
|
||||
started_at TIMESTAMP DEFAULT NULL,
|
||||
ended_at TIMESTAMP DEFAULT NULL,
|
||||
priority integer DEFAULT 10,
|
||||
queue integer DEFAULT 0,
|
||||
progress integer DEFAULT 0,
|
||||
fingerprint varchar(32),
|
||||
params json NOT NULL,
|
||||
undelegated integer NOT NULL DEFAULT 0,
|
||||
results json,
|
||||
|
||||
UNIQUE (hash_id)
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "PostgreSQL error, could not create 'test_results' table", data => $dbh->errstr() );
|
||||
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__hash_id ON test_results (hash_id)'
|
||||
);
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__fingerprint ON test_results (fingerprint)'
|
||||
);
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__batch_id_progress ON test_results (batch_id, progress)'
|
||||
);
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__progress ON test_results (progress)'
|
||||
);
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__domain_undelegated ON test_results (domain, undelegated)'
|
||||
);
|
||||
# this index helps speed up query time to retrieve the next test to
|
||||
# perform when using batches
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__progress_priority_id ON test_results (progress, priority DESC, id) WHERE (progress = 0)'
|
||||
);
|
||||
|
||||
####################################################################
|
||||
# LOG LEVEL
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
"CREATE TABLE IF NOT EXISTS log_level (
|
||||
value INT,
|
||||
level VARCHAR(15),
|
||||
|
||||
UNIQUE (value)
|
||||
)
|
||||
"
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "PostgreSQL error, could not create 'log_level' table", data => $dbh->errstr() );
|
||||
my ( $c ) = $dbh->selectrow_array( "SELECT count(*) FROM log_level" );
|
||||
if ( $c == 0 ) {
|
||||
$dbh->do(
|
||||
"INSERT INTO log_level (value, level)
|
||||
VALUES
|
||||
(-2, 'DEBUG3'),
|
||||
(-1, 'DEBUG2'),
|
||||
( 0, 'DEBUG'),
|
||||
( 1, 'INFO'),
|
||||
( 2, 'NOTICE'),
|
||||
( 3, 'WARNING'),
|
||||
( 4, 'ERROR'),
|
||||
( 5, 'CRITICAL')
|
||||
"
|
||||
);
|
||||
}
|
||||
|
||||
####################################################################
|
||||
# RESULT ENTRIES
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS result_entries (
|
||||
hash_id VARCHAR(16) NOT NULL,
|
||||
level INT NOT NULL,
|
||||
module VARCHAR(255) NOT NULL,
|
||||
testcase VARCHAR(255) NOT NULL,
|
||||
tag VARCHAR(255) NOT NULL,
|
||||
timestamp REAL NOT NULL,
|
||||
args JSONb NOT NULL,
|
||||
|
||||
CONSTRAINT fk_hash_id FOREIGN KEY (hash_id) REFERENCES test_results(hash_id),
|
||||
CONSTRAINT fk_level FOREIGN KEY(level) REFERENCES log_level(value)
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "PostgreSQL error, could not create 'result_entries' table", data => $dbh->errstr() );
|
||||
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS result_entries__hash_id ON result_entries (hash_id)'
|
||||
);
|
||||
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS result_entries__level ON result_entries (level)'
|
||||
);
|
||||
|
||||
####################################################################
|
||||
# BATCH JOBS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS batch_jobs (
|
||||
id serial PRIMARY KEY,
|
||||
username varchar(50) NOT NULL,
|
||||
created_at TIMESTAMP NOT NULL
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "PostgreSQL error, could not create 'batch_jobs' table", data => $dbh->errstr() );
|
||||
|
||||
|
||||
####################################################################
|
||||
# USERS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS users (
|
||||
id serial PRIMARY KEY,
|
||||
username VARCHAR(128),
|
||||
api_key VARCHAR(512),
|
||||
|
||||
UNIQUE (username)
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "PostgreSQL error, could not create 'users' table", data => $dbh->errstr() );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 drop_tables
|
||||
|
||||
Drop all the tables if they exist.
|
||||
|
||||
=cut
|
||||
|
||||
sub drop_tables {
|
||||
my ( $self ) = @_;
|
||||
|
||||
# Temporarily set the message level just above "notice" to mute messages when the tables don't
|
||||
# exist.
|
||||
# Without setting this level we run the risk of tripping up Test::NoWarnings in unit tests.
|
||||
my ( $old_client_min_messages ) = $self->dbh->selectrow_array( "SHOW client_min_messages" );
|
||||
$self->dbh->do( "SET client_min_messages = warning" );
|
||||
|
||||
try {
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS test_results CASCADE" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS result_entries CASCADE" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS log_level" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS users" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS batch_jobs" );
|
||||
}
|
||||
finally {
|
||||
$self->dbh->do( "SET client_min_messages = ?", undef, $old_client_min_messages );
|
||||
};
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub add_batch_job {
|
||||
my ( $self, $params ) = @_;
|
||||
my $batch_id;
|
||||
|
||||
my $dbh = $self->dbh;
|
||||
|
||||
if ( $self->user_authorized( $params->{username}, $params->{api_key} ) ) {
|
||||
$batch_id = $self->create_new_batch_job( $params->{username} );
|
||||
|
||||
my $test_params = $params->{test_params};
|
||||
|
||||
my $priority = $test_params->{priority};
|
||||
my $queue_label = $test_params->{queue};
|
||||
|
||||
my $created_at = $self->format_time( time() );
|
||||
|
||||
$dbh->begin_work();
|
||||
$dbh->do( "ALTER TABLE test_results DROP CONSTRAINT IF EXISTS test_results_pkey" );
|
||||
$dbh->do( "DROP INDEX IF EXISTS test_results__hash_id" );
|
||||
$dbh->do( "DROP INDEX IF EXISTS test_results__fingerprint" );
|
||||
$dbh->do( "DROP INDEX IF EXISTS test_results__batch_id_progress" );
|
||||
$dbh->do( "DROP INDEX IF EXISTS test_results__progress" );
|
||||
$dbh->do( "DROP INDEX IF EXISTS test_results__domain_undelegated" );
|
||||
|
||||
$dbh->do(
|
||||
q[
|
||||
COPY test_results (
|
||||
hash_id,
|
||||
domain,
|
||||
batch_id,
|
||||
created_at,
|
||||
priority,
|
||||
queue,
|
||||
fingerprint,
|
||||
params,
|
||||
undelegated
|
||||
)
|
||||
FROM STDIN
|
||||
]
|
||||
);
|
||||
|
||||
foreach my $domain ( @{$params->{domains}} ) {
|
||||
$test_params->{domain} = _normalize_domain( $domain );
|
||||
|
||||
my $fingerprint = $self->generate_fingerprint( $test_params );
|
||||
my $encoded_params = $self->encode_params( $test_params );
|
||||
my $undelegated = $self->undelegated ( $test_params );
|
||||
|
||||
my $hash_id = substr(md5_hex(time().rand()), 0, 16);
|
||||
$dbh->pg_putcopydata(
|
||||
"$hash_id\t$test_params->{domain}\t$batch_id\t$created_at\t$priority\t$queue_label\t$fingerprint\t$encoded_params\t$undelegated\n"
|
||||
);
|
||||
}
|
||||
$dbh->pg_putcopyend();
|
||||
$dbh->do( "ALTER TABLE test_results ADD PRIMARY KEY (id)" );
|
||||
$dbh->do( "CREATE INDEX test_results__hash_id ON test_results (hash_id, created_at)" );
|
||||
$dbh->do( "CREATE INDEX test_results__fingerprint ON test_results (fingerprint)" );
|
||||
$dbh->do( "CREATE INDEX test_results__batch_id_progress ON test_results (batch_id, progress)" );
|
||||
$dbh->do( "CREATE INDEX test_results__progress ON test_results (progress)" );
|
||||
$dbh->do( "CREATE INDEX test_results__domain_undelegated ON test_results (domain, undelegated)" );
|
||||
|
||||
$dbh->commit();
|
||||
}
|
||||
else {
|
||||
die Zonemaster::Backend::Error::PermissionDenied->new( message => 'User not authorized to use batch mode', data => { username => $params->{username}} );
|
||||
}
|
||||
|
||||
return $batch_id;
|
||||
}
|
||||
|
||||
sub get_relative_start_time {
|
||||
my ( $self, $hash_id ) = @_;
|
||||
|
||||
return $self->dbh->selectrow_array(
|
||||
q[
|
||||
SELECT EXTRACT(EPOCH FROM ? - started_at)
|
||||
FROM test_results
|
||||
WHERE hash_id=?
|
||||
],
|
||||
undef,
|
||||
$self->format_time( time() ),
|
||||
$hash_id,
|
||||
);
|
||||
}
|
||||
|
||||
sub is_duplicate {
|
||||
my ( $self ) = @_;
|
||||
|
||||
# for the list of codes see:
|
||||
# https://www.postgresql.org/docs/current/errcodes-appendix.html
|
||||
return ( $self->dbh->state == 23505 );
|
||||
}
|
||||
|
||||
no Moose;
|
||||
__PACKAGE__->meta()->make_immutable();
|
||||
|
||||
1;
|
||||
301
zonemaster-backend/lib/Zonemaster/Backend/DB/SQLite.pm
Normal file
301
zonemaster-backend/lib/Zonemaster/Backend/DB/SQLite.pm
Normal file
@@ -0,0 +1,301 @@
|
||||
package Zonemaster::Backend::DB::SQLite;
|
||||
|
||||
our $VERSION = '1.1.0';
|
||||
|
||||
use Moose;
|
||||
use 5.14.2;
|
||||
|
||||
use DBI qw(:utils);
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use JSON::PP;
|
||||
|
||||
|
||||
use Zonemaster::Backend::Errors;
|
||||
|
||||
with 'Zonemaster::Backend::DB';
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=head2 from_config
|
||||
|
||||
Construct a new instance from a Zonemaster::Backend::Config.
|
||||
|
||||
my $db = Zonemaster::Backend::DB::SQLite->from_config( $config );
|
||||
|
||||
=cut
|
||||
|
||||
sub from_config {
|
||||
my ( $class, $config ) = @_;
|
||||
|
||||
my $file = $config->SQLITE_database_file;
|
||||
|
||||
my $data_source_name = "DBI:SQLite:dbname=$file";
|
||||
|
||||
return $class->new(
|
||||
{
|
||||
data_source_name => $data_source_name,
|
||||
user => '',
|
||||
password => '',
|
||||
dbhandle => undef,
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
sub DEMOLISH {
|
||||
my ( $self ) = @_;
|
||||
$self->dbh->disconnect() if defined $self->dbhandle && $self->dbhandle->ping;
|
||||
}
|
||||
|
||||
sub get_dbh_specific_attributes {
|
||||
return { sqlite_extended_result_codes => 1 };
|
||||
}
|
||||
|
||||
sub create_schema {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $dbh = $self->dbh;
|
||||
|
||||
# enable FOREIGN KEY support
|
||||
$dbh->do( 'PRAGMA foreign_keys = ON;' );
|
||||
|
||||
####################################################################
|
||||
# TEST RESULTS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS test_results (
|
||||
id integer PRIMARY KEY AUTOINCREMENT,
|
||||
hash_id VARCHAR(16) NOT NULL,
|
||||
domain VARCHAR(255) NOT NULL,
|
||||
batch_id integer NULL,
|
||||
created_at DATETIME NOT NULL,
|
||||
started_at DATETIME DEFAULT NULL,
|
||||
ended_at DATETIME DEFAULT NULL,
|
||||
priority integer DEFAULT 10,
|
||||
queue integer DEFAULT 0,
|
||||
progress integer DEFAULT 0,
|
||||
fingerprint character varying(32),
|
||||
params text NOT NULL,
|
||||
results text DEFAULT NULL,
|
||||
undelegated boolean NOT NULL DEFAULT false,
|
||||
|
||||
UNIQUE (hash_id)
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "SQLite error, could not create 'test_results' table", data => $dbh->errstr() );
|
||||
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__hash_id ON test_results (hash_id)'
|
||||
);
|
||||
$self->dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__fingerprint ON test_results (fingerprint)'
|
||||
);
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__batch_id_progress ON test_results (batch_id, progress)'
|
||||
);
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__progress ON test_results (progress)'
|
||||
);
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS test_results__domain_undelegated ON test_results (domain, undelegated)'
|
||||
);
|
||||
|
||||
####################################################################
|
||||
# LOG LEVEL
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
"CREATE TABLE IF NOT EXISTS log_level (
|
||||
value INTEGER,
|
||||
level VARCHAR(15),
|
||||
|
||||
UNIQUE (value)
|
||||
)
|
||||
"
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "SQLite error, could not create 'log_level' table", data => $dbh->errstr() );
|
||||
|
||||
my ( $c ) = $dbh->selectrow_array( "SELECT count(*) FROM log_level" );
|
||||
if ( $c == 0 ) {
|
||||
$dbh->do(
|
||||
"INSERT INTO log_level (value, level)
|
||||
VALUES
|
||||
(-2, 'DEBUG3'),
|
||||
(-1, 'DEBUG2'),
|
||||
( 0, 'DEBUG'),
|
||||
( 1, 'INFO'),
|
||||
( 2, 'NOTICE'),
|
||||
( 3, 'WARNING'),
|
||||
( 4, 'ERROR'),
|
||||
( 5, 'CRITICAL')
|
||||
"
|
||||
);
|
||||
}
|
||||
|
||||
####################################################################
|
||||
# RESULT ENTRIES
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS result_entries (
|
||||
hash_id VARCHAR(16) NOT NULL,
|
||||
level INT NOT NULL,
|
||||
module VARCHAR(255) NOT NULL,
|
||||
testcase VARCHAR(255) NOT NULL,
|
||||
tag VARCHAR(255) NOT NULL,
|
||||
timestamp REAL NOT NULL,
|
||||
args BLOB NOT NULL,
|
||||
|
||||
FOREIGN KEY(hash_id) REFERENCES test_results(hash_id),
|
||||
FOREIGN KEY(level) REFERENCES log_level(value)
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "SQLite error, could not create 'result_entries' table", data => $dbh->errstr() );
|
||||
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS result_entries__hash_id ON result_entries (hash_id)'
|
||||
);
|
||||
|
||||
$dbh->do(
|
||||
'CREATE INDEX IF NOT EXISTS result_entries__level ON result_entries (level)'
|
||||
);
|
||||
|
||||
####################################################################
|
||||
# BATCH JOBS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS batch_jobs (
|
||||
id integer PRIMARY KEY,
|
||||
username character varying(50) NOT NULL,
|
||||
created_at DATETIME NOT NULL
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "SQLite error, could not create 'batch_jobs' table", data => $dbh->errstr() );
|
||||
|
||||
|
||||
####################################################################
|
||||
# USERS
|
||||
####################################################################
|
||||
$dbh->do(
|
||||
'CREATE TABLE IF NOT EXISTS users (
|
||||
id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
username varchar(128),
|
||||
api_key varchar(512),
|
||||
|
||||
UNIQUE (username)
|
||||
)
|
||||
'
|
||||
) or die Zonemaster::Backend::Error::Internal->new( reason => "SQLite error, could not create 'users' table", data => $dbh->errstr() );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 drop_tables
|
||||
|
||||
Drop all the tables if they exist.
|
||||
|
||||
=cut
|
||||
|
||||
sub drop_tables {
|
||||
my ( $self ) = @_;
|
||||
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS test_results" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS result_entries" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS log_level" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS users" );
|
||||
$self->dbh->do( "DROP TABLE IF EXISTS batch_jobs" );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub add_batch_job {
|
||||
my ( $self, $params ) = @_;
|
||||
my $batch_id;
|
||||
|
||||
my $dbh = $self->dbh;
|
||||
|
||||
if ( $self->user_authorized( $params->{username}, $params->{api_key} ) ) {
|
||||
$batch_id = $self->create_new_batch_job( $params->{username} );
|
||||
|
||||
my $test_params = $params->{test_params};
|
||||
my $priority = $test_params->{priority};
|
||||
my $queue_label = $test_params->{queue};
|
||||
|
||||
$dbh->{AutoCommit} = 0;
|
||||
eval {$dbh->do( "DROP INDEX IF EXISTS test_results__hash_id " );};
|
||||
eval {$dbh->do( "DROP INDEX IF EXISTS test_results__fingerprint " );};
|
||||
eval {$dbh->do( "DROP INDEX IF EXISTS test_results__batch_id_progress " );};
|
||||
eval {$dbh->do( "DROP INDEX IF EXISTS test_results__progress " );};
|
||||
eval {$dbh->do( "DROP INDEX IF EXISTS test_results__domain_undelegated " );};
|
||||
|
||||
my $sth = $dbh->prepare( '
|
||||
INSERT INTO test_results (
|
||||
hash_id,
|
||||
domain,
|
||||
batch_id,
|
||||
created_at,
|
||||
priority,
|
||||
queue,
|
||||
fingerprint,
|
||||
params,
|
||||
undelegated
|
||||
) VALUES (?,?,?,?,?,?,?,?,?)'
|
||||
);
|
||||
foreach my $domain ( @{$params->{domains}} ) {
|
||||
$test_params->{domain} = _normalize_domain( $domain );
|
||||
|
||||
my $fingerprint = $self->generate_fingerprint( $test_params );
|
||||
my $encoded_params = $self->encode_params( $test_params );
|
||||
my $undelegated = $self->undelegated ( $test_params );
|
||||
|
||||
my $hash_id = substr(md5_hex(time().rand()), 0, 16);
|
||||
$sth->execute(
|
||||
$hash_id,
|
||||
$test_params->{domain},
|
||||
$batch_id,
|
||||
$self->format_time( time() ),
|
||||
$priority,
|
||||
$queue_label,
|
||||
$fingerprint,
|
||||
$encoded_params,
|
||||
$undelegated,
|
||||
);
|
||||
}
|
||||
$dbh->do( "CREATE INDEX test_results__hash_id ON test_results (hash_id, created_at)" );
|
||||
$dbh->do( "CREATE INDEX test_results__fingerprint ON test_results (fingerprint)" );
|
||||
$dbh->do( "CREATE INDEX test_results__batch_id_progress ON test_results (batch_id, progress)" );
|
||||
$dbh->do( "CREATE INDEX test_results__progress ON test_results (progress)" );
|
||||
$dbh->do( "CREATE INDEX test_results__domain_undelegated ON test_results (domain, undelegated)" );
|
||||
|
||||
$dbh->commit();
|
||||
$dbh->{AutoCommit} = 1;
|
||||
}
|
||||
else {
|
||||
die Zonemaster::Backend::Error::PermissionDenied->new( message => 'User not authorized to use batch mode', data => { username => $params->{username}} );
|
||||
}
|
||||
|
||||
return $batch_id;
|
||||
}
|
||||
|
||||
sub get_relative_start_time {
|
||||
my ( $self, $hash_id ) = @_;
|
||||
|
||||
return $self->dbh->selectrow_array(
|
||||
q[
|
||||
SELECT (julianday(?) - julianday(started_at)) * 3600 * 24
|
||||
FROM test_results
|
||||
WHERE hash_id = ?
|
||||
],
|
||||
undef,
|
||||
$self->format_time( time() ),
|
||||
$hash_id,
|
||||
);
|
||||
}
|
||||
|
||||
sub is_duplicate {
|
||||
my ( $self ) = @_;
|
||||
|
||||
# for the list of codes see: https://sqlite.org/rescode.html
|
||||
return ( $self->dbh->err == 2067 );
|
||||
}
|
||||
|
||||
no Moose;
|
||||
__PACKAGE__->meta()->make_immutable();
|
||||
|
||||
1;
|
||||
162
zonemaster-backend/lib/Zonemaster/Backend/Errors.pm
Normal file
162
zonemaster-backend/lib/Zonemaster/Backend/Errors.pm
Normal file
@@ -0,0 +1,162 @@
|
||||
package Zonemaster::Backend::Error;
|
||||
use Moose;
|
||||
use Data::Dumper;
|
||||
|
||||
use overload '""' => \&as_string;
|
||||
|
||||
has 'message' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'code' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'data' => (
|
||||
is => 'ro',
|
||||
isa => 'Any',
|
||||
default => undef,
|
||||
);
|
||||
|
||||
sub as_hash {
|
||||
my $self = shift;
|
||||
my $error = {
|
||||
code => $self->code,
|
||||
message => $self->message,
|
||||
error => ref($self),
|
||||
};
|
||||
$error->{data} = $self->data if defined $self->data;
|
||||
return $error;
|
||||
}
|
||||
|
||||
sub as_string {
|
||||
my $self = shift;
|
||||
my $str = sprintf "%s (code %d).", $self->message, $self->code;
|
||||
if (defined $self->data) {
|
||||
$str .= sprintf " Context: %s", $self->_data_dump;
|
||||
}
|
||||
return $str;
|
||||
}
|
||||
|
||||
sub _data_dump {
|
||||
my $self = shift;
|
||||
local $Data::Dumper::Indent = 0;
|
||||
local $Data::Dumper::Terse = 1;
|
||||
my $data = Dumper($self->data);
|
||||
$data =~ s/[\n\r]/ /g;
|
||||
return $data ;
|
||||
}
|
||||
|
||||
package Zonemaster::Backend::Error::Internal;
|
||||
use Moose;
|
||||
|
||||
use overload '""' => \&as_string;
|
||||
|
||||
extends 'Zonemaster::Backend::Error';
|
||||
|
||||
has '+message' => (
|
||||
default => 'Internal server error'
|
||||
);
|
||||
|
||||
has '+code' => (
|
||||
default => -32603
|
||||
);
|
||||
|
||||
has 'reason' => (
|
||||
isa => 'Str',
|
||||
is => 'ro'
|
||||
);
|
||||
|
||||
has 'method' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
builder => '_build_method'
|
||||
);
|
||||
|
||||
sub _build_method {
|
||||
my $s = 0;
|
||||
while (my @c = caller($s)) {
|
||||
$s ++;
|
||||
last if $c[3] eq 'Moose::Object::new';
|
||||
}
|
||||
my @c = caller($s);
|
||||
if ($c[3] =~ /^(.*)::handle_exception$/ ) {
|
||||
@c = caller(++$s);
|
||||
}
|
||||
|
||||
return $c[3];
|
||||
}
|
||||
|
||||
sub as_string {
|
||||
my $self = shift;
|
||||
|
||||
my $reason = $self->reason;
|
||||
$reason =~ s/\s+/ /g;
|
||||
$reason =~ s/^\s+|\s+$//g;
|
||||
|
||||
my $str = sprintf "Caught %s in the `%s` method: %s", ref($self), $self->method, $reason;
|
||||
if (defined $self->data) {
|
||||
$str .= sprintf " Context: %s", $self->_data_dump;
|
||||
}
|
||||
return $str;
|
||||
}
|
||||
|
||||
around as_hash => sub {
|
||||
my ($orig, $self) = @_;
|
||||
|
||||
my $hash = $self->$orig;
|
||||
$hash->{reason} = $self->reason;
|
||||
$hash->{method} = $self->method;
|
||||
return $hash;
|
||||
};
|
||||
|
||||
|
||||
package Zonemaster::Backend::Error::ResourceNotFound;
|
||||
use Moose;
|
||||
|
||||
extends 'Zonemaster::Backend::Error';
|
||||
|
||||
has '+message' => (
|
||||
default => 'Resource not found'
|
||||
);
|
||||
|
||||
has '+code' => (
|
||||
default => -32000
|
||||
);
|
||||
|
||||
package Zonemaster::Backend::Error::PermissionDenied;
|
||||
use Moose;
|
||||
|
||||
extends 'Zonemaster::Backend::Error';
|
||||
|
||||
has '+message' => (
|
||||
default => 'Permission denied'
|
||||
);
|
||||
|
||||
has '+code' => (
|
||||
default => -32001
|
||||
);
|
||||
|
||||
package Zonemaster::Backend::Error::Conflict;
|
||||
use Moose;
|
||||
|
||||
extends 'Zonemaster::Backend::Error';
|
||||
|
||||
has '+message' => (
|
||||
default => 'Conflicting resource'
|
||||
);
|
||||
|
||||
has '+code' => (
|
||||
default => -32002
|
||||
);
|
||||
|
||||
package Zonemaster::Backend::Error::JsonError;
|
||||
use Moose;
|
||||
|
||||
extends 'Zonemaster::Backend::Error::Internal';
|
||||
|
||||
1;
|
||||
127
zonemaster-backend/lib/Zonemaster/Backend/Log.pm
Normal file
127
zonemaster-backend/lib/Zonemaster/Backend/Log.pm
Normal file
@@ -0,0 +1,127 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package Zonemaster::Backend::Log;
|
||||
|
||||
use English qw( $PID );
|
||||
use POSIX;
|
||||
use JSON::PP;
|
||||
use IO::Handle;
|
||||
use Log::Any::Adapter::Util ();
|
||||
use Carp;
|
||||
use Data::Dumper;
|
||||
|
||||
use base qw(Log::Any::Adapter::Base);
|
||||
|
||||
|
||||
my $default_level = Log::Any::Adapter::Util::numeric_level('info');
|
||||
|
||||
sub init {
|
||||
my ($self) = @_;
|
||||
|
||||
if ( defined $self->{log_level} && $self->{log_level} =~ /\D/ ) {
|
||||
$self->{log_level} = lc $self->{log_level};
|
||||
my $numeric_level = Log::Any::Adapter::Util::numeric_level( $self->{log_level} );
|
||||
if ( !defined($numeric_level) ) {
|
||||
croak "Error: Unrecognized log level " . $self->{log_level} . "\n";
|
||||
}
|
||||
$self->{log_level} = $numeric_level;
|
||||
}
|
||||
|
||||
$self->{log_level} //= $default_level;
|
||||
|
||||
my $fd;
|
||||
if ( !exists $self->{file} || $self->{file} eq '-') {
|
||||
if ( $self->{stderr} ) {
|
||||
$fd = fileno(STDERR);
|
||||
} else {
|
||||
$fd = fileno(STDOUT);
|
||||
}
|
||||
} else {
|
||||
open( $fd, '>>', $self->{file} ) or croak "Can't open log file: $!";
|
||||
}
|
||||
|
||||
$self->{handle} = IO::Handle->new_from_fd( $fd, "w" ) or croak "Can't fdopen file: $!";
|
||||
$self->{handle}->autoflush(1);
|
||||
|
||||
if ( !exists $self->{formatter} ) {
|
||||
if ( $self->{json} ) {
|
||||
$self->{formatter} = \&format_json;
|
||||
} else {
|
||||
$self->{formatter} = \&format_text;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub format_text {
|
||||
my ($self, $log_params) = @_;
|
||||
my $msg;
|
||||
$msg .= sprintf "%s ", $log_params->{timestamp};
|
||||
delete $log_params->{timestamp};
|
||||
$msg .= sprintf(
|
||||
"[%d] [%s] [%s] %s",
|
||||
delete $log_params->{pid},
|
||||
uc delete $log_params->{level},
|
||||
delete $log_params->{category},
|
||||
delete $log_params->{message}
|
||||
);
|
||||
|
||||
if ( %$log_params ) {
|
||||
local $Data::Dumper::Indent = 0;
|
||||
local $Data::Dumper::Terse = 1;
|
||||
my $data = Dumper($log_params);
|
||||
|
||||
$msg .= " Extra parameters: $data";
|
||||
}
|
||||
|
||||
return $msg
|
||||
}
|
||||
|
||||
sub format_json {
|
||||
my ($self, $log_params) = @_;
|
||||
|
||||
my $js = JSON::PP->new;
|
||||
$js->canonical( 1 );
|
||||
|
||||
return $js->encode( $log_params );
|
||||
}
|
||||
|
||||
|
||||
sub structured {
|
||||
my ($self, $level, $category, $string, @items) = @_;
|
||||
|
||||
my $log_level = Log::Any::Adapter::Util::numeric_level($level);
|
||||
|
||||
return if $log_level > $self->{log_level};
|
||||
|
||||
my %log_params = (
|
||||
timestamp => strftime( "%FT%TZ", gmtime ),
|
||||
level => $level,
|
||||
category => $category,
|
||||
message => $string,
|
||||
pid => $PID,
|
||||
);
|
||||
|
||||
for my $item ( @items ) {
|
||||
if (ref($item) eq 'HASH') {
|
||||
for my $key (keys %$item) {
|
||||
$log_params{$key} = $item->{$key};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $msg = $self->{formatter}->($self, \%log_params);
|
||||
$self->{handle}->print($msg . "\n");
|
||||
}
|
||||
|
||||
# From Log::Any::Adapter::File
|
||||
foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
|
||||
no strict 'refs';
|
||||
my $base = substr($method,3);
|
||||
my $method_level = Log::Any::Adapter::Util::numeric_level( $base );
|
||||
*{$method} = sub {
|
||||
return !!( $method_level <= $_[0]->{log_level} );
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
60
zonemaster-backend/lib/Zonemaster/Backend/Metrics.pm
Normal file
60
zonemaster-backend/lib/Zonemaster/Backend/Metrics.pm
Normal file
@@ -0,0 +1,60 @@
|
||||
package Zonemaster::Backend::Metrics;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Log::Any qw($log);
|
||||
|
||||
eval("use Net::Statsd");
|
||||
|
||||
my $enable_metrics = 0;
|
||||
|
||||
if (!$@) {
|
||||
$enable_metrics = 1;
|
||||
}
|
||||
|
||||
my %CODE_STATUS_HASH = (
|
||||
-32700 => 'RPC_PARSE_ERROR',
|
||||
-32600 => 'RPC_INVALID_REQUEST',
|
||||
-32601 => 'RPC_METHOD_NOT_FOUND',
|
||||
-32602 => 'RPC_INVALID_PARAMS',
|
||||
-32603 => 'RPC_INTERNAL_ERROR'
|
||||
);
|
||||
|
||||
sub setup {
|
||||
my ( $cls, $host, $port ) = @_;
|
||||
if (!defined $host) {
|
||||
$enable_metrics = 0;
|
||||
} elsif ( $enable_metrics ) {
|
||||
$log->info('Enabling metrics module', { host => $host, port => $port });
|
||||
$Net::Statsd::HOST = $host;
|
||||
$Net::Statsd::PORT = $port;
|
||||
}
|
||||
}
|
||||
|
||||
sub code_to_status {
|
||||
my ($cls, $code) = @_;
|
||||
if (defined $code) {
|
||||
return $CODE_STATUS_HASH{$code};
|
||||
} else {
|
||||
return 'RPC_SUCCESS';
|
||||
}
|
||||
}
|
||||
|
||||
sub increment {
|
||||
if ( $enable_metrics ) {
|
||||
Net::Statsd::increment(@_);
|
||||
}
|
||||
}
|
||||
|
||||
sub gauge {
|
||||
if ( $enable_metrics ) {
|
||||
Net::Statsd::gauge(@_);
|
||||
}
|
||||
}
|
||||
|
||||
sub timing {
|
||||
if ( $enable_metrics ) {
|
||||
Net::Statsd::timing(@_);
|
||||
}
|
||||
}
|
||||
916
zonemaster-backend/lib/Zonemaster/Backend/RPCAPI.pm
Normal file
916
zonemaster-backend/lib/Zonemaster/Backend/RPCAPI.pm
Normal file
@@ -0,0 +1,916 @@
|
||||
package Zonemaster::Backend::RPCAPI;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use 5.14.2;
|
||||
|
||||
# Public Modules
|
||||
use DBI qw(:utils);
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use File::Slurp qw(append_file);
|
||||
use HTML::Entities;
|
||||
use JSON::PP;
|
||||
use JSON::Validator::Joi;
|
||||
use Log::Any qw($log);
|
||||
use Mojo::JSON::Pointer;
|
||||
use Scalar::Util qw(blessed);
|
||||
use JSON::Validator::Schema::Draft7;
|
||||
use Locale::TextDomain qw[Zonemaster-Backend];
|
||||
use Locale::Messages qw[LC_MESSAGES LC_ALL];
|
||||
use POSIX qw (setlocale);
|
||||
use Encode;
|
||||
|
||||
# Zonemaster Modules
|
||||
use Zonemaster::Engine;
|
||||
use Zonemaster::Engine::Normalization qw( normalize_name trim_space );
|
||||
use Zonemaster::Engine::Profile;
|
||||
use Zonemaster::Engine::Recursor;
|
||||
use Zonemaster::Backend;
|
||||
use Zonemaster::Backend::Config;
|
||||
use Zonemaster::Backend::Translator;
|
||||
use Zonemaster::Backend::Validator;
|
||||
use Zonemaster::Backend::Errors;
|
||||
|
||||
my $zm_validator = Zonemaster::Backend::Validator->new;
|
||||
our %json_schemas;
|
||||
my $recursor = Zonemaster::Engine::Recursor->new;
|
||||
|
||||
sub joi {
|
||||
return JSON::Validator::Joi->new;
|
||||
}
|
||||
|
||||
sub new {
|
||||
my ( $type, $params ) = @_;
|
||||
|
||||
my $self = {};
|
||||
bless( $self, $type );
|
||||
|
||||
if ( ! $params || ! $params->{config} ) {
|
||||
handle_exception("Missing 'config' parameter");
|
||||
}
|
||||
|
||||
$self->{config} = $params->{config};
|
||||
|
||||
my $dbtype;
|
||||
if ( $params->{dbtype} ) {
|
||||
$dbtype = $self->{config}->check_db($params->{dbtype});
|
||||
} else {
|
||||
$dbtype = $self->{config}->DB_engine;
|
||||
}
|
||||
|
||||
$self->_init_db($dbtype);
|
||||
|
||||
$self->{_profiles} = Zonemaster::Backend::Config->load_profiles( #
|
||||
$self->{config}->PUBLIC_PROFILES,
|
||||
$self->{config}->PRIVATE_PROFILES,
|
||||
);
|
||||
|
||||
return ( $self );
|
||||
}
|
||||
|
||||
sub _init_db {
|
||||
my ( $self, $dbtype ) = @_;
|
||||
|
||||
eval {
|
||||
my $dbclass = Zonemaster::Backend::DB->get_db_class( $dbtype );
|
||||
$self->{db} = $dbclass->from_config( $self->{config} );
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
handle_exception("Failed to initialize the [$dbtype] database backend module: [$@]");
|
||||
}
|
||||
}
|
||||
|
||||
sub handle_exception {
|
||||
my ( $exception ) = @_;
|
||||
|
||||
if ( !$exception->isa('Zonemaster::Backend::Error') ) {
|
||||
my $reason = $exception;
|
||||
$exception = Zonemaster::Backend::Error::Internal->new( reason => $reason );
|
||||
}
|
||||
|
||||
my $log_extra = $exception->as_hash;
|
||||
delete $log_extra->{message};
|
||||
|
||||
if ( $exception->isa('Zonemaster::Backend::Error::Internal') ) {
|
||||
$log->error($exception->as_string, $log_extra);
|
||||
} else {
|
||||
$log->info($exception->as_string, $log_extra);
|
||||
}
|
||||
|
||||
die $exception->as_hash;
|
||||
}
|
||||
|
||||
$json_schemas{version_info} = joi->object->strict;
|
||||
sub version_info {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my %ver;
|
||||
eval {
|
||||
$ver{zonemaster_ldns} = Zonemaster::LDNS->VERSION;
|
||||
$ver{zonemaster_engine} = Zonemaster::Engine->VERSION;
|
||||
$ver{zonemaster_backend} = Zonemaster::Backend->VERSION;
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return \%ver;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{system_versions} = $json_schemas{version_info};
|
||||
sub system_versions {
|
||||
return version_info( @_ );
|
||||
}
|
||||
|
||||
$json_schemas{profile_names} = joi->object->strict;
|
||||
sub profile_names {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my %profiles;
|
||||
eval { %profiles = $self->{config}->PUBLIC_PROFILES };
|
||||
if ( $@ ) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return [ keys %profiles ];
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{conf_profiles} = $json_schemas{profile_names};
|
||||
sub conf_profiles {
|
||||
my $result = {
|
||||
profiles => profile_names( @_ )
|
||||
};
|
||||
return $result;
|
||||
}
|
||||
|
||||
# Return the list of language tags supported by get_test_results(). The tags are
|
||||
# derived from the locale tags set in the configuration file.
|
||||
$json_schemas{get_language_tags} = joi->object->strict;
|
||||
sub get_language_tags {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my @lang_tags;
|
||||
eval {
|
||||
my %locales = $self->{config}->LANGUAGE_locale;
|
||||
|
||||
@lang_tags = sort keys %locales;
|
||||
};
|
||||
if ( $@ ) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return \@lang_tags;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{conf_languages} = $json_schemas{get_language_tags};
|
||||
sub conf_languages {
|
||||
my $result = {
|
||||
languages => get_language_tags( @_ )
|
||||
};
|
||||
return $result;
|
||||
}
|
||||
|
||||
$json_schemas{get_host_by_name} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'hostname' ],
|
||||
properties => {
|
||||
hostname => $zm_validator->domain_name
|
||||
}
|
||||
};
|
||||
sub get_host_by_name {
|
||||
my ( $self, $params ) = @_;
|
||||
my @adresses;
|
||||
|
||||
eval {
|
||||
my $ns_name = $params->{hostname};
|
||||
|
||||
@adresses = map { {$ns_name => $_->short} } $recursor->get_addresses_for($ns_name);
|
||||
@adresses = { $ns_name => '0.0.0.0' } if not @adresses;
|
||||
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return \@adresses;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{lookup_address_records} = $json_schemas{get_host_by_name};
|
||||
sub lookup_address_records {
|
||||
my $result = {
|
||||
address_records => get_host_by_name( @_ )
|
||||
};
|
||||
return $result;
|
||||
}
|
||||
|
||||
$json_schemas{get_data_from_parent_zone} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'domain' ],
|
||||
properties => {
|
||||
domain => $zm_validator->domain_name,
|
||||
language => $zm_validator->language_tag,
|
||||
}
|
||||
};
|
||||
sub get_data_from_parent_zone {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $result = eval {
|
||||
my %result;
|
||||
my $domain = $params->{domain};
|
||||
my ( $_errors, $normalized_domain ) = normalize_name( trim_space ( $domain ) );
|
||||
|
||||
my @ns_list;
|
||||
my @ns_names;
|
||||
|
||||
my $zone = Zonemaster::Engine->zone( $normalized_domain );
|
||||
push @ns_list, { ns => $_->name->string, ip => $_->address->short} for @{$zone->glue};
|
||||
|
||||
my @ds_list;
|
||||
|
||||
$zone = Zonemaster::Engine->zone($normalized_domain);
|
||||
my $ds_p = $zone->parent->query_one( $zone->name, 'DS', { dnssec => 1, cd => 1, recurse => 1 } );
|
||||
if ($ds_p) {
|
||||
my @ds = $ds_p->get_records( 'DS', 'answer' );
|
||||
|
||||
foreach my $ds ( @ds ) {
|
||||
next unless $ds->type eq 'DS';
|
||||
push(@ds_list, { keytag => $ds->keytag, algorithm => $ds->algorithm, digtype => $ds->digtype, digest => $ds->hexdigest });
|
||||
}
|
||||
}
|
||||
|
||||
$result{ns_list} = \@ns_list;
|
||||
$result{ds_list} = \@ds_list;
|
||||
return \%result;
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
elsif ($result) {
|
||||
return $result;
|
||||
}
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{lookup_delegation_data} = $json_schemas{get_data_from_parent_zone};
|
||||
sub lookup_delegation_data {
|
||||
return get_data_from_parent_zone( @_ );
|
||||
}
|
||||
|
||||
$json_schemas{start_domain_test} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'domain' ],
|
||||
properties => {
|
||||
domain => $zm_validator->domain_name,
|
||||
ipv4 => joi->boolean->compile,
|
||||
ipv6 => joi->boolean->compile,
|
||||
nameservers => {
|
||||
type => 'array',
|
||||
items => $zm_validator->nameserver
|
||||
},
|
||||
ds_info => {
|
||||
type => 'array',
|
||||
items => $zm_validator->ds_info
|
||||
},
|
||||
profile => $zm_validator->profile_name,
|
||||
client_id => $zm_validator->client_id->compile,
|
||||
client_version => $zm_validator->client_version->compile,
|
||||
config => joi->string->compile,
|
||||
priority => $zm_validator->priority->compile,
|
||||
queue => $zm_validator->queue->compile,
|
||||
language => $zm_validator->language_tag,
|
||||
}
|
||||
};
|
||||
sub start_domain_test {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $result = 0;
|
||||
eval {
|
||||
$params->{profile} //= "default";
|
||||
$params->{priority} //= 10;
|
||||
$params->{queue} //= 0;
|
||||
|
||||
my $profile = $self->{_profiles}{ $params->{profile} };
|
||||
$params->{ipv4} //= $profile->get( "net.ipv4" );
|
||||
$params->{ipv6} //= $profile->get( "net.ipv6" );
|
||||
|
||||
$result = $self->{db}->create_new_test( $params->{domain}, $params, $self->{config}->ZONEMASTER_age_reuse_previous_test );
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{job_create} = $json_schemas{start_domain_test};
|
||||
sub job_create {
|
||||
my $result = {
|
||||
job_id => start_domain_test( @_ )
|
||||
};
|
||||
return $result;
|
||||
}
|
||||
|
||||
$json_schemas{test_progress} = joi->object->strict->props(
|
||||
test_id => $zm_validator->test_id->required
|
||||
);
|
||||
sub test_progress {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $result = 0;
|
||||
eval {
|
||||
my $test_id = $params->{test_id};
|
||||
$result = $self->{db}->test_progress( $test_id );
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{job_status} = joi->object->strict->props(
|
||||
job_id => $zm_validator->test_id->required
|
||||
);
|
||||
sub job_status {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
$params->{test_id} = delete $params->{job_id};
|
||||
|
||||
my $result = {
|
||||
progress => $self->test_progress( $params )
|
||||
};
|
||||
return $result;
|
||||
}
|
||||
|
||||
$json_schemas{get_test_params} = joi->object->strict->props(
|
||||
test_id => $zm_validator->test_id->required
|
||||
);
|
||||
sub get_test_params {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $result;
|
||||
eval {
|
||||
my $test_id = $params->{test_id};
|
||||
|
||||
$result = $self->{db}->get_test_params( $test_id );
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{job_params} = joi->object->strict->props(
|
||||
job_id => $zm_validator->test_id->required
|
||||
);
|
||||
sub job_params {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
$params->{test_id} = delete $params->{job_id};
|
||||
|
||||
return $self->get_test_params( $params );
|
||||
}
|
||||
|
||||
$json_schemas{get_test_results} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'id', 'language' ],
|
||||
properties => {
|
||||
id => $zm_validator->test_id->required->compile,
|
||||
language => $zm_validator->language_tag,
|
||||
}
|
||||
};
|
||||
sub get_test_results {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $result;
|
||||
eval{
|
||||
|
||||
my $locale = $self->_get_locale( $params );
|
||||
|
||||
my $translator;
|
||||
$translator = Zonemaster::Backend::Translator->instance();
|
||||
|
||||
my $previous_locale = $translator->locale;
|
||||
if ( !$translator->locale( $locale ) ) {
|
||||
die "Failed to set locale: $locale";
|
||||
}
|
||||
|
||||
eval { $translator->data } if $translator; # Provoke lazy loading of translation data
|
||||
|
||||
my @zm_results;
|
||||
my %testcases;
|
||||
|
||||
my $test_info = $self->{db}->test_results( $params->{id} );
|
||||
foreach my $test_res ( @{ $test_info->{results} } ) {
|
||||
my $res;
|
||||
if ( $test_res->{module} eq 'Nameserver' ) {
|
||||
$res->{ns} = ( $test_res->{args}->{ns} ) ? ( $test_res->{args}->{ns} ) : ( 'All' );
|
||||
}
|
||||
elsif ($test_res->{module} eq 'SYSTEM'
|
||||
&& $test_res->{tag} eq 'POLICY_DISABLED'
|
||||
&& $test_res->{args}->{name} eq 'Example' )
|
||||
{
|
||||
next;
|
||||
}
|
||||
|
||||
$res->{module} = $test_res->{module};
|
||||
$res->{message} = $translator->translate_tag( $test_res ) . "\n";
|
||||
$res->{message} =~ s/,/, /isg;
|
||||
$res->{message} =~ s/;/; /isg;
|
||||
$res->{level} = $test_res->{level};
|
||||
$res->{testcase} = $test_res->{testcase} // 'UNSPECIFIED';
|
||||
$testcases{$res->{testcase}} = $translator->test_case_description($res->{testcase});
|
||||
|
||||
if ( $test_res->{module} eq 'SYSTEM' ) {
|
||||
if ( $res->{message} =~ /policy\.json/ ) {
|
||||
my ( $policy ) = ( $res->{message} =~ /\s(\/.*)$/ );
|
||||
if ( $policy ) {
|
||||
my $policy_description = 'DEFAULT POLICY';
|
||||
$policy_description = 'SOME OTHER POLICY' if ( $policy =~ /some\/other\/policy\/path/ );
|
||||
$res->{message} =~ s/$policy/$policy_description/;
|
||||
}
|
||||
else {
|
||||
$res->{message} = 'UNKNOWN POLICY FORMAT';
|
||||
}
|
||||
}
|
||||
elsif ( $res->{message} =~ /config\.json/ ) {
|
||||
my ( $config ) = ( $res->{message} =~ /\s(\/.*)$/ );
|
||||
if ( $config ) {
|
||||
my $config_description = 'DEFAULT CONFIGURATION';
|
||||
$config_description = 'SOME OTHER CONFIGURATION' if ( $config =~ /some\/other\/configuration\/path/ );
|
||||
$res->{message} =~ s/$config/$config_description/;
|
||||
}
|
||||
else {
|
||||
$res->{message} = 'UNKNOWN CONFIG FORMAT';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
push( @zm_results, $res );
|
||||
}
|
||||
|
||||
$result = $test_info;
|
||||
$result->{testcase_descriptions} = \%testcases;
|
||||
$result->{results} = \@zm_results;
|
||||
|
||||
$translator->locale( $previous_locale );
|
||||
|
||||
$result = $test_info;
|
||||
$result->{results} = \@zm_results;
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{job_results} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'job_id', 'language' ],
|
||||
properties => {
|
||||
job_id => $zm_validator->test_id->required->compile,
|
||||
language => $zm_validator->language_tag,
|
||||
}
|
||||
};
|
||||
sub job_results {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
$params->{id} = delete $params->{job_id};
|
||||
|
||||
my $result = $self->get_test_results( $params );
|
||||
|
||||
return {
|
||||
created_at => $result->{created_at},
|
||||
job_id => $result->{hash_id},
|
||||
results => $result->{results},
|
||||
params => $result->{params},
|
||||
testcase_descriptions => $result->{testcase_descriptionsd},
|
||||
};
|
||||
}
|
||||
|
||||
$json_schemas{get_test_history} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'frontend_params' ],
|
||||
properties => {
|
||||
offset => joi->integer->min(0)->compile,
|
||||
limit => joi->integer->min(0)->compile,
|
||||
filter => joi->string->regex('^(?:all|delegated|undelegated)$')->compile,
|
||||
frontend_params => {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'domain' ],
|
||||
properties => {
|
||||
domain => $zm_validator->domain_name
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
sub get_test_history {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $results;
|
||||
|
||||
eval {
|
||||
$params->{offset} //= 0;
|
||||
$params->{limit} //= 200;
|
||||
$params->{filter} //= "all";
|
||||
|
||||
$results = $self->{db}->get_test_history( $params );
|
||||
my @results = map { { %$_, undelegated => $_->{undelegated} ? JSON::PP::true : JSON::PP::false } } @$results;
|
||||
$results = \@results;
|
||||
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return $results;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{domain_history} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'params' ],
|
||||
properties => {
|
||||
offset => joi->integer->min(0)->compile,
|
||||
limit => joi->integer->min(0)->compile,
|
||||
filter => joi->string->regex('^(?:all|delegated|undelegated)$')->compile,
|
||||
params => {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'domain' ],
|
||||
properties => {
|
||||
domain => $zm_validator->domain_name
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
sub domain_history {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
$params->{frontend_params} = delete $params->{params};
|
||||
|
||||
my $results = $self->get_test_history( $params );
|
||||
|
||||
return {
|
||||
history => [
|
||||
map {
|
||||
{
|
||||
job_id => $_->{id},
|
||||
created_at => $_->{created_at},
|
||||
overall_result => $_->{overall_result},
|
||||
undelegated => $_->{undelegated},
|
||||
}
|
||||
} @$results
|
||||
],
|
||||
};
|
||||
}
|
||||
|
||||
$json_schemas{add_api_user} = joi->object->strict->props(
|
||||
username => $zm_validator->username->required,
|
||||
api_key => $zm_validator->api_key->required,
|
||||
);
|
||||
sub add_api_user {
|
||||
my ( $self, $params, undef, $remote_ip ) = @_;
|
||||
|
||||
my $result = 0;
|
||||
|
||||
eval {
|
||||
my $allow = 0;
|
||||
if ( defined $remote_ip ) {
|
||||
$allow = 1 if ( $remote_ip eq '::1' || $remote_ip eq '127.0.0.1' || $remote_ip eq '::ffff:127.0.0.1' );
|
||||
}
|
||||
else {
|
||||
$allow = 1;
|
||||
}
|
||||
|
||||
if ( $allow ) {
|
||||
$result = 1 if ( $self->{db}->add_api_user( $params->{username}, $params->{api_key} ) eq '1' );
|
||||
}
|
||||
else {
|
||||
die Zonemaster::Backend::Error::PermissionDenied->new(
|
||||
message => 'Call to "add_api_user" method not permitted from a remote IP',
|
||||
data => { remote_ip => $remote_ip }
|
||||
);
|
||||
}
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{user_create} = $json_schemas{add_api_user};
|
||||
sub user_create {
|
||||
my $result = {
|
||||
success => add_api_user( @_ )
|
||||
};
|
||||
return $result;
|
||||
}
|
||||
|
||||
$json_schemas{add_batch_job} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'username', 'api_key', 'domains' ],
|
||||
properties => {
|
||||
username => $zm_validator->username->required->compile,
|
||||
api_key => $zm_validator->api_key->required->compile,
|
||||
domains => {
|
||||
type => "array",
|
||||
additionalItems => 0,
|
||||
items => $zm_validator->domain_name,
|
||||
minItems => 1
|
||||
},
|
||||
test_params => {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
properties => {
|
||||
ipv4 => joi->boolean->compile,
|
||||
ipv6 => joi->boolean->compile,
|
||||
nameservers => {
|
||||
type => 'array',
|
||||
items => $zm_validator->nameserver
|
||||
},
|
||||
ds_info => {
|
||||
type => 'array',
|
||||
items => $zm_validator->ds_info
|
||||
},
|
||||
profile => $zm_validator->profile_name,
|
||||
client_id => $zm_validator->client_id->compile,
|
||||
client_version => $zm_validator->client_version->compile,
|
||||
config => joi->string->compile,
|
||||
priority => $zm_validator->priority->compile,
|
||||
queue => $zm_validator->queue->compile,
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
sub add_batch_job {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $results;
|
||||
eval {
|
||||
$params->{test_params}{profile} //= "default";
|
||||
$params->{test_params}{priority} //= 5;
|
||||
$params->{test_params}{queue} //= 0;
|
||||
|
||||
my $profile = $self->{_profiles}{ $params->{test_params}{profile} };
|
||||
$params->{test_params}{ipv4} //= $profile->get( "net.ipv4" );
|
||||
$params->{test_params}{ipv6} //= $profile->get( "net.ipv6" );
|
||||
|
||||
$results = $self->{db}->add_batch_job( $params );
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
|
||||
return $results;
|
||||
}
|
||||
|
||||
# Experimental
|
||||
$json_schemas{batch_create} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'username', 'api_key', 'domains' ],
|
||||
properties => {
|
||||
username => $zm_validator->username->required->compile,
|
||||
api_key => $zm_validator->api_key->required->compile,
|
||||
domains => {
|
||||
type => "array",
|
||||
additionalItems => 0,
|
||||
items => $zm_validator->domain_name,
|
||||
minItems => 1
|
||||
},
|
||||
job_params => {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
properties => {
|
||||
ipv4 => joi->boolean->compile,
|
||||
ipv6 => joi->boolean->compile,
|
||||
nameservers => {
|
||||
type => 'array',
|
||||
items => $zm_validator->nameserver
|
||||
},
|
||||
ds_info => {
|
||||
type => 'array',
|
||||
items => $zm_validator->ds_info
|
||||
},
|
||||
profile => $zm_validator->profile_name,
|
||||
client_id => $zm_validator->client_id->compile,
|
||||
client_version => $zm_validator->client_version->compile,
|
||||
config => joi->string->compile,
|
||||
priority => $zm_validator->priority->compile,
|
||||
queue => $zm_validator->queue->compile,
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
sub batch_create {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
$params->{test_params} = delete $params->{job_params};
|
||||
|
||||
my $result = {
|
||||
batch_id => $self->add_batch_job( $params )
|
||||
};
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
$json_schemas{batch_status} = {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'batch_id' ],
|
||||
properties => {
|
||||
batch_id => $zm_validator->batch_id->required,
|
||||
list_waiting_tests => joi->boolean->compile,
|
||||
list_running_tests => joi->boolean->compile,
|
||||
list_finished_tests => joi->boolean->compile,
|
||||
}
|
||||
};
|
||||
sub batch_status {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my $result;
|
||||
eval {
|
||||
$result = $self->{db}->batch_status($params);
|
||||
};
|
||||
if ($@) {
|
||||
handle_exception( $@ );
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub _get_locale {
|
||||
my ( $self, $params ) = @_;
|
||||
my @error;
|
||||
|
||||
if ( ref $params ne 'HASH' ) {
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $language = $params->{language};
|
||||
if ( !defined $language ) {
|
||||
return undef;
|
||||
}
|
||||
|
||||
my %locales = $self->{config}->LANGUAGE_locale;
|
||||
|
||||
my $locale = $locales{$language};
|
||||
if ( !defined $locale ) {
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $locale . '.UTF-8';
|
||||
}
|
||||
|
||||
sub _set_error_message_locale {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
my @error_response = ();
|
||||
my $locale = $self->_get_locale( $params );
|
||||
|
||||
if (not defined $locale or $locale eq "") {
|
||||
# Don't translate message if locale is not defined
|
||||
$locale = "C";
|
||||
}
|
||||
|
||||
# Use POSIX implementation instead of Locale::Messages wrapper
|
||||
setlocale( LC_ALL, $locale );
|
||||
return @error_response;
|
||||
}
|
||||
|
||||
my $rpc_request = joi->object->props(
|
||||
jsonrpc => joi->string->required,
|
||||
method => $zm_validator->jsonrpc_method()->required,
|
||||
id => joi->type([qw(null number string)]));
|
||||
sub jsonrpc_validate {
|
||||
my ( $self, $jsonrpc_request ) = @_;
|
||||
|
||||
my @error_rpc = $rpc_request->validate($jsonrpc_request);
|
||||
if ((ref($jsonrpc_request) eq 'HASH' && !exists $jsonrpc_request->{id}) || @error_rpc) {
|
||||
$self->_set_error_message_locale;
|
||||
return {
|
||||
jsonrpc => '2.0',
|
||||
id => undef,
|
||||
error => {
|
||||
code => '-32600',
|
||||
message => 'The JSON sent is not a valid request object.',
|
||||
data => "@error_rpc"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $method_schema = $json_schemas{$jsonrpc_request->{method}};
|
||||
if (blessed $method_schema) {
|
||||
$method_schema = $method_schema->compile;
|
||||
}
|
||||
|
||||
# The "params" key of the JSONRPC object is optional per the JSONRPC 2.0
|
||||
# specification, but if the method being called requires at least one
|
||||
# parameter, omitting it is an error.
|
||||
|
||||
if ( exists $method_schema->{required} and not exists $jsonrpc_request->{params} ) {
|
||||
return {
|
||||
jsonrpc => '2.0',
|
||||
id => $jsonrpc_request->{id},
|
||||
error => {
|
||||
code => '-32602',
|
||||
message => "Missing 'params' object",
|
||||
}
|
||||
};
|
||||
}
|
||||
elsif ( exists $jsonrpc_request->{params} ) {
|
||||
my @error_response = $self->validate_params($method_schema, $jsonrpc_request->{params});
|
||||
|
||||
if ( scalar @error_response ) {
|
||||
return {
|
||||
jsonrpc => '2.0',
|
||||
id => $jsonrpc_request->{id},
|
||||
error => {
|
||||
code => '-32602',
|
||||
message => decode_utf8(__ 'Invalid method parameter(s).'),
|
||||
data => \@error_response
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub validate_params {
|
||||
my ( $self, $method_schema, $params ) = @_;
|
||||
my @error_response = ();
|
||||
|
||||
push @error_response, $self->_set_error_message_locale( $params );
|
||||
|
||||
if (blessed $method_schema) {
|
||||
$method_schema = $method_schema->compile;
|
||||
}
|
||||
my $jv = JSON::Validator::Schema::Draft7->new->coerce('booleans,numbers,strings')->data($method_schema);
|
||||
$jv->formats(Zonemaster::Backend::Validator::formats( $self->{config} ));
|
||||
my @json_validation_error = $jv->validate( $params );
|
||||
|
||||
# Customize error message from json validation
|
||||
foreach my $err ( @json_validation_error ) {
|
||||
my $message = $err->message;
|
||||
my @details = @{$err->details};
|
||||
|
||||
# Handle 'required' errors globally so it does not get overwritten
|
||||
if ($details[1] eq 'required') {
|
||||
$message = N__ 'Missing property';
|
||||
} else {
|
||||
my @path = split '/', $err->path, -1;
|
||||
shift @path; # first item is an empty string
|
||||
my $found = 1;
|
||||
my $data = Mojo::JSON::Pointer->new($method_schema);
|
||||
|
||||
foreach my $p (@path) {
|
||||
if ( $data->contains("/properties/$p") ) {
|
||||
$data = $data->get("/properties/$p")
|
||||
} elsif ( $p =~ /^\d+$/ and $data->contains("/items") ) {
|
||||
$data = $data->get("/items")
|
||||
} else {
|
||||
$found = 0;
|
||||
last;
|
||||
}
|
||||
$data = Mojo::JSON::Pointer->new($data);
|
||||
}
|
||||
|
||||
if ($found and exists $data->data->{'x-error-message'}) {
|
||||
$message = $data->data->{'x-error-message'};
|
||||
}
|
||||
}
|
||||
|
||||
push @error_response, { path => $err->path, message => $message };
|
||||
|
||||
}
|
||||
|
||||
# Translate messages
|
||||
@error_response = map { { %$_, ( message => decode_utf8 __ $_->{message} ) } } @error_response;
|
||||
|
||||
return @error_response;
|
||||
}
|
||||
|
||||
1;
|
||||
218
zonemaster-backend/lib/Zonemaster/Backend/TestAgent.pm
Normal file
218
zonemaster-backend/lib/Zonemaster/Backend/TestAgent.pm
Normal file
@@ -0,0 +1,218 @@
|
||||
package Zonemaster::Backend::TestAgent;
|
||||
our $VERSION = '1.1.0';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use 5.14.2;
|
||||
|
||||
use DBI qw(:utils);
|
||||
use JSON::PP;
|
||||
use Scalar::Util qw( blessed );
|
||||
use File::Slurp;
|
||||
use Locale::TextDomain qw[Zonemaster-Backend];
|
||||
use Time::HiRes qw[time sleep gettimeofday tv_interval];
|
||||
|
||||
use Zonemaster::LDNS;
|
||||
|
||||
use Zonemaster::Engine;
|
||||
use Zonemaster::Engine::Translator;
|
||||
use Zonemaster::Engine::Profile;
|
||||
use Zonemaster::Engine::Util;
|
||||
use Zonemaster::Engine::Logger::Entry;
|
||||
use Zonemaster::Backend::Config;
|
||||
use Zonemaster::Backend::Metrics;
|
||||
|
||||
sub new {
|
||||
my ( $class, $params ) = @_;
|
||||
my $self = {};
|
||||
|
||||
if ( !$params || !$params->{config} ) {
|
||||
die "missing 'config' parameter";
|
||||
}
|
||||
|
||||
my $config = $params->{config};
|
||||
|
||||
my $dbtype;
|
||||
if ( $params->{dbtype} ) {
|
||||
$dbtype = $config->check_db( $params->{dbtype} );
|
||||
}
|
||||
else {
|
||||
$dbtype = $config->DB_engine;
|
||||
}
|
||||
|
||||
my $dbclass = Zonemaster::Backend::DB->get_db_class( $dbtype );
|
||||
$self->{_db} = $dbclass->from_config( $config );
|
||||
|
||||
$self->{_profiles} = Zonemaster::Backend::Config->load_profiles( #
|
||||
$config->PUBLIC_PROFILES,
|
||||
$config->PRIVATE_PROFILES,
|
||||
);
|
||||
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub run {
|
||||
my ( $self, $test_id, $show_progress ) = @_;
|
||||
my @accumulator;
|
||||
|
||||
my $params;
|
||||
|
||||
$params = $self->{_db}->get_test_params( $test_id );
|
||||
|
||||
my ( $domain ) = $params->{domain};
|
||||
if ( !$domain ) {
|
||||
die "Must give the name of a domain to test.\n";
|
||||
}
|
||||
$domain = $self->to_idn( $domain );
|
||||
my %numeric = Zonemaster::Engine::Logger::Entry->levels();
|
||||
|
||||
if ( $params->{nameservers} && @{ $params->{nameservers} } > 0 ) {
|
||||
$self->add_fake_delegation( $domain, $params->{nameservers} );
|
||||
}
|
||||
|
||||
if ( $params->{ds_info} && @{ $params->{ds_info} } > 0 ) {
|
||||
$self->add_fake_ds( $domain, $params->{ds_info} );
|
||||
}
|
||||
|
||||
# If the profile parameter has been set in the API, then load a profile
|
||||
if ( $params->{profile} ) {
|
||||
$params->{profile} = lc($params->{profile});
|
||||
if ( defined $self->{_profiles}{ $params->{profile} } ) {
|
||||
Zonemaster::Engine::Profile->effective->merge( $self->{_profiles}{ $params->{profile} } );
|
||||
}
|
||||
else {
|
||||
die "The profile [$params->{profile}] is not defined in the backend_config ini file";
|
||||
}
|
||||
}
|
||||
|
||||
# If IPv4 or IPv6 transport has been explicitly disabled or enabled, then load it after
|
||||
# any explicitly set profile has been loaded.
|
||||
if (defined $params->{ipv4}) {
|
||||
Zonemaster::Engine::Profile->effective->set( q{net.ipv4}, ( $params->{ipv4} ) ? ( 1 ) : ( 0 ) );
|
||||
}
|
||||
|
||||
if (defined $params->{ipv6}) {
|
||||
Zonemaster::Engine::Profile->effective->set( q{net.ipv6}, ( $params->{ipv6} ) ? ( 1 ) : ( 0 ) );
|
||||
}
|
||||
|
||||
if ( $show_progress ) {
|
||||
my %methods = Zonemaster::Engine->all_methods;
|
||||
|
||||
# BASIC methods are always run: Basic0{0..4}
|
||||
my $nbr_testcases_planned = 5;
|
||||
my $nbr_testcases_finished = 0;
|
||||
|
||||
foreach my $module ( keys %methods ) {
|
||||
foreach my $method ( @{ $methods{$module} } ) {
|
||||
if ( Zonemaster::Engine::Util::should_run_test( $method ) ) {
|
||||
$nbr_testcases_planned++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Zonemaster::Engine->logger->callback(
|
||||
sub {
|
||||
my ( $entry ) = @_;
|
||||
|
||||
if ( $entry->{tag} and $entry->{tag} eq 'TEST_CASE_END' ) {
|
||||
$nbr_testcases_finished++;
|
||||
my $progress_percent = int( 100 * $nbr_testcases_finished / $nbr_testcases_planned );
|
||||
$self->{_db}->test_progress( $test_id, $progress_percent );
|
||||
}
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
# Actually run tests!
|
||||
eval { Zonemaster::Engine->test_zone( $domain ); };
|
||||
if ( $@ ) {
|
||||
my $err = $@;
|
||||
if ( blessed $err and $err->isa( "NormalExit" ) ) {
|
||||
say STDERR "Exited early: " . $err->message;
|
||||
}
|
||||
else {
|
||||
die "$err\n"; # Don't know what it is, rethrow
|
||||
}
|
||||
}
|
||||
|
||||
my $insert_result_start_time = [ gettimeofday ];
|
||||
|
||||
# TODO: Make minimum level configurable
|
||||
my @entries = grep { $_->numeric_level >= $numeric{INFO} } @{ Zonemaster::Engine->logger->entries };
|
||||
|
||||
Zonemaster::Backend::Metrics::timing("zonemaster.testagent.log_callback_add_result_entry_filter_duration", tv_interval($insert_result_start_time) * 1000);
|
||||
|
||||
$self->{_db}->add_result_entries( $test_id, @entries);
|
||||
|
||||
my $callback_add_result_entry_duration = tv_interval($insert_result_start_time);
|
||||
Zonemaster::Backend::Metrics::timing("zonemaster.testagent.log_callback_add_result_entry_duration", $callback_add_result_entry_duration * 1000);
|
||||
|
||||
$self->{_db}->set_test_completed( $test_id );
|
||||
|
||||
return;
|
||||
} ## end sub run
|
||||
|
||||
sub reset {
|
||||
my ( $self ) = @_;
|
||||
Zonemaster::Engine->reset();
|
||||
}
|
||||
|
||||
sub add_fake_delegation {
|
||||
my ( $self, $domain, $nameservers ) = @_;
|
||||
my @ns_with_no_ip;
|
||||
my %data;
|
||||
|
||||
foreach my $ns_ip_pair ( @$nameservers ) {
|
||||
if ( $ns_ip_pair->{ns} && $ns_ip_pair->{ip} ) {
|
||||
push( @{ $data{ $self->to_idn( $ns_ip_pair->{ns} ) } }, $ns_ip_pair->{ip} );
|
||||
}
|
||||
elsif ($ns_ip_pair->{ns}) {
|
||||
push(@ns_with_no_ip, $self->to_idn( $ns_ip_pair->{ns} ) );
|
||||
}
|
||||
else {
|
||||
die "Invalid ns_ip_pair";
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $ns ( @ns_with_no_ip ) {
|
||||
if ( not exists $data{ $ns } ) {
|
||||
$data{ $self->to_idn( $ns ) } = undef;
|
||||
}
|
||||
}
|
||||
|
||||
Zonemaster::Engine->add_fake_delegation( $domain => \%data );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub add_fake_ds {
|
||||
my ( $self, $domain, $ds_info ) = @_;
|
||||
my @data;
|
||||
|
||||
foreach my $ds ( @{ $ds_info } ) {
|
||||
push @data, { keytag => $ds->{keytag}, algorithm => $ds->{algorithm}, type => $ds->{digtype}, digest => $ds->{digest} };
|
||||
}
|
||||
|
||||
Zonemaster::Engine->add_fake_ds( $domain => \@data );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub to_idn {
|
||||
my ( $self, $str ) = @_;
|
||||
|
||||
if ( $str =~ m/^[[:ascii:]]+$/ ) {
|
||||
return $str;
|
||||
}
|
||||
|
||||
if ( Zonemaster::LDNS::has_idn() ) {
|
||||
return Zonemaster::LDNS::to_idn( $str );
|
||||
}
|
||||
else {
|
||||
warn __( "Warning: Zonemaster::LDNS not compiled with IDN support, cannot handle non-ASCII names correctly." );
|
||||
return $str;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
54
zonemaster-backend/lib/Zonemaster/Backend/Translator.pm
Normal file
54
zonemaster-backend/lib/Zonemaster/Backend/Translator.pm
Normal file
@@ -0,0 +1,54 @@
|
||||
package Zonemaster::Backend::Translator;
|
||||
|
||||
our $VERSION = '1.1.0';
|
||||
|
||||
use 5.14.2;
|
||||
|
||||
use Moose;
|
||||
use Encode;
|
||||
use Readonly;
|
||||
use POSIX qw[setlocale LC_MESSAGES LC_CTYPE];
|
||||
use Locale::TextDomain qw[Zonemaster-Backend];
|
||||
use Zonemaster::Backend::Config;
|
||||
|
||||
# Zonemaster Modules
|
||||
require Zonemaster::Engine::Translator;
|
||||
require Zonemaster::Engine::Logger::Entry;
|
||||
|
||||
extends 'Zonemaster::Engine::Translator';
|
||||
|
||||
Readonly my %TAG_DESCRIPTIONS => (
|
||||
TEST_DIED => sub {
|
||||
__x # BACKEND_TEST_AGENT:TEST_DIED
|
||||
'An error occured and Zonemaster could not start or finish the test.', @_;
|
||||
},
|
||||
UNABLE_TO_FINISH_TEST => sub {
|
||||
__x # BACKEND_TEST_AGENT:UNABLE_TO_FINISH_TEST
|
||||
'The test took too long to run (the current limit is {max_execution_time} seconds). '
|
||||
. 'Maybe there are too many name servers or the name servers are either unreachable or not responsive enough.', @_;
|
||||
},
|
||||
);
|
||||
|
||||
sub _build_all_tag_descriptions {
|
||||
my ( $class ) = @_;
|
||||
|
||||
my $all_tag_descriptions = Zonemaster::Engine::Translator::_build_all_tag_descriptions();
|
||||
$all_tag_descriptions->{Backend} = \%TAG_DESCRIPTIONS;
|
||||
return $all_tag_descriptions;
|
||||
}
|
||||
|
||||
sub translate_tag {
|
||||
my ( $self, $hashref ) = @_;
|
||||
|
||||
my $entry = Zonemaster::Engine::Logger::Entry->new( { %{ $hashref } } );
|
||||
|
||||
return decode_utf8( $self->SUPER::translate_tag( $entry ) );
|
||||
}
|
||||
|
||||
sub test_case_description {
|
||||
my ( $self, $test_name ) = @_;
|
||||
|
||||
return decode_utf8( $self->SUPER::test_case_description( $test_name ) );
|
||||
}
|
||||
|
||||
1;
|
||||
554
zonemaster-backend/lib/Zonemaster/Backend/Validator.pm
Normal file
554
zonemaster-backend/lib/Zonemaster/Backend/Validator.pm
Normal file
@@ -0,0 +1,554 @@
|
||||
package Zonemaster::Backend::Validator;
|
||||
|
||||
our $VERSION = '0.1.0';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use 5.14.2;
|
||||
|
||||
use Exporter qw( import );
|
||||
use File::Spec::Functions qw( file_name_is_absolute );
|
||||
use JSON::Validator::Joi;
|
||||
use Readonly;
|
||||
use Locale::TextDomain qw[Zonemaster-Backend];
|
||||
use Net::IP::XS;
|
||||
use Zonemaster::Engine::Logger::Entry;
|
||||
use Zonemaster::Engine::Normalization qw( normalize_name trim_space );
|
||||
use Zonemaster::LDNS;
|
||||
|
||||
our @EXPORT_OK = qw(
|
||||
untaint_abs_path
|
||||
untaint_bool
|
||||
untaint_engine_type
|
||||
untaint_ip_address
|
||||
untaint_ipv4_address
|
||||
untaint_ipv6_address
|
||||
untaint_host
|
||||
untaint_ldh_domain
|
||||
untaint_locale_tag
|
||||
untaint_mariadb_database
|
||||
untaint_mariadb_user
|
||||
untaint_non_negative_int
|
||||
untaint_password
|
||||
untaint_postgresql_ident
|
||||
untaint_profile_name
|
||||
untaint_strictly_positive_int
|
||||
untaint_strictly_positive_millis
|
||||
check_domain
|
||||
check_ip
|
||||
check_profile
|
||||
check_language_tag
|
||||
);
|
||||
|
||||
our %EXPORT_TAGS = (
|
||||
untaint => [
|
||||
qw(
|
||||
untaint_abs_path
|
||||
untaint_bool
|
||||
untaint_engine_type
|
||||
untaint_ip_address
|
||||
untaint_ipv4_address
|
||||
untaint_ipv6_address
|
||||
untaint_host
|
||||
untaint_ldh_domain
|
||||
untaint_locale_tag
|
||||
untaint_mariadb_database
|
||||
untaint_mariadb_user
|
||||
untaint_non_negative_int
|
||||
untaint_password
|
||||
untaint_postgresql_ident
|
||||
untaint_profile_name
|
||||
untaint_strictly_positive_int
|
||||
untaint_strictly_positive_millis
|
||||
)
|
||||
],
|
||||
format => [
|
||||
qw(
|
||||
check_domain
|
||||
check_ip
|
||||
check_profile
|
||||
check_language_tag
|
||||
)
|
||||
]
|
||||
);
|
||||
|
||||
# Does not check value ranges within the groups
|
||||
Readonly my $IPV4_RE => qr/^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}$/;
|
||||
|
||||
# Does not check the length and number of the hex groups, nor the value ranges in the IPv4 groups
|
||||
Readonly my $IPV6_RE => qr/^[0-9a-f:]*:[0-9a-f:]+(:[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})?$/i;
|
||||
|
||||
Readonly my $API_KEY_RE => qr/^[a-z0-9-_]{1,512}$/i;
|
||||
Readonly my $CLIENT_ID_RE => qr/^[a-z0-9-+~_.: ]{1,50}$/i;
|
||||
Readonly my $CLIENT_VERSION_RE => qr/^[a-z0-9-+~_.: ]{1,50}$/i;
|
||||
Readonly my $DIGEST_RE => qr/^[a-f0-9]{40}$|^[a-f0-9]{64}$|^[a-f0-9]{96}$/i;
|
||||
Readonly my $ENGINE_TYPE_RE => qr/^(?:mysql|postgresql|sqlite)$/i;
|
||||
Readonly my $IPADDR_RE => qr/^$|$IPV4_RE|$IPV6_RE/;
|
||||
Readonly my $JSONRPC_METHOD_RE => qr/^[a-z0-9_-]*$/i;
|
||||
Readonly my $LANGUAGE_RE => qr/^[a-z]{2}$/;
|
||||
Readonly my $LDH_DOMAIN_RE1 => qr{^[a-z0-9_./-]{1,253}[.]?$}i;
|
||||
Readonly my $LDH_DOMAIN_RE2 => qr{^(?:[.]|[^.]{1,63}(?:[.][^.]{1,63})*[.]?)$};
|
||||
Readonly my $LOCALE_TAG_RE => qr/^[a-z]{2}_[A-Z]{2}$/;
|
||||
Readonly my $MARIADB_DATABASE_LENGTH_RE => qr/^.{1,64}$/;
|
||||
|
||||
# See: https://mariadb.com/kb/en/identifier-names/#unquoted
|
||||
Readonly my $MARIADB_IDENT_RE => qr/^[0-9a-z\$_]+$/i;
|
||||
Readonly my $MARIADB_USER_LENGTH_RE => qr/^.{1,80}$/u;
|
||||
|
||||
# Up to 5 and 3 digits in the integer and fraction components respectively
|
||||
Readonly my $MILLIS_RE => qr/^(?:0|[1-9][0-9]{0,4})(?:[.][0-9]{1,3})?$/;
|
||||
|
||||
# Up to 5 digits
|
||||
Readonly my $NON_NEGATIVE_INT_RE => qr/^(?:0|[1-9][0-9]{0,4})$/;
|
||||
|
||||
# At least one non-zero digit
|
||||
Readonly my $NON_ZERO_NUM_RE => qr/[1-9]/;
|
||||
|
||||
# Printable ASCII but first character must not be space or '<'
|
||||
Readonly my $PASSWORD_RE => qr/^(?:[\x21-\x3b\x3d-\x7e][\x20-\x7e]{0,99})?$/;
|
||||
|
||||
# See: https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS
|
||||
Readonly my $POSTGRESQL_IDENT_RE => qr/^[a-z_][a-z0-9_\$]{0,62}$/i;
|
||||
Readonly my $PROFILE_NAME_RE => qr/^[a-z0-9]$|^[a-z0-9][a-z0-9_-]{0,30}[a-z0-9]$/i;
|
||||
Readonly my $RELAXED_DOMAIN_NAME_RE => qr/^[.]$|^.{2,254}$/;
|
||||
Readonly my $TEST_ID_RE => qr/^[0-9a-f]{16}$/;
|
||||
Readonly my $USERNAME_RE => qr/^[a-z0-9-.@]{1,50}$/i;
|
||||
|
||||
# Boolean
|
||||
Readonly my $BOOL_TRUE_RE => qr/^(true|yes)$/i;
|
||||
Readonly my $BOOL_FALSE_RE => qr/^(false|no)$/i;
|
||||
Readonly my $BOOL_RE => qr/^$BOOL_TRUE_RE|$BOOL_FALSE_RE$/i;
|
||||
|
||||
sub joi {
|
||||
return JSON::Validator::Joi->new;
|
||||
}
|
||||
|
||||
sub new {
|
||||
my ( $type ) = @_;
|
||||
|
||||
my $self = {};
|
||||
bless( $self, $type );
|
||||
|
||||
return ( $self );
|
||||
}
|
||||
|
||||
sub api_key {
|
||||
return joi->string->regex( $API_KEY_RE );
|
||||
}
|
||||
sub batch_id {
|
||||
return joi->integer->positive;
|
||||
}
|
||||
sub client_id {
|
||||
return joi->string->regex( $CLIENT_ID_RE );
|
||||
}
|
||||
sub client_version {
|
||||
return joi->string->regex( $CLIENT_VERSION_RE );
|
||||
}
|
||||
sub domain_name {
|
||||
return {
|
||||
type => 'string',
|
||||
format => 'domain',
|
||||
};
|
||||
}
|
||||
sub ds_info {
|
||||
return {
|
||||
type => 'object',
|
||||
additionalProperties => 0,
|
||||
required => [ 'digest', 'algorithm', 'digtype', 'keytag' ],
|
||||
properties => {
|
||||
digest => {
|
||||
type => 'string',
|
||||
pattern => $DIGEST_RE,
|
||||
'x-error-message' => N__ 'Invalid digest format'
|
||||
},
|
||||
algorithm => {
|
||||
type => 'number',
|
||||
minimum => 0,
|
||||
'x-error-message' => N__ 'Algorithm must be a positive integer'
|
||||
},
|
||||
digtype => {
|
||||
type => 'number',
|
||||
minimum => 0,
|
||||
'x-error-message' => N__ 'Digest type must be a positive integer'
|
||||
},
|
||||
keytag => {
|
||||
type => 'number',
|
||||
minimum => 0,
|
||||
'x-error-message' => N__ 'Keytag must be a positive integer'
|
||||
}
|
||||
}
|
||||
};
|
||||
}
|
||||
sub ip_address {
|
||||
return {
|
||||
type => 'string',
|
||||
format => 'ip',
|
||||
};
|
||||
}
|
||||
sub nameserver {
|
||||
return {
|
||||
type => 'object',
|
||||
required => [ 'ns' ],
|
||||
additionalProperties => 0,
|
||||
properties => {
|
||||
ns => domain_name,
|
||||
ip => ip_address
|
||||
}
|
||||
};
|
||||
}
|
||||
sub priority {
|
||||
return joi->integer;
|
||||
}
|
||||
sub profile_name {
|
||||
return {
|
||||
type => 'string',
|
||||
format => 'profile',
|
||||
};
|
||||
}
|
||||
sub queue {
|
||||
return joi->integer;
|
||||
}
|
||||
sub test_id {
|
||||
return joi->string->regex( $TEST_ID_RE );
|
||||
}
|
||||
sub language_tag {
|
||||
return {
|
||||
type => 'string',
|
||||
format => 'language_tag',
|
||||
};
|
||||
}
|
||||
sub username {
|
||||
return joi->string->regex( $USERNAME_RE );
|
||||
}
|
||||
sub jsonrpc_method {
|
||||
return joi->string->regex( $JSONRPC_METHOD_RE );
|
||||
}
|
||||
|
||||
=head1 FORMAT INTERFACE
|
||||
|
||||
This module contains a set of procedures for validating data types.
|
||||
The C<check_*> procedures take the value to validate and potential extra
|
||||
arguments and return either undef if the validation succeeded or the reason of
|
||||
the failure.
|
||||
|
||||
use Zonemaster::Backend::Validator qw( :format );
|
||||
|
||||
# prints "invalid value: The domain name character(s) are not supported"
|
||||
if ( defined ( my $error = check_domain( 'not a domain' ) ) ) {
|
||||
print "invalid value: $error\n";
|
||||
} else {
|
||||
print "value is valid\n";
|
||||
}
|
||||
|
||||
# prints "value is valid"
|
||||
if ( defined ( my $error = check_domain( 'zonemaster.net' ) ) ) {
|
||||
print "invalid value: $error\n";
|
||||
} else {
|
||||
print "value is valid\n";
|
||||
}
|
||||
|
||||
=cut
|
||||
|
||||
=head2 formats($config)
|
||||
|
||||
Returns a hashref to be used with the L<"format" method in JSON::Validator|JSON::Validator::Schema/formats>.
|
||||
The keys are the names of the custom formats, supports: C<domain>,
|
||||
C<language_tag>, C<ip> and C<profile>.
|
||||
|
||||
The method takes a L<Config|Zonemaster::Backend::Config> object as argument.
|
||||
|
||||
=cut
|
||||
|
||||
sub formats {
|
||||
my ( $config ) = @_;
|
||||
return {
|
||||
domain => \&check_domain,
|
||||
language_tag => sub { check_language_tag( @_, $config->LANGUAGE_locale ) },
|
||||
ip => \&check_ip,
|
||||
profile => sub { check_profile( @_, ( $config->PUBLIC_PROFILES, $config->PRIVATE_PROFILES ) ) },
|
||||
};
|
||||
}
|
||||
|
||||
=head2 check_domain(%value)
|
||||
|
||||
Validates a L<domain name|https://github.com/zonemaster/zonemaster/blob/master/docs/public/using/backend/rpcapi-reference.md#domain-name>.
|
||||
|
||||
=cut
|
||||
|
||||
sub check_domain {
|
||||
my ( $domain ) = @_;
|
||||
|
||||
if ( !defined( $domain ) ) {
|
||||
return N__ 'Domain name required';
|
||||
}
|
||||
|
||||
my ( $errors, $_domain ) = normalize_name( trim_space( $domain ) );
|
||||
|
||||
if ( @{$errors} ) {
|
||||
return $errors->[0]->message;
|
||||
}
|
||||
|
||||
return undef
|
||||
}
|
||||
|
||||
=head2 check_language_tag($value, %locales)
|
||||
|
||||
Validates a L<https://github.com/zonemaster/zonemaster/blob/master/docs/public/using/backend/rpcapi-reference.md#language-tag>.
|
||||
|
||||
=over
|
||||
|
||||
=item %locales
|
||||
|
||||
A hash of configured locales, as returned by L<Zonemaster::Backend::Config::LANGUAGE_locale>.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub check_language_tag {
|
||||
my ( $language, %locales ) = @_;
|
||||
|
||||
my @error;
|
||||
|
||||
if ( $language !~ $LANGUAGE_RE ) {
|
||||
return N__ 'Invalid language tag format';
|
||||
}
|
||||
elsif ( !exists $locales{$language} ) {
|
||||
return N__ "Unkown language string";
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
=head2 check_ip($value)
|
||||
|
||||
Validates an L<IP address|https://github.com/zonemaster/zonemaster/blob/master/docs/public/using/backend/rpcapi-reference.md#ip-address>.
|
||||
|
||||
=cut
|
||||
|
||||
sub check_ip {
|
||||
my ( $ip ) = @_;
|
||||
|
||||
return N__ 'Invalid IP address' unless untaint_ip_address($ip) ;
|
||||
|
||||
return undef
|
||||
|
||||
}
|
||||
|
||||
=head2 check_profile($value, %profiles)
|
||||
|
||||
Validates a L<profile name|https://github.com/zonemaster/zonemaster/blob/master/docs/public/using/backend/rpcapi-reference.md#profile-name>.
|
||||
|
||||
=over
|
||||
|
||||
=item %profiles
|
||||
|
||||
A hash of configured profiles, as returned by L<Zonemaster::Backend::Config::PUBLIC_PROFILES>.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub check_profile {
|
||||
my ( $profile, %profiles ) = @_;
|
||||
|
||||
if ( $profile !~ $PROFILE_NAME_RE ) {
|
||||
return N__ "Invalid profile format";
|
||||
}
|
||||
|
||||
if ( !exists $profiles{ lc($profile) } ) {
|
||||
return N__ "Unknown profile";
|
||||
}
|
||||
}
|
||||
|
||||
=head1 UNTAINT INTERFACE
|
||||
|
||||
This module contains a set of procedures for validating and untainting strings.
|
||||
|
||||
use Zonemaster::Backend::Validator qw( :untaint );
|
||||
|
||||
# prints "untainted: sqlite"
|
||||
if ( defined ( my $value = untaint_engine_type( 'sqlite' ) ) ) {
|
||||
print "untainted: $value\n";
|
||||
}
|
||||
|
||||
# does not print anything
|
||||
if ( defined ( my $value = untaint_engine_type( 'Excel' ) ) ) {
|
||||
print "untainted: $value\n";
|
||||
}
|
||||
|
||||
These procedures all take a possibly tainted single string argument.
|
||||
If the string is accepted an untainted copy of the string is returned.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_abs_path {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pred( $value, \&file_name_is_absolute );
|
||||
}
|
||||
|
||||
=head2 untaint_engine_type
|
||||
|
||||
Accepts the strings C<"MySQL">, C<"PostgreSQL"> and C<"SQLite">,
|
||||
case-insensitively.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_engine_type {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value , $ENGINE_TYPE_RE );
|
||||
}
|
||||
|
||||
=head2 untaint_ip_address
|
||||
|
||||
Accepts an IPv4 or IPv6 address.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_ip_address {
|
||||
my ( $value ) = @_;
|
||||
return untaint_ipv4_address( $value ) // untaint_ipv6_address( $value );
|
||||
}
|
||||
|
||||
=head2 untaint_ipv4_address
|
||||
|
||||
Accepts an IPv4 address.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_ipv4_address {
|
||||
my ( $value ) = @_;
|
||||
if ( $value =~ /($IPV4_RE)/
|
||||
&& Net::IP::XS::ip_is_ipv4( $value ) )
|
||||
{
|
||||
return $1;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 untaint_ipv6_address
|
||||
|
||||
Accepts an IPv6 address.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_ipv6_address {
|
||||
my ( $value ) = @_;
|
||||
if ( $value =~ /($IPV6_RE)/
|
||||
&& Net::IP::XS::ip_is_ipv6( $value ) )
|
||||
{
|
||||
return $1;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 untaint_host
|
||||
|
||||
Accepts an LDH domain name or an IPv4 or IPv6 address.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_host {
|
||||
my ( $value ) = @_;
|
||||
return untaint_ldh_domain( $value ) // untaint_ip_address( $value );
|
||||
}
|
||||
|
||||
=head2 untaint_ldh_domain
|
||||
|
||||
Accepts an LDH domain name.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_ldh_domain {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $LDH_DOMAIN_RE1, $LDH_DOMAIN_RE2 );
|
||||
}
|
||||
|
||||
=head2 untaint_locale_tag
|
||||
|
||||
Accepts a locale tag.
|
||||
|
||||
=cut
|
||||
|
||||
sub untaint_locale_tag {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $LOCALE_TAG_RE );
|
||||
}
|
||||
|
||||
sub untaint_mariadb_database {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $MARIADB_IDENT_RE, $MARIADB_DATABASE_LENGTH_RE );
|
||||
}
|
||||
|
||||
sub untaint_mariadb_user {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $MARIADB_IDENT_RE, $MARIADB_USER_LENGTH_RE );
|
||||
}
|
||||
|
||||
sub untaint_password {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $PASSWORD_RE );
|
||||
}
|
||||
|
||||
sub untaint_strictly_positive_int {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $NON_NEGATIVE_INT_RE, $NON_ZERO_NUM_RE );
|
||||
}
|
||||
|
||||
sub untaint_strictly_positive_millis {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $MILLIS_RE, $NON_ZERO_NUM_RE );
|
||||
}
|
||||
|
||||
sub untaint_postgresql_ident {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $POSTGRESQL_IDENT_RE );
|
||||
}
|
||||
|
||||
sub untaint_non_negative_int {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $NON_NEGATIVE_INT_RE );
|
||||
}
|
||||
|
||||
sub untaint_profile_name {
|
||||
my ( $value ) = @_;
|
||||
return _untaint_pat( $value, $PROFILE_NAME_RE );
|
||||
}
|
||||
|
||||
sub untaint_bool {
|
||||
my ( $value ) = @_;
|
||||
|
||||
my $ret;
|
||||
$ret = 1 if defined _untaint_pat( $value, $BOOL_TRUE_RE );
|
||||
$ret = 0 if defined _untaint_pat( $value, $BOOL_FALSE_RE );
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub _untaint_pat {
|
||||
my ( $value, @patterns ) = @_;
|
||||
|
||||
for my $pattern ( @patterns ) {
|
||||
if ( $value !~ /($pattern)/ ) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
$value =~ qr/(.*)/;
|
||||
return $1;
|
||||
}
|
||||
|
||||
sub _untaint_pred {
|
||||
my ( $value, $predicate ) = @_;
|
||||
|
||||
if ( $predicate->( $value ) ) {
|
||||
$value =~ qr/(.*)/;
|
||||
return $1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user