Merge pull request #681 from rhansen/group_hosts_by

group_hosts_by: Add IPv6 and undef/unset support
This commit is contained in:
Richard Hansen 2024-06-01 03:09:18 -04:00 committed by GitHub
commit a0e119c2f2
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
4 changed files with 107 additions and 14 deletions

View file

@ -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 \

View file

@ -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], [],

View file

@ -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;
@ -3421,13 +3422,14 @@ 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 = ();
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;
@ -3980,7 +3982,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 wantipv4 wantipv6)]);
my %errors = (
'badauth' => 'Bad authorization (username or password)',
@ -4275,7 +4277,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 wantipv4 wantipv6)]);
my %errors = (
'badauth' => 'Invalid username or password',
@ -4622,7 +4624,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 +5711,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 wantipv4 wantipv6)]);
## update each set of hosts that had similar configurations
for my $sig (keys %groups) {
@ -5846,7 +5848,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 +6028,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 wantipv4 wantipv6)]);
## update each set of hosts that had similar configurations
for my $sig (keys %groups) {
@ -6143,7 +6145,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 wantipv4 wantipv6)]);
## update each set of hosts that had similar configurations
for my $sig (keys %groups) {
@ -6291,7 +6293,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 wantipv4 wantipv6)]);
## update each set of hosts that had similar configurations
for my $sig (keys %groups) {
@ -6448,7 +6450,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 +7341,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);

90
t/group_hosts_by.pl Normal file
View file

@ -0,0 +1,90 @@
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]],
},
{
desc => 'set, unset, undef',
groupby => [qw(maybeunset)],
want => [[$h1], [$h2], [$h3]],
},
{
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)));
is_deeply(\@got, $tc->{want}, $tc->{desc})
or diag(Data::Dumper->Dump([\@got, $tc->{want}], [qw(got want)]));
}
done_testing();