Commit 0d7dda42 authored by Mattias Päivärinta's avatar Mattias Päivärinta
Browse files

Fix handling of mixed empty field types

Fixes PDTT-395 and PDTT-397
Partially fixes SFG-142
parent 3b9ba057
......@@ -95,13 +95,13 @@ sub validate {
};
# Validate rule
my $result = _rule( $state, key => $rule, quantifier => 'required' );
my ( $result, $rule_errors ) = _rule( $state, key => $rule, quantifier => 'required' );
# Pick up validation warnings
my @errors;
if ( defined $result ) {
ref $result eq 'ARRAY' or croak 'unexpected return value from _rule()';
@errors = @{$result};
ref $rule_errors eq 'ARRAY' or croak 'unexpected return value from _rule()';
@errors = @{$rule_errors};
}
# Check status of parsed input
......@@ -144,12 +144,36 @@ sub _describe_line {
}
}
=head2 B<_sequence_section( $state, $section_rule )>
Parse a sequence section rule.
my ( $token, $errors ) = _sequence_section( $state, key => 'field', type => 'hostname', quantifier => 'required' );
Returns:
=over 4
=item B<( undef, [] )>
No match. Input may have been consumed.
=item B<( $token, $errors )>
Match. Input may have been consumed.
If a grammar rule was parsed, B<$token> is 'section'. If a line was parsed,
B<$token> is the one B<_line()> returned.
=back
=cut
sub _sequence_section {
my $state = shift or croak 'Missing argument: $state';
my $section_rule = shift or croak 'Missing argument: $section_rule';
my @errors;
my $total = 0;
for my $elem ( @$section_rule ) {
......@@ -162,32 +186,53 @@ sub _sequence_section {
## no critic (TestingAndDebugging::ProhibitNoWarnings)
no warnings 'recursion';
## use critic
my ( $count, $result ) = _occurances( $state, %$params, key => $key );
my $result = _occurances( $state, %$params, key => $key );
if ( !defined $count ) {
if ( $total == 0 ) {
return;
}
else {
my ( $token, $token_value, $token_errors ) = $state->{lexer}->peek_line();
defined $token or croak 'unexpected return value';
ref $token_errors eq 'ARRAY' or croak 'unexpected return value';
if ( defined $result ) {
ref $result eq 'ARRAY' or croak 'unexpected return value from _occurances()';
push @errors, @{$result};
}
else {
my ( $token, $token_value, $token_errors ) = $state->{lexer}->peek_line();
defined $token or croak 'unexpected return value';
ref $token_errors eq 'ARRAY' or croak 'unexpected return value';
push @errors, @{$token_errors};
push @errors, @{$token_errors};
my $description = _describe_line( $token, $token_value );
push @errors, sprintf( "line %d: %s not allowed here", $state->{lexer}->line_no, $description );
last;
}
my $description = _describe_line( $token, $token_value );
push @errors, sprintf( "line %d: %s not allowed here", $state->{lexer}->line_no, $description );
return ( undef, \@errors );
}
ref $result eq 'ARRAY' or confess;
push @errors, @$result;
$total += $count;
}
return ( 'section', \@errors );
}
=head2 B<_choice_section( $state, $section_rule )>
Parse a choice section rule.
my ( $token, $errors ) = _choice_section( $state, key => 'field', type => 'hostname', quantifier => 'required' );
Returns:
=over 4
=item B<( undef, [] )>
No match. Input may have been consumed.
=item B<( $token, $errors )>
Match. Input may have been consumed.
If a grammar rule was parsed, B<$token> is 'section'. If a line was parsed,
B<$token> is the one B<_line()> returned.
=back
=cut
sub _choice_section {
my $state = shift or croak 'Missing argument: $state';
my $section_rule = shift or croak 'Missing argument: $section_rule';
......@@ -197,15 +242,40 @@ sub _choice_section {
my $params = $section_rule->{$key};
ref $params eq 'HASH' or confess "value of key '$key' must be a hashref";
my ( $count, $result ) = _occurances( $state, %$params, key => $key );
if ( defined $count ) {
my $result = _occurances( $state, %$params, key => $key );
if ( defined $result ) {
ref $result eq 'ARRAY' or croak 'unexpected return value from _occurances()';
return ( 'section', $result );
}
}
return;
return ( undef, [] );
}
=head2 B<_occurances( $state, key, line, type, quantifier, keytype )>
Parse a quantified grammar rule or a line type with the given $key.
my $result = _occurances( $state, key => 'field', type => 'hostname', quantifier => 'required' );
Returns:
=over 4
=item B<()>
No match. Input may have been consumed.
=item B<$result>
Match. Input may have been consumed.
B<$result> is an arrayref containing validation error strings.
=back
=cut
sub _occurances {
my ( $state, %args ) = @_;
my $key = $args{'key'} or croak 'Missing argument: key';
......@@ -213,6 +283,9 @@ sub _occurances {
my $type = $args{'type'};
my $quantifier = $args{'quantifier'} || 'required';
my $keytype = $args{'keytype'};
if ( $type ) {
$line ||= 'field';
}
my $min_occurs;
my $max_occurs;
......@@ -238,27 +311,25 @@ sub _occurances {
}
}
my $count = 0;
my $first = 1;
my $element_count = 0;
my @pending_empty_error = ();
my @errors;
while ( !defined $max_occurs || $count < $max_occurs ) {
while ( !defined $max_occurs || $element_count < $max_occurs ) {
my $line_before = $state->{lexer}->line_no;
my ( $parsed, $parsed_errors ) = _rule( $state, line => $line, key => $key, type => $type, quantifier => $quantifier, keytype => $keytype );
if ( defined $parsed ) {
ref $parsed_errors eq 'ARRAY' or confess;
$count++;
ref $parsed_errors eq 'ARRAY' or croak 'unexpected return value from _rule()';
my $line_after = $state->{lexer}->line_no;
if ( $line_before == $line_after ) {
last;
}
push @errors, @$parsed_errors;
if ( $parsed eq 'empty field' ) {
push @pending_empty_error, sprintf( "line %d: empty field in repetition '%s'", $line_after - 1, $key );
if ( $count != 1 ) {
if ( !$first ) {
push @errors, @pending_empty_error;
@pending_empty_error = ();
}
elsif ( $quantifier =~ /^required$|^repeatable|^omitted-constrained$|^optional-not-empty$/ ) {
elsif ( $quantifier =~ /^required$|^repeatable|^optional-repeatable|^omitted-constrained$|^optional-not-empty$/ ) {
push @errors, sprintf( "line %d: field '%s' is %s and must not be present as an empty field", $line_after - 1, $key, $quantifier );
}
elsif ( $quantifier =~ /^optional-constrained$|^empty-constrained$/ ) {
......@@ -268,16 +339,19 @@ sub _occurances {
else {
push @errors, @pending_empty_error;
@pending_empty_error = ();
$element_count++;
if ( $parsed eq 'field' && $quantifier =~ /^empty-constrained$|^omitted-constrained$/ ) {
push @errors, sprintf( "line %d: field '%s' is %s and must not be present as a non-empty field", $line_after - 1, $key, $quantifier );
return; # mismatch: field must not be present as a non-empty field
}
elsif ( $line_before == $line_after ) {
last; # successfully parsed zero lines, no need to do it again
}
}
}
else {
if ( $count == 0 && defined $line && $line eq 'field' ) {
if ( $first && defined $line && $line eq 'field' ) {
if ( $quantifier eq 'empty-constrained' ) {
push @errors, sprintf( "line %d: field '%s' is empty-constrained and must not be omitted", $state->{lexer}->line_no, $key );
return; # mismatch: field must not be omitted
}
elsif ( $quantifier =~ /^optional-constrained$|^omitted-constrained$/ ) {
push @errors, _set_empty_kind( $state, kind => 'omitted field', line_no => $state->{lexer}->line_no, key => $key );
......@@ -285,16 +359,43 @@ sub _occurances {
}
last;
}
$first = '';
}
if ( $count >= $min_occurs ) {
return ( $count, \@errors );
if ( $element_count >= $min_occurs ) {
return \@errors;
}
else {
return;
}
}
=head2 B<_rule( $state, key, line, type, quantifier, keytype )>
Parse a single occurance of a grammar rule or a line type with the given $key.
my ( $token, $errors ) = _rule( $state, key => 'field', type => 'hostname', quantifier => 'required' );
Returns:
=over 4
=item B<( undef, [] )>
No match. Input may have been consumed.
=item B<( $token, $errors )>
Match. Input may have been consumed.
If a grammar rule was parsed, B<$token> is 'section'. If a line was parsed,
B<$token> is the one B<_line()> returned.
=back
=cut
## no critic (Subroutines::RequireArgUnpacking)
sub _rule {
my ( $state, %args ) = @_;
......@@ -305,8 +406,11 @@ sub _rule {
my $keytype = $args{'keytype'};
if ( defined $line || defined $type ) {
my ( $subtype, $result ) = _line( $state, line => $line, key => $key, type => $type, quantifier => $quantifier, keytype => $keytype );
return ( $subtype, $result );
my ( $rule_token, $rule_errors ) = _line( $state, line => $line, key => $key, type => $type, quantifier => $quantifier, keytype => $keytype );
ref $rule_token eq '' or croak 'unexpected return value from _line()';
!defined $rule_errors || ref $rule_errors eq 'ARRAY' or croak 'unexpected return value from _line()';
return ( $rule_token, $rule_errors || [] );
}
else {
if ( my $section_rule = $state->{grammar}->{$key} ) {
......@@ -335,18 +439,40 @@ sub _rule {
}
## use critic
=head2 B<_line( $state, key, line, type, quantifier, keytype )>
Parse a line of an expected type.
my ( $token, $errors ) = _line( $state, key => 'field', type => 'hostname', quantifier => 'required' );
Returns one of the following:
=over 4
=item B<()>
No match. No input was consumed.
=item B<( $token, $errors )>
Match. One line of input was consumed.
B<$token> is one of the B<PDT::TS::Whoiw::Lexer> token types, 'empty field' or 'any line'.
=back
=cut
sub _line {
my ( $state, %args ) = @_;
my $key = $args{'key'} or croak 'Missing argument: key';
my $line = $args{'line'};
my $key = $args{'key'} or croak 'Missing argument: key';
my $line = $args{'line'} or croak 'Missing argument: line';
my $type = $args{'type'};
my $quantifier = $args{'quantifier'} or croak 'Missing argument: quantifier';
my $keytype = $args{'keytype'};
( $line || $type ) or croak 'Must give at least one of arguments: line, type';
if ( defined $type ) {
$state->{types}->has_type( $type ) or croak "unknown type '$type'";
$line ||= 'field';
$line eq 'field' or confess;
}
if ( defined $keytype ) {
......
......@@ -552,9 +552,11 @@ WHOIS Server:
Referral URL: http://www.example-registrar.tld
Admin Contact: Joe Registrar
Phone Number: +1.3105551214
Fax Number:
Email: joeregistrar\@example-registrar.tld
Technical Contact: John Geek
Phone Number: +1.3105551216
Fax Number:
Email: johngeek\@example-registrar.tld
Additional field:
EOF
......
......@@ -2,7 +2,7 @@ use strict;
use warnings;
use 5.014;
use Test::More tests => 6;
use Test::More tests => 7;
use Test::Differences;
use PDT::TS::Whois::Lexer;
use PDT::TS::Whois::Validator qw( validate );
......@@ -11,14 +11,26 @@ use PDT::TS::Whois::Types;
sub accept_registrar {
my $test_name = shift;
my $input = shift =~ s/\r?$/\r/gmr;
my $input = shift =~ s/\r?\n/\r\n/gmr;
my $types = PDT::TS::Whois::Types->new;
$types->add_type( 'query registrar name' => sub { return (shift !~ /Example Registrar, Inc\./ ) ? ( 'expected matching registrar name' ) : () } );
my $lexer = PDT::TS::Whois::Lexer->new( $input );
my @errors = validate( rule => 'Registrar Object query', lexer => $lexer, grammar => $grammar, types => $types );
eq_or_diff \@errors, [], 'Should accept valid registrar reply';
my @errors = validate( rule => 'Registrar details section', lexer => $lexer, grammar => $grammar, types => $types );
eq_or_diff \@errors, [], "Should accept $test_name";
}
sub reject_registrar {
my $test_name = shift;
my $input = shift =~ s/\r?\n/\r\n/gmr;
my $types = PDT::TS::Whois::Types->new;
$types->add_type( 'query registrar name' => sub { return (shift !~ /Example Registrar, Inc\./ ) ? ( 'expected matching registrar name' ) : () } );
my $lexer = PDT::TS::Whois::Lexer->new( $input );
my @errors = validate( rule => 'Registrar details section', lexer => $lexer, grammar => $grammar, types => $types );
cmp_ok @errors, '>', 0, "Should reject $test_name";
}
accept_registrar 'Fax number section type A, empty' => <<EOF;
......@@ -35,11 +47,6 @@ Fax Number: +1.3105551214
Email: registrar\@example.tld
WHOIS Server:
Referral URL: http://www.example-registrar.tld
>>> Last update of WHOIS database: 2009-05-29T20:15:00Z <<<
For more information on Whois status codes, please visit https://icann.org/epp
Disclaimer: This is a legal disclaimer.
EOF
accept_registrar 'Fax number section type A, omitted' => <<EOF;
......@@ -54,11 +61,6 @@ Fax Ext:
Fax Number: +1.3105551214
Email: registrar\@example.tld
Referral URL: http://www.example-registrar.tld
>>> Last update of WHOIS database: 2009-05-29T20:15:00Z <<<
For more information on Whois status codes, please visit https://icann.org/epp
Disclaimer: This is a legal disclaimer.
EOF
accept_registrar 'Fax number section type B, non-empty field' => <<EOF;
......@@ -74,11 +76,6 @@ Fax Ext: 567
Email: registrar\@example.tld
WHOIS Server:
Referral URL: http://www.example-registrar.tld
>>> Last update of WHOIS database: 2009-05-29T20:15:00Z <<<
For more information on Whois status codes, please visit https://icann.org/epp
Disclaimer: This is a legal disclaimer.
EOF
accept_registrar 'Fax number section type B, empty field' => <<EOF;
......@@ -94,11 +91,6 @@ Fax Ext:
Email: registrar\@example.tld
WHOIS Server:
Referral URL: http://www.example-registrar.tld
>>> Last update of WHOIS database: 2009-05-29T20:15:00Z <<<
For more information on Whois status codes, please visit https://icann.org/epp
Disclaimer: This is a legal disclaimer.
EOF
accept_registrar 'Fax number section type B, omitted field' => <<EOF;
......@@ -113,11 +105,6 @@ Fax Number:
Email: registrar\@example.tld
WHOIS Server:
Referral URL: http://www.example-registrar.tld
>>> Last update of WHOIS database: 2009-05-29T20:15:00Z <<<
For more information on Whois status codes, please visit https://icann.org/epp
Disclaimer: This is a legal disclaimer.
EOF
accept_registrar 'Fax number section type C' => <<EOF;
......@@ -129,9 +116,22 @@ Country: US
Phone Number: +1.3105551212
Email: registrar\@example.tld
Referral URL: http://www.example-registrar.tld
>>> Last update of WHOIS database: 2009-05-29T20:15:00Z <<<
For more information on Whois status codes, please visit https://icann.org/epp
EOF
Disclaimer: This is a legal disclaimer.
reject_registrar 'Empty fields but omitted Fax Number' => <<EOF;
Registrar Name: Example Registrar, Inc.
Street: 1234 Admiralty Way
City: Marina del Rey
State/Province:
Postal Code:
Country: US
Phone Number: +1.3105551212
Fax Number: +1.3105551213
Fax Ext:
Email: registrar\@example.tld
WHOIS Server:
Referral URL: http://www.example-registrar.tld
Admin Contact: Joe Registrar
Phone Number: +1.3105551214
Email: joeregistrar\@example-registrar.tld
EOF
......@@ -11,10 +11,7 @@ use PDT::TS::Whois::Types;
sub accept_domain {
my $test_name = shift;
my $input = shift;
chomp $input;
$input =~ s/\r?$/\r/gm;
my $input = shift =~ s/\r?\n/\r\n/gmr;
my $types = PDT::TS::Whois::Types->new;
$types->load_roid_suffix('t/iana-epp-rep-id.txt');
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment