From ce0a362fd03c0bfae763a445fcb151ef9ea2b9d0 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Sat, 1 Jun 2024 02:48:21 -0400 Subject: [PATCH 1/4] group_hosts_by: Add tests --- Makefile.am | 1 + t/group_hosts_by.pl | 95 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+) create mode 100644 t/group_hosts_by.pl diff --git a/Makefile.am b/Makefile.am index 459931e..5b61f08 100644 --- a/Makefile.am +++ b/Makefile.am @@ -65,6 +65,7 @@ handwritten_tests = \ t/builtinfw_query.pl \ t/get_ip_from_if.pl \ t/geturl_connectivity.pl \ + t/group_hosts_by.pl \ t/interval_expired.pl \ t/is-and-extract-ipv4.pl \ t/is-and-extract-ipv6.pl \ diff --git a/t/group_hosts_by.pl b/t/group_hosts_by.pl new file mode 100644 index 0000000..cc2cc09 --- /dev/null +++ b/t/group_hosts_by.pl @@ -0,0 +1,95 @@ +use Test::More; +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); +eval { require Data::Dumper; } or skip($@, 1); +Data::Dumper->import(); + +my $h1 = 'h1'; +my $h2 = 'h2'; +my $h3 = 'h3'; + +$ddclient::config{$h1} = { + common => 'common', + h1h2 => 'h1 and h2', + unique => 'h1', + falsy => 0, + maybeunset => 'unique', +}; +$ddclient::config{$h2} = { + common => 'common', + h1h2 => 'h1 and h2', + unique => 'h2', + falsy => '', + maybeunset => undef, # should not be grouped with unset +}; +$ddclient::config{$h3} = { + common => 'common', + h1h2 => 'unique', + unique => 'h3', + falsy => undef, + # maybeunset is intentionally not set +}; + +my @test_cases = ( + { + desc => 'empty attribute set yields single group with all hosts', + groupby => [qw()], + want => [[$h1, $h2, $h3]], + }, + { + desc => 'common attribute yields single group with all hosts', + groupby => [qw(common)], + want => [[$h1, $h2, $h3]], + }, + { + desc => 'subset share a value', + groupby => [qw(h1h2)], + want => [[$h1, $h2], [$h3]], + }, + { + desc => 'all unique', + groupby => [qw(unique)], + want => [[$h1], [$h2], [$h3]], + }, + { + desc => 'combination', + groupby => [qw(common h1h2)], + want => [[$h1, $h2], [$h3]], + }, + { + desc => 'falsy values', + groupby => [qw(falsy)], + want => [[$h1], [$h2], [$h3]], + todo => 'support for undef not yet added', + }, + { + desc => 'set, unset, undef', + groupby => [qw(maybeunset)], + want => [[$h1], [$h2], [$h3]], + todo => 'support for unset and undef not yet added', + }, + { + desc => 'missing attribute', + groupby => [qw(thisdoesnotexist)], + want => [[$h1, $h2, $h3]], + }, +); + +for my $tc (@test_cases) { + my %got = ddclient::group_hosts_by([$h1, $h2, $h3], $tc->{groupby}); + # %got is used as a set of sets. Sort everything to make comparison easier. + my @got = sort({ + for (my $i = 0; $i < @$a && $i < @$b; ++$i) { + my $x = $a->[$i] cmp $b->[$i]; + return $x if $x != 0; + } + return @$a <=> @$b; + } map({ [sort(@$_)]; } values(%got))); + TODO: { + local $TODO = $tc->{todo}; + is_deeply(\@got, $tc->{want}, $tc->{desc}) + or diag(Data::Dumper->Dump([\@got, $tc->{want}], [qw(got want)])); + } +} + +done_testing(); From 343fcff6254b1be91d346b2af0f3676a9fd07143 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Tue, 28 May 2024 02:54:26 -0400 Subject: [PATCH 2/4] group_hosts_by: Add support for `wantipv4`, `wantipv6` --- ddclient.in | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/ddclient.in b/ddclient.in index cbd009a..ec35fad 100755 --- a/ddclient.in +++ b/ddclient.in @@ -3421,9 +3421,8 @@ sub get_ipv6 { ## group_hosts_by ###################################################################### sub group_hosts_by { -##TODO - Update for wantipv4 and wantipv6 my ($hosts, $attributes) = @_; - my %attrs = (map({ ($_ => 1) } @$attributes), 'wantip' => 1); + my %attrs = map({ ($_ => 1) } @$attributes); my @attrs = sort(keys(%attrs)); my %groups = (); for my $h (@$hosts) { @@ -3980,7 +3979,7 @@ sub nic_dyndns2_update { debug("\nnic_dyndns2_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]); + my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantip)]); my %errors = ( 'badauth' => 'Bad authorization (username or password)', @@ -4275,7 +4274,7 @@ sub nic_noip_update { debug("\nnic_noip_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]); + my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantip)]); my %errors = ( 'badauth' => 'Invalid username or password', @@ -4622,7 +4621,7 @@ sub nic_zoneedit1_update { debug("\nnic_zoneedit1_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]); + my %groups = group_hosts_by(\@_, [qw(login password server zone wantip)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -5709,7 +5708,7 @@ sub nic_godaddy_update { debug("\nnic_godaddy_update --------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(server login password zone) ]); + my %groups = group_hosts_by(\@_, [qw(server login password zone wantip)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -5846,7 +5845,7 @@ sub nic_googledomains_update { debug("\nnic_googledomains_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(server login password) ]); + my %groups = group_hosts_by(\@_, [qw(server login password wantip)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -6026,7 +6025,7 @@ sub nic_nsupdate_update { debug("\nnic_nsupdate_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]); + my %groups = group_hosts_by(\@_, [qw(login password server zone wantip)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -6143,7 +6142,7 @@ sub nic_cloudflare_update { debug("\nnic_cloudflare_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(ssh login password server wildcard mx backupmx zone) ]); + my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantip)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -6291,7 +6290,7 @@ sub nic_hetzner_update { debug("\nnic_hetzner_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(ssh login password server wildcard mx backupmx zone) ]); + my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantip)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -6448,7 +6447,7 @@ sub nic_yandex_update { debug("\nnic_yandex_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(server login pasword) ]); + my %groups = group_hosts_by(\@_, [qw(server login pasword wantip)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -7339,7 +7338,7 @@ EoEXAMPLE } sub nic_cloudns_update { - my %groups = group_hosts_by([ @_ ], [ qw(dynurl) ]); + my %groups = group_hosts_by(\@_, [qw(dynurl wantip)]); for my $hr (values(%groups)) { my @hosts = @$hr; my $hosts = join(',', @hosts); From f4802fc53440c970f5762b86bff107ddb0bc47f7 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Tue, 28 May 2024 02:57:22 -0400 Subject: [PATCH 3/4] Fix `group_hosts_by` call for IPv6-enabled services --- ddclient.in | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/ddclient.in b/ddclient.in index ec35fad..24cae4f 100755 --- a/ddclient.in +++ b/ddclient.in @@ -3979,7 +3979,7 @@ sub nic_dyndns2_update { debug("\nnic_dyndns2_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantip)]); + my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantipv4 wantipv6)]); my %errors = ( 'badauth' => 'Bad authorization (username or password)', @@ -4274,7 +4274,7 @@ sub nic_noip_update { debug("\nnic_noip_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantip)]); + my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantipv4 wantipv6)]); my %errors = ( 'badauth' => 'Invalid username or password', @@ -5708,7 +5708,7 @@ sub nic_godaddy_update { debug("\nnic_godaddy_update --------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by(\@_, [qw(server login password zone wantip)]); + my %groups = group_hosts_by(\@_, [qw(server login password zone wantipv4 wantipv6)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -6025,7 +6025,7 @@ sub nic_nsupdate_update { debug("\nnic_nsupdate_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by(\@_, [qw(login password server zone wantip)]); + my %groups = group_hosts_by(\@_, [qw(login password server zone wantipv4 wantipv6)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -6142,7 +6142,7 @@ sub nic_cloudflare_update { debug("\nnic_cloudflare_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantip)]); + my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantipv4 wantipv6)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { @@ -6290,7 +6290,7 @@ sub nic_hetzner_update { debug("\nnic_hetzner_update -------------------"); ## group hosts with identical attributes together - my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantip)]); + my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantipv4 wantipv6)]); ## update each set of hosts that had similar configurations for my $sig (keys %groups) { From e60e6e804b164d850c1ef1781c03577fbe95d05c Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Tue, 28 May 2024 02:58:32 -0400 Subject: [PATCH 4/4] group_hosts_by: Use `Data::Dumper` to make the group signature This is a bit more robust than manually making the group signature because it gracefully handles corner cases such as `undef`. --- configure.ac | 2 +- ddclient.in | 5 ++++- t/group_hosts_by.pl | 9 ++------- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/configure.ac b/configure.ac index f65b8b3..d1fc02c 100644 --- a/configure.ac +++ b/configure.ac @@ -49,6 +49,7 @@ AC_SUBST([PERL]) # package doesn't depend on all of them, so their availability can't # be assumed. m4_foreach_w([_m], [ + Data::Dumper File::Basename File::Path File::Temp @@ -63,7 +64,6 @@ m4_foreach_w([_m], [ # then some tests will fail. Only prints a warning if not installed. m4_foreach_w([_m], [ B - Data::Dumper File::Spec::Functions File::Temp ], [AX_PROG_PERL_MODULES([_m], [], diff --git a/ddclient.in b/ddclient.in index 24cae4f..2bf68e8 100755 --- a/ddclient.in +++ b/ddclient.in @@ -15,6 +15,7 @@ package ddclient; require v5.10.1; use strict; use warnings; +use Data::Dumper; use File::Basename; use File::Path qw(make_path); use File::Temp; @@ -3425,8 +3426,10 @@ sub group_hosts_by { my %attrs = map({ ($_ => 1) } @$attributes); my @attrs = sort(keys(%attrs)); my %groups = (); + my $d = Data::Dumper->new([])->Indent(0)->Sortkeys(1)->Terse(1)->Useqq(1); for my $h (@$hosts) { - my $sig = join(',', map({ sprintf("%s=%s", $_, $config{$h}{$_} // '') } @attrs)); + my %cfg = map({ ($_ => $config{$h}{$_}); } grep(exists($config{$h}{$_}), @attrs)); + my $sig = $d->Reset()->Values([\%cfg])->Dump(); push @{$groups{$sig}}, $h; } return %groups; diff --git a/t/group_hosts_by.pl b/t/group_hosts_by.pl index cc2cc09..61acd0f 100644 --- a/t/group_hosts_by.pl +++ b/t/group_hosts_by.pl @@ -60,13 +60,11 @@ my @test_cases = ( desc => 'falsy values', groupby => [qw(falsy)], want => [[$h1], [$h2], [$h3]], - todo => 'support for undef not yet added', }, { desc => 'set, unset, undef', groupby => [qw(maybeunset)], want => [[$h1], [$h2], [$h3]], - todo => 'support for unset and undef not yet added', }, { desc => 'missing attribute', @@ -85,11 +83,8 @@ for my $tc (@test_cases) { } return @$a <=> @$b; } map({ [sort(@$_)]; } values(%got))); - TODO: { - local $TODO = $tc->{todo}; - is_deeply(\@got, $tc->{want}, $tc->{desc}) - or diag(Data::Dumper->Dump([\@got, $tc->{want}], [qw(got want)])); - } + is_deeply(\@got, $tc->{want}, $tc->{desc}) + or diag(Data::Dumper->Dump([\@got, $tc->{want}], [qw(got want)])); } done_testing();