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:
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