From 92c1294af99ac1b5c44b54a3d8a2ef107dfc7f9b Mon Sep 17 00:00:00 2001
From: David Kerr <david@kerr.net>
Date: Sun, 28 Jun 2020 22:50:17 -0400
Subject: [PATCH] Accept leading zeros in IPv4 addresses

Also add unit tests.
---
 Makefile.am              |  1 +
 configure.ac             |  1 +
 ddclient.in              | 21 +++++-----
 t/is-and-extract-ipv4.pl | 83 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 97 insertions(+), 9 deletions(-)
 create mode 100644 t/is-and-extract-ipv4.pl

diff --git a/Makefile.am b/Makefile.am
index a1cef03..87be3ee 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 \
diff --git a/configure.ac b/configure.ac
index 94b62b3..6151e88 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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
diff --git a/ddclient.in b/ddclient.in
index 8b8a4a9..288e5c5 100755
--- a/ddclient.in
+++ b/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;
 }
diff --git a/t/is-and-extract-ipv4.pl b/t/is-and-extract-ipv4.pl
new file mode 100644
index 0000000..41517ab
--- /dev/null
+++ b/t/is-and-extract-ipv4.pl
@@ -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();