Merge pull request #719 from rhansen/cleanups

Various minor cleanups and improvements

ChangeLog.md

@@ -68,9 +68,10 @@ repository history](https://github.com/ddclient/ddclient/commits/master).
     [#639](https://github.com/ddclient/ddclient/pull/639)
   * Updated sample systemd service unit file to improve logging in the systemd
     journal.  [#669](https://github.com/ddclient/ddclient/pull/669)
-  * The second and subsequent lines in a multi-line log message are now prefixed
+  * The second and subsequent lines in a multi-line log message now have a
-    with a `|` character.
+    different prefix to distinguish them from separate log messages.
     [#676](https://github.com/ddclient/ddclient/pull/676)
+    [#719](https://github.com/ddclient/ddclient/pull/719)
   * `emailonly`: New `protocol` option that simply emails you when your IP
     address changes.  [#654](https://github.com/ddclient/ddclient/pull/654)
   * `he.net`: Added support for updating Hurricane Electric records.
@@ -83,6 +84,10 @@ repository history](https://github.com/ddclient/ddclient/commits/master).
     records.  [#695](https://github.com/ddclient/ddclient/pull/695)
   * `inwx`: New `protocol` option for updating [INWX](https://www.inwx.com/)
     records.  [#690](https://github.com/ddclient/ddclient/pull/690)
+  * `domeneshop`: Add IPv6 support.
+    [#719](https://github.com/ddclient/ddclient/pull/719)
+  * `duckdns`: Multiple hosts with the same IP address are now updated together.
+    [#719](https://github.com/ddclient/ddclient/pull/719)
 
 ### Bug fixes
 
@@ -130,6 +135,13 @@ repository history](https://github.com/ddclient/ddclient/commits/master).
     [#713](https://github.com/ddclient/ddclient/pull/713)
   * `easydns`: Fixed successful updates treated as failed updates.
     [#713](https://github.com/ddclient/ddclient/pull/713)
+  * Any IP addresses in an HTTP response's headers or in an HTTP error
+    response's body are now ignored when obtaining the IP address from a
+    web-based IP discovery service (`--usev4=webv4`, `--usev6=webv6`) or from a
+    router/firewall device.
+    [#719](https://github.com/ddclient/ddclient/pull/719)
+  * `yandex`: Errors are now retried.
+    [#719](https://github.com/ddclient/ddclient/pull/719)
 
 ## 2023-11-23 v3.11.2
 

Makefile.am

@@ -77,6 +77,7 @@ handwritten_tests = \
 	t/parse_assignments.pl \
 	t/skip.pl \
 	t/ssl-validate.pl \
+	t/use_web.pl \
 	t/variable_defaults.pl \
 	t/write_recap.pl
 generated_tests = \

t/builtinfw_query.pl

@@ -1,33 +1,22 @@
 use Test::More;
-eval { require Test::MockModule; } or plan(skip_all => $@);
 SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
 eval { require 'ddclient'; } or BAIL_OUT($@);
 
-my $debug_msg;
-my $module = Test::MockModule->new('ddclient');
-# Note: 'mock' is used instead of 'redefine' because 'redefine' is not available in the versions of
-# Test::MockModule distributed with old Debian and Ubuntu releases.
-$module->mock('debug', sub {
-    my $msg = sprintf(shift, @_);
-    return unless ($msg =~ qr/^get_ip(v[46])?:/);
-    BAIL_OUT("debug already called") if defined($debug_msg);
-    $debug_msg = $msg;
-});
 my $got_host;
 my $builtinfw = 't/builtinfw_query.pl';
 $ddclient::builtinfw{$builtinfw} = {
     name => 'dummy device for testing',
     query => sub {
         ($got_host) = @_;
-        return ($got_host, "192.0.2.1 skip1 192.0.2.2 skip2 192.0.2.3");
+        return '192.0.2.1 skip1 192.0.2.2 skip2 192.0.2.3';
     },
     queryv4 => sub {
         ($got_host) = @_;
-        return ($got_host, "192.0.2.4 skip1 192.0.2.5 skip3 192.0.2.6");
+        return '192.0.2.4 skip1 192.0.2.5 skip3 192.0.2.6';
     },
     queryv6 => sub {
         ($got_host) = @_;
-        return ($got_host, "2001:db8::1 skip1 2001:db8::2 skip4 2001:db8::3");
+        return '2001:db8::1 skip1 2001:db8::2 skip4 2001:db8::3';
     },
 };
 %ddclient::builtinfw if 0;  # suppress spurious warning "Name used only once: possible typo"
@@ -81,12 +70,10 @@ for my $tc (@test_cases) {
             %{$tc->{cfgxtra}},
         };
         %ddclient::config if 0;  # suppress spurious warning "Name used only once: possible typo"
-        undef($debug_msg);
         undef($got_host);
         my $got = $tc->{getip}($builtinfw, $h);
         is($got_host, $h, "host is passed through");
         is($got, $tc->{want}, "returned IP matches");
-        like($debug_msg, qr/\b\Q$h\E\b/, "returned arg is properly handled");
     };
 }
 

t/logmsg.pl

@@ -55,49 +55,49 @@ my @test_cases = (
     {
         desc => 'single-line prefix',
         args => [pfx => 'PFX:', 'foo'],
-        want => "PFX:       foo\n",
+        want => "PFX:     > foo\n",
     },
     {
         desc => 'multi-line prefix',
         args => [pfx => 'PFX:', "foo\nbar"],
-        want => "PFX:       foo\nPFX:     | bar\n",
+        want => "PFX:     > foo\nPFX:       bar\n",
     },
     {
         desc => 'single-line long prefix',
         args => [pfx => 'VERY LONG PREFIX:', 'foo'],
-        want => "VERY LONG PREFIX:  foo\n",
+        want => "VERY LONG PREFIX: > foo\n",
     },
     {
         desc => 'multi-line long prefix',
         args => [pfx => 'VERY LONG PREFIX:', "foo\nbar"],
-        want => "VERY LONG PREFIX:  foo\nVERY LONG PREFIX:| bar\n",
+        want => "VERY LONG PREFIX: > foo\nVERY LONG PREFIX:   bar\n",
     },
     {
         desc => 'single line, no prefix, file',
         args => ['foo'],
         file => 'name',
-        want => "file name:  foo\n",
+        want => "file name: > foo\n",
     },
     {
         desc => 'single line, no prefix, file, and line number',
         args => ['foo'],
         file => 'name',
         lineno => 42,
-        want => "file name, line 42:  foo\n",
+        want => "file name, line 42: > foo\n",
     },
     {
         desc => 'single line, prefix, file, and line number',
         args => [pfx => 'PFX:', 'foo'],
         file => 'name',
         lineno => 42,
-        want => "PFX:       file name, line 42:  foo\n",
+        want => "PFX:     file name, line 42: > foo\n",
     },
     {
         desc => 'multiple lines, prefix, file, and line number',
         args => [pfx => 'PFX:', "foo\nbar"],
         file => 'name',
         lineno => 42,
-        want => "PFX:       file name, line 42:  foo\nPFX:       file name, line 42:| bar\n",
+        want => "PFX:     file name, line 42: > foo\nPFX:     file name, line 42:   bar\n",
     },
 );
 
@@ -122,18 +122,20 @@ for my $tc (@test_cases) {
     my $output;
     open(my $fh, '>', \$output);
     local *STDERR = $fh;
-    ddclient::msg('%%');
+    local $ddclient::globals{debug} = 1;
+    ddclient::debug('%%');
     close($fh);
-    is($output, "%%\n", 'single argument is printed directly, not via sprintf');
+    is($output, "DEBUG:   > %%\n", 'single argument is printed directly, not via sprintf');
 }
 
 {
     my $output;
     open(my $fh, '>', \$output);
     local *STDERR = $fh;
-    ddclient::msg('%s', 'foo');
+    local $ddclient::globals{debug} = 1;
+    ddclient::debug('%s', 'foo');
     close($fh);
-    is($output, "foo\n", 'multiple arguments are formatted via sprintf');
+    is($output, "DEBUG:   > foo\n", 'multiple arguments are formatted via sprintf');
 }
 
 done_testing();

t/use_web.pl

@@ -0,0 +1,124 @@
+use Test::More;
+use Scalar::Util qw(blessed);
+eval { require ddclient::Test::Fake::HTTPD; } or plan(skip_all => $@);
+SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
+eval { require 'ddclient'; } or BAIL_OUT($@);
+my $ipv6_supported = eval {
+    require IO::Socket::IP;
+    my $ipv6_socket = IO::Socket::IP->new(
+        Domain => 'PF_INET6',
+        LocalHost => '::1',
+        Listen => 1,
+    );
+    defined($ipv6_socket);
+};
+my $http_daemon_supports_ipv6 = eval {
+    require HTTP::Daemon;
+    HTTP::Daemon->VERSION(6.12);
+};
+
+my $builtinweb = 't/use_web.pl builtinweb';
+my $h = 't/use_web.pl hostname';
+
+sub run_httpd {
+    my ($ipv) = @_;
+    return undef if $ipv eq '6' && (!$ipv6_supported || !$http_daemon_supports_ipv6);
+    my $httpd = ddclient::Test::Fake::HTTPD->new(
+        host => $ipv eq '4' ? '127.0.0.1' : '::1',
+        daemon_args => {V6Only => 1},
+    );
+    my $headers = [
+        'content-type' => 'text/plain',
+        'this-ipv4-should-be-ignored' => 'skip skip2 192.0.2.255',
+        'this-ipv6-should-be-ignored' => 'skip skip2 2001:db8::ff',
+    ];
+    my $content = $ipv eq '4'
+        ? '192.0.2.1 skip 192.0.2.2 skip2 192.0.2.3'
+        : '2001:db8::1 skip 2001:db8::2 skip2 2001:db8::3';
+    $httpd->run(sub { return [200, $headers, [$content]]; });
+    diag("started IPv$ipv server running at ${\($httpd->endpoint())}");
+    return $httpd;
+}
+my %httpd = (
+    '4' => run_httpd('4'),
+    '6' => run_httpd('6'),
+);
+my %ep = (
+    '4' => $httpd{'4'}->endpoint(),
+    '6' => $httpd{'6'} ? $httpd{'6'}->endpoint() : undef,
+);
+
+my @test_cases;
+for my $ipv ('4', '6') {
+    my $ipv4 = $ipv eq '4';
+    for my $sfx ('', "v$ipv") {
+        push(
+            @test_cases,
+            {
+                desc => "use$sfx=web$sfx web$sfx=<url> IPv$ipv",
+                ipv6 => !$ipv4,
+                cfg => {"use$sfx" => "web$sfx", "web$sfx" => $ep{$ipv}},
+                want => $ipv4 ? '192.0.2.1' : '2001:db8::1',
+            },
+            {
+                desc => "use$sfx=web$sfx web$sfx=<url> web$sfx-skip=skip IPv$ipv",
+                ipv6 => !$ipv4,
+                cfg => {"use$sfx" => "web$sfx", "web$sfx" => $ep{$ipv}, "web$sfx-skip" => 'skip'},
+                # Note that "skip" should skip past the first "skip" and not past "skip2".
+                want => $ipv4 ? '192.0.2.2' : '2001:db8::2',
+            },
+            {
+                desc => "use$sfx=web$sfx web$sfx=<builtinweb> IPv$ipv",
+                ipv6 => !$ipv4,
+                cfg => {"use$sfx" => "web$sfx", "web$sfx" => $builtinweb},
+                biw => {url => $ep{$ipv}},
+                want => $ipv4 ? '192.0.2.1' : '2001:db8::1',
+            },
+            {
+                desc => "use$sfx=web$sfx web$sfx=<builtinweb w/skip> IPv$ipv",
+                ipv6 => !$ipv4,
+                cfg => {"use$sfx" => "web$sfx", "web$sfx" => $builtinweb},
+                biw => {url => $ep{$ipv}, skip => 'skip'},
+                # Note that "skip" should skip past the first "skip" and not past "skip2".
+                want => $ipv4 ? '192.0.2.2' : '2001:db8::2',
+            },
+            {
+                desc => "use$sfx=web$sfx web$sfx=<builtinweb w/skip> web$sfx-skip=skip2 IPv$ipv",
+                ipv6 => !$ipv4,
+                cfg => {"use$sfx" => "web$sfx", "web$sfx" => $builtinweb, "web$sfx-skip" => 'skip2'},
+                biw => {url => $ep{$ipv}, skip => 'skip'},
+                want => $ipv4 ? '192.0.2.3' : '2001:db8::3',
+            },
+        );
+    }
+}
+
+for my $tc (@test_cases) {
+    my $subst = sub {
+        return map({
+            my $class = blessed($_);
+            (defined($class) && $class->isa('EndpointPlaceholder')) ? do {
+                my $uri = ${$_}->clone();
+                $uri->query_param(tc => $tc->{desc});
+                $uri;
+            } : $_;
+        } @_);
+    };
+    local $ddclient::builtinweb{$builtinweb} = $tc->{biw};
+    $ddclient::builtinweb if 0;
+    local $ddclient::config{$h} = $tc->{cfg};
+    $ddclient::config if 0;
+    SKIP: {
+        skip("IPv6 not supported on this system", 1) if $tc->{ipv6} && !$ipv6_supported;
+        skip("HTTP::Daemon too old for IPv6 support", 1)
+            if $tc->{ipv6} && !$http_daemon_supports_ipv6;
+        is(ddclient::get_ip($tc->{cfg}{use}, $h), $tc->{want}, $tc->{desc})
+            if $tc->{cfg}{use};
+        is(ddclient::get_ipv4($tc->{cfg}{usev4}, $h), $tc->{want}, $tc->{desc})
+            if $tc->{cfg}{usev4};
+        is(ddclient::get_ipv6($tc->{cfg}{usev6}, $h), $tc->{want}, $tc->{desc})
+            if $tc->{cfg}{usev6};
+    }
+}
+
+done_testing();