Add infrastructure for custom logic in a %builtinfw entry

Makefile.am

@@ -62,6 +62,7 @@ AM_PL_LOG_FLAGS = -Mstrict -w \
 	-I'$(abs_top_srcdir)'/t/lib \
 	-MDevel::Autoflush
 handwritten_tests = \
+	t/builtinfw_query.pl \
 	t/get_ip_from_if.pl \
 	t/geturl_connectivity.pl \
 	t/is-and-extract-ipv4.pl \

ddclient.in

@@ -437,7 +437,11 @@ my %ip_strategies = (
     'cmd'       => ": deprecated, see '--usev4=cmdv4' and '--usev6=cmdv6'",
     'cisco'     => ": deprecated, see '--usev4=cisco'",
     'cisco-asa' => ": deprecated, see '--usev4=cisco-asa'",
-    map({ $_ => ": deprecated, see '--usev4=$_'"; } keys(%builtinfw)),
+    map({
+        my $fw = $builtinfw{$_};
+        $_ => ": deprecated, see '--usev4=$_'" .
+            (defined($fw->{queryv6}) ? " and '--usev6=$_'" : '');
+    } keys(%builtinfw)),
 );
 
 sub ip_strategies_usage {
@@ -457,7 +461,9 @@ my %ipv4_strategies = (
     'cisco-asa'   => ": obtain IPv4 from Cisco ASA at the host given by --fwv4=<host> and interface given by --ifv4=<interface>",
     map({
         my $fw = $builtinfw{$_};
-        $_ => ": obtain IPv4 from $fw->{'name'} at the host or URL given by --fwv4=<host|URL>";
+        $_ => defined($fw->{queryv4})
+            ? ": obtain IPv4 from $fw->{name}@{[($fw->{help} // sub {})->('v4') // '']}"
+            : ": obtain IPv4 from $fw->{name} at the host or URL given by --fwv4=<host|URL>";
     } keys(%builtinfw)),
 );
 sub ipv4_strategies_usage {
@@ -477,11 +483,17 @@ my %ipv6_strategies = (
     'cmdv6'       => ": obtain IPv6 from the command given by --cmdv6=<command>",
     'cmd'         => ": deprecated, use '--usev6=cmdv6'",
     'fwv6'        => ": obtain IPv6 from the URL given by --fwv6=<URL>",
+    map({
+        my $fw = $builtinfw{$_};
+        defined($fw->{queryv6})
+            ? ($_ => ": obtain IPv6 from $fw->{name}@{[($fw->{help} // sub {})->('v6') // '']}")
+            : ();
+    } keys(%builtinfw)),
 );
 sub ipv6_strategies_usage {
     return map({ sprintf("    --usev6=%-22s %s.", $_, $ipv6_strategies{$_}) }
                'disabled', 'no', 'ipv6', 'ip', 'webv6', 'web', 'ifv6', 'if', 'cmdv6', 'cmd',
-               'fwv6');
+               'fwv6', sort(map({exists($ipv6_strategies{$_}) ? ($_) : ()} keys(%builtinfw))));
 }
 
 sub setv {
@@ -2900,7 +2912,12 @@ sub get_ip {
         $skip = opt('fw-skip', $h);
         if ($fw) {
             $skip //= $fw->{'skip'};
-            $url = "http://$url$fw->{'url'}" unless $url =~ /\//;
+            if (defined(my $query = $fw->{'query'})) {
+                $url = undef;
+                ($arg, $reply) = $query->($h);
+            } else {
+                $url = "http://$url$fw->{'url'}" unless $url =~ /\//;
+            }
         }
 
         if ($url) {
@@ -3334,7 +3351,12 @@ sub get_ipv4 {
         $skip = opt('fwv4-skip', $h) // opt('fw-skip', $h);
         if ($fw) {
             $skip //= $fw->{'skip'};
-            $url = "http://$url$fw->{'url'}" unless $url =~ /\//;
+            if (defined(my $query = $fw->{'queryv4'})) {
+                $url = undef;
+                ($arg, $reply) = $query->($h);
+            } else {
+                $url = "http://$url$fw->{'url'}" unless $url =~ /\//;
+            }
         }
         if ($url) {
             $reply = geturl(
@@ -3442,8 +3464,14 @@ sub get_ipv6 {
     } elsif ($usev6 eq 'disabled') {
         $reply = '';
 
-    } elsif ($usev6 eq 'fwv6' || defined($builtinfw{$usev6})) {
+    } elsif ($usev6 eq 'fwv6' || defined(my $fw = $builtinfw{$usev6})) {
-        warning("'--usev6=%s' is not implemented and does nothing", $usev6);
+        $skip = opt('fwv6-skip', $h) // $fw->{'skip'};
+        if ($fw && defined(my $query = $fw->{'queryv6'})) {
+            $skip //= $fw->{'skip'};
+            ($arg, $reply) = $query->($h);
+        } else {
+            warning("'--usev6=%s' is not implemented and does nothing", $usev6);
+        }
 
     } else {
         warning("ignoring unsupported '--usev6=$usev6'");

t/builtinfw_query.pl

@@ -0,0 +1,93 @@
+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");
+    },
+    queryv4 => sub {
+        ($got_host) = @_;
+        return ($got_host, "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");
+    },
+};
+%ddclient::builtinfw if 0;  # suppress spurious warning "Name used only once: possible typo"
+
+my @test_cases = (
+    {
+        desc => 'query',
+        getip => \&ddclient::get_ip,
+        useopt => 'use',
+        cfgxtra => {},
+        want => '192.0.2.2',
+    },
+    {
+        desc => 'queryv4',
+        getip => \&ddclient::get_ipv4,
+        useopt => 'usev4',
+        cfgxtra => {'fwv4-skip' => 'skip3'},
+        want => '192.0.2.6',
+    },
+    {
+        desc => 'queryv4 with fw-skip fallback',
+        getip => \&ddclient::get_ipv4,
+        useopt => 'usev4',
+        cfgxtra => {},
+        want => '192.0.2.5',
+    },
+    {
+        desc => 'queryv6',
+        getip => \&ddclient::get_ipv6,
+        useopt => 'usev6',
+        cfgxtra => {'fwv6-skip' => 'skip4'},
+        want => '2001:db8::3',
+    },
+    {
+        # Support for --usev6=<builtin> wasn't added until after --fwv6-skip was added, so fallback
+        # to the deprecated --fw-skip option was never needed.
+        desc => 'queryv6 ignores fw-skip',
+        getip => \&ddclient::get_ipv6,
+        useopt => 'usev6',
+        cfgxtra => {},
+        want => '2001:db8::1',
+    },
+);
+
+for my $tc (@test_cases) {
+    subtest $tc->{desc} => sub {
+        my $h = "t/builtinfw_query.pl $tc->{desc}";
+        $ddclient::config{$h} = {
+            $tc->{useopt} => $builtinfw,
+            'fw-skip' => 'skip1',
+            %{$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");
+    };
+}
+
+done_testing();