Accept leading zeros in IPv4 addresses
Also add unit tests.
This commit is contained in:
parent
f414493a06
commit
92c1294af9
4 changed files with 97 additions and 9 deletions
|
@ -70,6 +70,7 @@ AM_PL_LOG_FLAGS = -Mstrict -w \
|
|||
-I'$(abs_top_srcdir)'/t/lib \
|
||||
-MDevel::Autoflush
|
||||
handwritten_tests = \
|
||||
t/is-and-extract-ipv4.pl \
|
||||
t/geturl_connectivity.pl \
|
||||
t/geturl_ssl.pl \
|
||||
t/parse_assignments.pl \
|
||||
|
|
|
@ -49,6 +49,7 @@ m4_foreach_w([_m], [
|
|||
# Perl modules required for tests. If these modules are not installed
|
||||
# then some tests will fail. Only prints a warning if not installed.
|
||||
m4_foreach_w([_m], [
|
||||
B
|
||||
Data::Dumper
|
||||
File::Spec::Functions
|
||||
File::Temp
|
||||
|
|
21
ddclient.in
21
ddclient.in
|
@ -2273,23 +2273,26 @@ sub get_ip {
|
|||
return $ip;
|
||||
}
|
||||
|
||||
|
||||
######################################################################
|
||||
## is_ipv4() validates if string is valid IPv4 address and only a
|
||||
## valid address with no preceding or trailing spaces/characters
|
||||
## and no embedded leading zeros.
|
||||
## Regex to find IPv4 address. Accepts embedded leading zeros.
|
||||
######################################################################
|
||||
my $regex_ipv4 = qr/(?:(?<octet>25[0-5]|2[0-4]\d|[01]?\d\d?)\.){3}(?&octet)/;
|
||||
|
||||
######################################################################
|
||||
## is_ipv4() validates if string is valid IPv4 address with no preceding
|
||||
## or trailing spaces/characters, not even line breaks.
|
||||
######################################################################
|
||||
sub is_ipv4 {
|
||||
my ($value) = @_;
|
||||
return (length($value // '') != 0) && ($value eq (extract_ipv4($value) // ''));
|
||||
return (shift // '') =~ /\A$regex_ipv4\z/;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
## extract_ipv4() extracts the first valid IPv4 address from given string.
|
||||
## Accepts leading zeros in the address but removes them in returned value
|
||||
## extract_ipv4() finds the first valid IPv4 address in the given string,
|
||||
## removes embedded leading zeros, and returns the result.
|
||||
######################################################################
|
||||
sub extract_ipv4 {
|
||||
(shift // '') =~ /\b((?:(?<octet>25[0-5]|2[0-4]\d|[01]?\d\d?)\.){3}(?&octet))\b/
|
||||
or return undef;
|
||||
(shift // '') =~ /(?:\b|_)($regex_ipv4)(?:\b|_)/ or return undef;
|
||||
(my $ip = $1) =~ s/\b0+\B//g; ## remove embedded leading zeros
|
||||
return $ip;
|
||||
}
|
||||
|
|
83
t/is-and-extract-ipv4.pl
Normal file
83
t/is-and-extract-ipv4.pl
Normal file
|
@ -0,0 +1,83 @@
|
|||
use Test::More;
|
||||
use B qw(perlstring);
|
||||
|
||||
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
|
||||
eval { require 'ddclient'; } or BAIL_OUT($@);
|
||||
|
||||
|
||||
my @valid_ipv4 = (
|
||||
"192.168.1.1",
|
||||
"0.0.0.0",
|
||||
"000.000.000.000",
|
||||
"255.255.255.255",
|
||||
"10.0.0.0",
|
||||
);
|
||||
|
||||
my @invalid_ipv4 = (
|
||||
undef,
|
||||
"",
|
||||
"192.168.1",
|
||||
"0.0.0",
|
||||
"000.000",
|
||||
"256.256.256.256",
|
||||
".10.0.0.0",
|
||||
);
|
||||
|
||||
|
||||
subtest "is_ipv4() with valid addresses" => sub {
|
||||
foreach my $ip (@valid_ipv4) {
|
||||
ok(ddclient::is_ipv4($ip), "is_ipv4('$ip')");
|
||||
}
|
||||
};
|
||||
|
||||
subtest "is_ipv4() with invalid addresses" => sub {
|
||||
foreach my $ip (@invalid_ipv4) {
|
||||
ok(!ddclient::is_ipv4($ip), sprintf("!is_ipv4(%s)", defined($ip) ? "'$ip'" : 'undef'));
|
||||
}
|
||||
};
|
||||
|
||||
subtest "is_ipv4() with char adjacent to valid address" => sub {
|
||||
foreach my $ch (split(//, '/.,:z @$#&%!^*()_-+'), "\n") {
|
||||
subtest perlstring($ch) => sub {
|
||||
foreach my $ip (@valid_ipv4) {
|
||||
subtest $ip => sub {
|
||||
my $test = $ch . $ip; # insert at front
|
||||
ok(!ddclient::is_ipv4($test), "!is_ipv4('$test')");
|
||||
$test = $ip . $ch; # add at end
|
||||
ok(!ddclient::is_ipv4($test), "!is_ipv4('$test')");
|
||||
$test = $ch . $ip . $ch; # wrap front and end
|
||||
ok(!ddclient::is_ipv4($test), "!is_ipv4('$test')");
|
||||
};
|
||||
}
|
||||
};
|
||||
}
|
||||
};
|
||||
|
||||
subtest "extract_ipv4()" => sub {
|
||||
my @test_cases = (
|
||||
{name => "undef", text => undef, want => undef},
|
||||
{name => "empty", text => "", want => undef},
|
||||
{name => "invalid", text => "1.2.3.256", want => undef},
|
||||
{name => "two addrs", text => "1.1.1.1\n2.2.2.2", want => "1.1.1.1"},
|
||||
{name => "host+port", text => "1.2.3.4:123", want => "1.2.3.4"},
|
||||
{name => "zero pad", text => "001.002.003.004", want => "1.2.3.4"},
|
||||
);
|
||||
foreach my $tc (@test_cases) {
|
||||
is(ddclient::extract_ipv4($tc->{text}), $tc->{want}, $tc->{name});
|
||||
}
|
||||
};
|
||||
|
||||
subtest "extract_ipv4() of valid addr with adjacent non-word char" => sub {
|
||||
foreach my $wb (split(//, '/, @$#&%!^*()_-+:'), "\n") {
|
||||
subtest perlstring($wb) => sub {
|
||||
my $test = "";
|
||||
foreach my $ip (@valid_ipv4) {
|
||||
$test = "foo" . $wb . $ip . $wb . "bar"; # wrap front and end
|
||||
$ip =~ s/\b0+\B//g; ## remove embedded leading zeros for testing
|
||||
is(ddclient::extract_ipv4($test), $ip, perlstring($test));
|
||||
}
|
||||
};
|
||||
}
|
||||
};
|
||||
|
||||
done_testing();
|
Loading…
Reference in a new issue