diff --git a/Makefile.am b/Makefile.am index a1910825..13367ad6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -162,4 +162,6 @@ EXTRA_DIST += $(handwritten_tests) \ t/lib/ddclient/Test/Fake/HTTPD/dummy-server-cert.pem \ t/lib/ddclient/Test/Fake/HTTPD/dummy-server-key.pem \ t/lib/ddclient/t.pm \ + t/lib/ddclient/t/HTTPD.pm \ + t/lib/ddclient/t/ip.pm \ t/lib/ok.pm diff --git a/configure.ac b/configure.ac index fa0c856e..7f1c580e 100644 --- a/configure.ac +++ b/configure.ac @@ -95,7 +95,6 @@ m4_foreach_w([_m], [ HTTP::Request HTTP::Response JSON::PP - LWP::UserAgent Test::MockModule Test::TCP Test::Warnings diff --git a/ddclient.in b/ddclient.in index 463661bc..ae9ab9e1 100755 --- a/ddclient.in +++ b/ddclient.in @@ -131,7 +131,6 @@ my $daemon_default = ($programd =~ /d$/) ? interval('5m') : undef; # Current Logger instance. To push a context prefix onto the context stack: # local _l = pushlogctx('additional context goes here'); our $_l = ddclient::Logger->new(); -our @_test_headers; $ENV{'PATH'} = (exists($ENV{PATH}) ? "$ENV{PATH}:" : "") . "/sbin:/usr/sbin:/bin:/usr/bin:/etc:/usr/lib:"; @@ -2818,7 +2817,7 @@ sub geturl { push(@curlopt, "user=\"".escape_curl_param("${login}:${password}").'"') if (defined($login) && defined($password)); push(@curlopt, "proxy=\"".escape_curl_param("${protocol}://${proxy}").'"') if defined($proxy); push(@curlopt, "url=\"".escape_curl_param("${protocol}://${server}/${url}").'"'); - push(@curlopt, map('header="' . escape_curl_param($_) . '"', @_test_headers, + push(@curlopt, map('header="' . escape_curl_param($_) . '"', ref($headers) eq 'ARRAY' ? @$headers : split('\n', $headers))); # Add in the data if any was provided (for POST/PATCH) diff --git a/t/builtinfw_query.pl b/t/builtinfw_query.pl index a784a338..e5ea9496 100644 --- a/t/builtinfw_query.pl +++ b/t/builtinfw_query.pl @@ -1,6 +1,6 @@ use Test::More; -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } my $got_host; my $builtinfw = 't/builtinfw_query.pl'; diff --git a/t/get_ip_from_if.pl b/t/get_ip_from_if.pl index 15c66a13..8ff36fb0 100644 --- a/t/get_ip_from_if.pl +++ b/t/get_ip_from_if.pl @@ -1,12 +1,7 @@ use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } use ddclient::t; -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); - -# To aid in debugging, uncomment the following lines. (They are normally left commented to avoid -# accidentally interfering with the Test Anything Protocol messages written by Test::More.) -#STDOUT->autoflush(1); -#$ddclient::globals{'debug'} = 1; subtest "get_default_interface tests" => sub { for my $sample (@ddclient::t::routing_samples) { diff --git a/t/geturl_connectivity.pl b/t/geturl_connectivity.pl index 8c1cb996..b0dd94d2 100644 --- a/t/geturl_connectivity.pl +++ b/t/geturl_connectivity.pl @@ -1,58 +1,23 @@ use Test::More; -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 $has_http_daemon_ssl = eval { require HTTP::Daemon::SSL; }; -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); -}; - -# To aid in debugging, uncomment the following lines. (They are normally left commented to avoid -# accidentally interfering with the Test Anything Protocol messages written by Test::More.) -#STDOUT->autoflush(1); -#$ddclient::globals{'verbose'} = 1; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); +} +use ddclient::t::ip; -my $certdir = "$ENV{abs_top_srcdir}/t/lib/ddclient/Test/Fake/HTTPD"; -$ddclient::globals{'ssl_ca_file'} = "$certdir/dummy-ca-cert.pem"; +$ddclient::globals{'ssl_ca_file'} = $ca_file; -sub run_httpd { - my ($ipv6, $ssl) = @_; - return undef if $ssl && !$has_http_daemon_ssl; - return undef if $ipv6 && (!$ipv6_supported || !$http_daemon_supports_ipv6); - my $httpd = ddclient::Test::Fake::HTTPD->new( - host => $ipv6 ? '::1' : '127.0.0.1', - scheme => $ssl ? 'https' : 'http', - daemon_args => { - SSL_cert_file => "$certdir/dummy-server-cert.pem", - SSL_key_file => "$certdir/dummy-server-key.pem", - V6Only => 1, - }, - ); - $httpd->run(sub { - # Echo back the full request. - return [200, ['Content-Type' => 'application/octet-stream'], [$_[0]->as_string()]]; - }); - diag(sprintf("started IPv%s%s server running at %s", - $ipv6 ? '6' : '4', $ssl ? ' SSL' : '', $httpd->endpoint())); - return $httpd; +for my $ipv ('4', '6') { + for my $ssl (0, 1) { + my $httpd = httpd($ipv, $ssl) or next; + $httpd->run(sub { + return [200, ['Content-Type' => 'application/octet-stream'], [$_[0]->as_string()]]; + }); + } } -my %httpd = ( - '4' => {'http' => run_httpd(0, 0), 'https' => run_httpd(0, 1)}, - '6' => {'http' => run_httpd(1, 0), 'https' => run_httpd(1, 1)}, -); - my @test_cases = ( {ipv6_opt => 0, server_ipv => '4', client_ipv => ''}, {ipv6_opt => 0, server_ipv => '4', client_ipv => '4'}, @@ -79,9 +44,9 @@ sub run_httpd { skip("IPv6 not supported on this system", 1) if $tc->{server_ipv} eq '6' && !$ipv6_supported; skip("HTTP::Daemon too old for IPv6 support", 1) - if $tc->{server_ipv} eq '6' && !$http_daemon_supports_ipv6; - skip("HTTP::Daemon::SSL not available", 1) if $tc->{ssl} && !$has_http_daemon_ssl; - my $uri = $httpd{$tc->{server_ipv}}{$tc->{ssl} ? 'https' : 'http'}->endpoint(); + if $tc->{server_ipv} eq '6' && !$httpd_ipv6_supported; + skip("HTTP::Daemon::SSL not available", 1) if $tc->{ssl} && !$httpd_ssl_supported; + my $uri = httpd($tc->{server_ipv}, $tc->{ssl})->endpoint(); my $name = sprintf("IPv%s client to %s%s", $tc->{client_ipv} || '*', $uri, $tc->{ipv6_opt} ? ' (-ipv6)' : ''); $ddclient::globals{'ipv6'} = $tc->{ipv6_opt}; diff --git a/t/lib/ddclient/t.pm b/t/lib/ddclient/t.pm index c546b9c9..4f8813e8 100644 --- a/t/lib/ddclient/t.pm +++ b/t/lib/ddclient/t.pm @@ -560,3 +560,5 @@ EOF want_ipv6_if => "en0", }, ); + +1; diff --git a/t/lib/ddclient/t/HTTPD.pm b/t/lib/ddclient/t/HTTPD.pm new file mode 100644 index 00000000..f9a5f1a8 --- /dev/null +++ b/t/lib/ddclient/t/HTTPD.pm @@ -0,0 +1,135 @@ +package ddclient::t::HTTPD; + +use v5.10.1; +use strict; +use warnings; + +use parent qw(ddclient::Test::Fake::HTTPD); + +use Exporter qw(import); +use JSON::PP; +use Test::More; +BEGIN { require 'ddclient'; } +use ddclient::t::ip; + +our @EXPORT = qw( + httpd + httpd_ipv6_ok httpd_ipv6_required $httpd_ipv6_supported $httpd_ipv6_support_error + httpd_ssl_ok httpd_ssl_required $httpd_ssl_supported $httpd_ssl_support_error + $ca_file $certdir + $textplain +); + +our $httpd_ssl_support_error; +our $httpd_ssl_supported = eval { require HTTP::Daemon::SSL; 1; } or $httpd_ssl_support_error = $@; + +sub httpd_ssl_ok { + ok($httpd_ssl_supported, "SSL is supported") or diag($httpd_ssl_support_error); +} + +sub httpd_ssl_required { + plan(skip_all => $httpd_ssl_support_error) if !$httpd_ssl_supported; +} + +our $httpd_ipv6_support_error; +our $httpd_ipv6_supported = $ipv6_supported or $httpd_ipv6_support_error = $ipv6_support_error; +$httpd_ipv6_supported = eval { require HTTP::Daemon; HTTP::Daemon->VERSION(6.12); } + or $httpd_ipv6_support_error = $@ + if $httpd_ipv6_supported; + +sub httpd_ipv6_ok { + ok($httpd_ipv6_supported, "test HTTP server supports IPv6") or diag($httpd_ipv6_support_error); +} + +sub httpd_ipv6_required { + plan(skip_all => $httpd_ipv6_support_error) if !$httpd_ipv6_supported; +} + +our $textplain = ['content-type' => 'text/plain; charset=utf-8']; + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + $self->{_requests} = []; # Log of received requests. + $self->{_responses} = []; # Script of responses to play back. + return $self; +} + +sub run { + my ($self, $app) = @_; + $self->SUPER::run(sub { + my ($req) = @_; + push(@{$self->{_requests}}, $req); + my $res = $app->($req) if defined($app); + return $res if defined($res); + if ($req->uri()->path() eq '/control') { + pop(@{$self->{_requests}}); + if ($req->method() eq 'PUT') { + return [400, $textplain, ['content must be json']] + if $req->headers()->content_type() ne 'application/json'; + eval { @{$self->{_responses}} = @{decode_json($req->content())}; 1; } + or return [400, $textplain, ['content is not valid json']]; + @{$self->{_requests}} = (); + return [200, $textplain, ["successfully reset request log and response script"]]; + } elsif ($req->method() eq 'GET') { + my @reqs = map($_->as_string(), @{$self->{_requests}}); + return [200, ['content-type' => 'application/json'], [encode_json(\@reqs)]]; + } else { + return [405, $textplain, ['unsupported method: ' . $req->method()]]; + } + } + return shift(@{$self->{_responses}}) // [500, $textplain, ["no more scripted responses"]]; + }); + diag("started server running at " . $self->endpoint()); + return $self; +} + +sub reset { + my $self = shift; + my $ep = $self->endpoint(); + my $got = ddclient::geturl(url => "$ep/control"); + diag("http response:\n$got"); + ddclient::header_ok($got) + or BAIL_OUT("failed to get log of requests from test http server at $ep"); + $got =~ s/^.*?\n\n//s; + my @got = map(HTTP::Request->parse($_), @{decode_json($got)}); + ddclient::header_ok(ddclient::geturl( + url => "$ep/control", + method => 'PUT', + headers => ['content-type: application/json'], + data => encode_json(\@_), + )) or BAIL_OUT("failed to reset the test http server at $ep"); + return @got; +} + +our $certdir = "$ENV{abs_top_srcdir}/t/lib/ddclient/Test/Fake/HTTPD"; +our $ca_file = "$certdir/dummy-ca-cert.pem"; + +my %daemons; + +sub httpd { + my ($ipv, $ssl) = @_; + $ipv //= ''; + $ssl = !!$ssl; + return undef if $ipv eq '6' && !$httpd_ipv6_supported; + return undef if $ssl && !$httpd_ssl_supported; + if (!defined($daemons{$ipv}{$ssl})) { + my $host + = $ipv eq '4' ? '127.0.0.1' + : $ipv eq '6' ? '::1' + : $httpd_ipv6_supported ? '::1' + : '127.0.0.1'; + $daemons{$ipv}{$ssl} = __PACKAGE__->new( + host => $host, + scheme => $ssl ? 'https' : 'http', + daemon_args => { + (V6Only => $ipv eq '6' ? 1 : 0) x ($host eq '::1'), + (SSL_cert_file => "$certdir/dummy-server-cert.pem", + SSL_key_file => "$certdir/dummy-server-key.pem") x $ssl, + }, + ); + } + return $daemons{$ipv}{$ssl}; +} + +1; diff --git a/t/lib/ddclient/t/ip.pm b/t/lib/ddclient/t/ip.pm new file mode 100644 index 00000000..769e5a9c --- /dev/null +++ b/t/lib/ddclient/t/ip.pm @@ -0,0 +1,30 @@ +package ddclient::t::ip; + +use v5.10.1; +use strict; +use warnings; +use Exporter qw(import); +use Test::More; + +our @EXPORT = qw(ipv6_ok ipv6_required $ipv6_supported $ipv6_support_error); + +our $ipv6_support_error; +our $ipv6_supported = eval { + require IO::Socket::IP; + my $ipv6_socket = IO::Socket::IP->new( + Domain => 'PF_INET6', + LocalHost => '::1', + Listen => 1, + ); + defined($ipv6_socket); +} or $ipv6_support_error = $@; + +sub ipv6_ok { + ok($ipv6_supported, "system supports IPv6") or diag($ipv6_support_error); +} + +sub ipv6_required { + plan(skip_all => $ipv6_support_error) if !$ipv6_supported; +} + +1; diff --git a/t/protocol_directnic.pl b/t/protocol_directnic.pl index 855500d1..30be5d5c 100644 --- a/t/protocol_directnic.pl +++ b/t/protocol_directnic.pl @@ -1,14 +1,15 @@ use Test::More; -eval { require JSON::PP; } or plan(skip_all => $@); -JSON::PP->import(qw(encode_json)); -eval { require ddclient::Test::Fake::HTTPD; } or plan(skip_all => $@); -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require JSON::PP; 1; } or plan(skip_all => $@); JSON::PP->import(); } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); +} ddclient::load_json_support('directnic'); -my $httpd = ddclient::Test::Fake::HTTPD->new(); -$httpd->run(sub { +httpd()->run(sub { my ($req) = @_; diag('=============================================================================='); diag("Test server received request:\n" . $req->as_string()); @@ -28,11 +29,10 @@ } return [400, $headers, ['unexpected request: ' . $req->uri()]] }); -diag("started IPv4 HTTP server running at " . $httpd->endpoint()); { package Logger; - BEGIN { push(our @ISA, qw(ddclient::Logger)); } + use parent qw(-norequire ddclient::Logger); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new(undef, $parent); @@ -47,7 +47,7 @@ } } -my $hostname = $httpd->endpoint(); +my $hostname = httpd()->endpoint(); my @test_cases = ( { desc => 'IPv4, good', diff --git a/t/protocol_dnsexit2.pl b/t/protocol_dnsexit2.pl index 76071ea1..0586276b 100644 --- a/t/protocol_dnsexit2.pl +++ b/t/protocol_dnsexit2.pl @@ -1,49 +1,25 @@ use Test::More; -eval { require JSON::PP; } or plan(skip_all => $@); -JSON::PP->import(qw(encode_json decode_json)); -eval { require 'ddclient'; } or BAIL_OUT($@); -eval { require ddclient::Test::Fake::HTTPD; } or plan(skip_all => $@); -eval { require LWP::UserAgent; } or plan(skip_all => $@); +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require JSON::PP; 1; } or plan(skip_all => $@); JSON::PP->import(); } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); +} ddclient::load_json_support('dnsexit2'); -my @requests; # Declare global variable to store requests, used for tests. -my @httpd_requests; # Declare variable specificly used for the httpd process (which cannot be shared with tests). -my $httpd = ddclient::Test::Fake::HTTPD->new(); - -$httpd->run(sub { +httpd()->run(sub { my ($req) = @_; - if ($req->uri->as_string eq '/get_requests') { - return [200, ['Content-Type' => 'application/json'], [encode_json(\@httpd_requests)]]; - } elsif ($req->uri->as_string eq '/reset_requests') { - @httpd_requests = (); - return [200, ['Content-Type' => 'application/json'], [encode_json({ message => 'OK' })]]; - } - my $request_info = { - method => $req->method, - uri => $req->uri->as_string, - content => $req->content, - headers => $req->headers->as_string - }; - push @httpd_requests, $request_info; + return undef if $req->uri()->path() eq '/control'; return [200, ['Content-Type' => 'application/json'], [encode_json({ code => 0, message => 'Success' })]]; }); -diag(sprintf("started IPv4 server running at %s", $httpd->endpoint())); - local $ddclient::globals{verbose} = 1; -my $ua = LWP::UserAgent->new; - -sub test_nic_dnsexit2_update { - my ($config, @hostnames) = @_; - %ddclient::config = %$config; - ddclient::nic_dnsexit2_update(undef, @hostnames); -} - sub decode_and_sort_array { my ($data) = @_; if (!ref $data) { @@ -53,145 +29,132 @@ sub decode_and_sort_array { return $data; } -sub reset_test_data { - my $response = $ua->get($httpd->endpoint . '/reset_requests'); - die "Failed to reset requests" unless $response->is_success; - @requests = (); -} - -sub get_requests { - my $res = $ua->get($httpd->endpoint . '/get_requests'); - die "Failed to get requests: " . $res->status_line unless $res->is_success; - return @{decode_json($res->decoded_content)}; -} - subtest 'Testing nic_dnsexit2_update' => sub { - my %config = ( - 'host.my.zone.com' => { + httpd()->reset(); + local %ddclient::config = ( + 'host.my.example.com' => { 'usev4' => 'ipv4', - 'wantipv4' => '8.8.4.4', + 'wantipv4' => '192.0.2.1', 'usev6' => 'ipv6', - 'wantipv6' => '2001:4860:4860::8888', + 'wantipv6' => '2001:db8::1', 'protocol' => 'dnsexit2', 'password' => 'mytestingpassword', - 'zone' => 'my.zone.com', - 'server' => $httpd->endpoint(), + 'zone' => 'my.example.com', + 'server' => httpd()->endpoint(), 'path' => '/update', 'ttl' => 5 }); - test_nic_dnsexit2_update(\%config, 'host.my.zone.com'); - @requests = get_requests(); - is($requests[0]->{method}, 'POST', 'Method is correct'); - is($requests[0]->{uri}, '/update', 'URI contains correct path'); - like($requests[0]->{headers}, qr/Content-Type: application\/json/, 'Content-Type header is correct'); - like($requests[0]->{headers}, qr/Accept: application\/json/, 'Accept header is correct'); - my $data = decode_and_sort_array($requests[0]->{content}); - my $expected_data = decode_and_sort_array({ - 'domain' => 'my.zone.com', + ddclient::nic_dnsexit2_update(undef, 'host.my.example.com'); + my @requests = httpd()->reset(); + is(scalar(@requests), 1, 'expected number of update requests'); + my $req = shift(@requests); + is($req->method(), 'POST', 'Method is correct'); + is($req->uri()->as_string(), '/update', 'URI contains correct path'); + is($req->header('content-type'), 'application/json', 'Content-Type header is correct'); + is($req->header('accept'), 'application/json', 'Accept header is correct'); + my $got = decode_and_sort_array($req->content()); + my $want = decode_and_sort_array({ + 'domain' => 'my.example.com', 'apikey' => 'mytestingpassword', 'update' => [ { 'type' => 'A', 'name' => 'host', - 'content' => '8.8.4.4', + 'content' => '192.0.2.1', 'ttl' => 5, }, { 'type' => 'AAAA', 'name' => 'host', - 'content' => '2001:4860:4860::8888', + 'content' => '2001:db8::1', 'ttl' => 5, } ] }); - is_deeply($data, $expected_data, 'Data is correct'); - reset_test_data(); + is_deeply($got, $want, 'Data is correct'); }; subtest 'Testing nic_dnsexit2_update without a zone set' => sub { - my %config = ( - 'myhost.zone.com' => { + httpd()->reset(); + local %ddclient::config = ( + 'myhost.example.com' => { 'usev4' => 'ipv4', - 'wantipv4' => '8.8.4.4', + 'wantipv4' => '192.0.2.1', 'protocol' => 'dnsexit2', 'password' => 'anotherpassword', - 'server' => $httpd->endpoint(), + 'server' => httpd()->endpoint(), 'path' => '/update-alt', 'ttl' => 10 }); - test_nic_dnsexit2_update(\%config, 'myhost.zone.com'); - @requests = get_requests(); - my $data = decode_and_sort_array($requests[0]->{content}); - my $expected_data = decode_and_sort_array({ - 'domain' => 'myhost.zone.com', + ddclient::nic_dnsexit2_update(undef, 'myhost.example.com'); + my @requests = httpd()->reset(); + is(scalar(@requests), 1, 'expected number of update requests'); + my $req = shift(@requests); + my $got = decode_and_sort_array($req->content()); + my $want = decode_and_sort_array({ + 'domain' => 'myhost.example.com', 'apikey' => 'anotherpassword', 'update' => [ { 'type' => 'A', 'name' => '', - 'content' => '8.8.4.4', + 'content' => '192.0.2.1', 'ttl' => 10, } ] }); - is_deeply($data, $expected_data, 'Data is correct'); - reset_test_data($ua); + is_deeply($got, $want, 'Data is correct'); }; subtest 'Testing nic_dnsexit2_update with two hostnames, one with a zone and one without' => sub { - my %config = ( - 'host1.zone.com' => { + httpd()->reset(); + local %ddclient::config = ( + 'host1.example.com' => { 'usev4' => 'ipv4', - 'wantipv4' => '8.8.4.4', + 'wantipv4' => '192.0.2.1', 'protocol' => 'dnsexit2', 'password' => 'testingpassword', - 'server' => $httpd->endpoint(), + 'server' => httpd()->endpoint(), 'path' => '/update', 'ttl' => 5 }, - 'host2.zone.com' => { + 'host2.example.com' => { 'usev6' => 'ipv6', - 'wantipv6' => '2001:4860:4860::8888', + 'wantipv6' => '2001:db8::1', 'protocol' => 'dnsexit2', 'password' => 'testingpassword', - 'server' => $httpd->endpoint(), + 'server' => httpd()->endpoint(), 'path' => '/update', 'ttl' => 10, - 'zone' => 'zone.com' + 'zone' => 'example.com' } ); - test_nic_dnsexit2_update(\%config, 'host1.zone.com', 'host2.zone.com'); - my $expected_data1 = decode_and_sort_array({ - 'domain' => 'host1.zone.com', - 'apikey' => 'testingpassword', - 'update' => [ - { + ddclient::nic_dnsexit2_update(undef, 'host1.example.com', 'host2.example.com'); + my @requests = httpd()->reset(); + my @got = map(decode_and_sort_array($_->content()), @requests); + my @want = ( + decode_and_sort_array({ + 'domain' => 'host1.example.com', + 'apikey' => 'testingpassword', + 'update' => [{ 'type' => 'A', 'name' => '', - 'content' => '8.8.4.4', + 'content' => '192.0.2.1', 'ttl' => 5, - } - ] - }); - my $expected_data2 = decode_and_sort_array({ - 'domain' => 'zone.com', - 'apikey' => 'testingpassword', - 'update' => [ - { + }], + }), + decode_and_sort_array({ + 'domain' => 'example.com', + 'apikey' => 'testingpassword', + 'update' => [{ 'type' => 'AAAA', 'name' => 'host2', - 'content' => '2001:4860:4860::8888', + 'content' => '2001:db8::1', 'ttl' => 10, - } - ] - }); - @requests = get_requests(); - for my $i (0..1) { - my $data = decode_and_sort_array($requests[$i]->{content}); - is_deeply($data, $expected_data1, 'Data is correct for call host1') if $i == 0; - is_deeply($data, $expected_data2, 'Data is correct for call host2') if $i == 1; - } - reset_test_data(); + }], + }), + ); + is_deeply(\@got, \@want, 'data is correct'); }; done_testing(); diff --git a/t/protocol_dyndns2.pl b/t/protocol_dyndns2.pl index 6cc4e2ae..682be57b 100644 --- a/t/protocol_dyndns2.pl +++ b/t/protocol_dyndns2.pl @@ -1,30 +1,28 @@ use Test::More; -use Scalar::Util qw(blessed); +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } use MIME::Base64; -eval { require ddclient::Test::Fake::HTTPD; } or plan(skip_all => $@); -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); +use Scalar::Util qw(blessed); +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); +} -my $httpd = ddclient::Test::Fake::HTTPD->new(); -$httpd->run(sub { +httpd()->run(sub { my ($req) = @_; diag('=============================================================================='); diag("Test server received request:\n" . $req->as_string()); - my $headers = ['content-type' => 'text/plain; charset=utf-8']; + return undef if $req->uri()->path() eq '/control'; my $wantauthn = 'Basic ' . encode_base64('username:password', ''); - return [401, [@$headers, 'www-authenticate' => 'Basic realm="realm", charset="UTF-8"'], + return [401, [@$textplain, 'www-authenticate' => 'Basic realm="realm", charset="UTF-8"'], ['authentication required']] if ($req->header('authorization') // '') ne $wantauthn; - return [400, $headers, ['invalid method: ' . $req->method()]] if $req->method() ne 'GET'; - return [400, $headers, ['unexpected request: ' . $req->uri() . "\n", - 'want: ' . $req->header('want-req')]] - if $req->uri() ne $req->header('want-req'); - return [200, $headers, [map("$_\n", $req->header('line'))]]; + return [400, $textplain, ['invalid method: ' . $req->method()]] if $req->method() ne 'GET'; + return undef; }); -diag("started IPv4 HTTP server running at " . $httpd->endpoint()); { package Logger; - BEGIN { push(our @ISA, qw(ddclient::Logger)); } + use parent qw(-norequire ddclient::Logger); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new(undef, $parent); @@ -256,18 +254,20 @@ $ddclient::config{$_} = { login => 'username', password => 'password', - server => $httpd->endpoint(), + server => httpd()->endpoint(), script => '/nic/update', %{$tc->{cfg}{$_}}, } for keys(%{$tc->{cfg}}); + httpd()->reset([200, $textplain, [map("$_\n", @{$tc->{resp}})]]); { - local @ddclient::_test_headers = ( - "want-req: /nic/update?$tc->{wantquery}", - map("line: $_", @{$tc->{resp}}), - ); local $ddclient::_l = $l; ddclient::nic_dyndns2_update(undef, sort(keys(%{$tc->{cfg}}))); } + my @requests = httpd()->reset(); + is(scalar(@requests), 1, "$tc->{desc}: single update request"); + my $req = shift(@requests); + is($req->uri()->path(), '/nic/update', "$tc->{desc}: request path"); + is($req->uri()->query(), $tc->{wantquery}, "$tc->{desc}: request query"); is_deeply(\%ddclient::recap, $tc->{wantrecap}, "$tc->{desc}: recap") or diag(ddclient::repr(Values => [\%ddclient::recap, $tc->{wantrecap}], Names => ['*got', '*want'])); diff --git a/t/read_recap.pl b/t/read_recap.pl index b2a62c57..a243d99a 100644 --- a/t/read_recap.pl +++ b/t/read_recap.pl @@ -1,7 +1,7 @@ use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } use File::Temp; -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } local $ddclient::globals{debug} = 1; local $ddclient::globals{verbose} = 1; diff --git a/t/skip.pl b/t/skip.pl index 4e44a816..ba5dac98 100644 --- a/t/skip.pl +++ b/t/skip.pl @@ -1,48 +1,25 @@ use Test::More; -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); -}; - -sub run_httpd { - my ($ipv6) = @_; - return undef if $ipv6 && (!$ipv6_supported || !$http_daemon_supports_ipv6); - my $httpd = ddclient::Test::Fake::HTTPD->new( - host => $ipv6 ? '::1' : '127.0.0.1', - scheme => 'http', - daemon_args => {V6Only => 1}, - ); - my $out = $ipv6 ? '::1 skip ::2' : '127.0.0.1 skip 127.0.0.2'; - $httpd->run(sub { - return [200, ['Content-Type' => 'text/plain'], [$out]]; - }); - diag(sprintf("started IPv%s SSL server running at %s", $ipv6 ? '6' : '4', $httpd->endpoint())); - return $httpd; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); } -my %httpd = ( - '4' => run_httpd(0), - '6' => run_httpd(1), -); +use ddclient::t::ip; + +httpd('4')->run( + sub { return [200, ['Content-Type' => 'text/plain'], ['127.0.0.1 skip 127.0.0.2']]; }); +httpd('6')->run( + sub { return [200, ['Content-Type' => 'text/plain'], ['::1 skip ::2']]; }) + if httpd('6'); my $builtinwebv4 = 't/skip.pl webv4'; my $builtinwebv6 = 't/skip.pl webv6'; my $builtinfw = 't/skip.pl fw'; -$ddclient::builtinweb{$builtinwebv4} = {'url' => $httpd{'4'}->endpoint(), 'skip' => 'skip'}; -$ddclient::builtinweb{$builtinwebv6} = {'url' => $httpd{'6'}->endpoint(), 'skip' => 'skip'} - if $httpd{'6'}; +$ddclient::builtinweb{$builtinwebv4} = {'url' => httpd('4')->endpoint(), 'skip' => 'skip'}; +$ddclient::builtinweb{$builtinwebv6} = {'url' => httpd('6')->endpoint(), 'skip' => 'skip'} + if httpd('6'); $ddclient::builtinfw{$builtinfw} = {name => 'test', skip => 'skip'}; %ddclient::builtinfw if 0; # suppress spurious warning "Name used only once: possible typo" @@ -50,8 +27,7 @@ sub run_test_case { my %tc = @_; 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; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc{ipv6} && !$httpd_ipv6_supported; my $h = 't/skip.pl'; $ddclient::config{$h} = $tc{cfg}; %ddclient::config if 0; # suppress spurious warning "Name used only once: possible typo" @@ -127,7 +103,7 @@ sub run_test_case { run_test_case( desc => "fw-skip='' cancels built-in skip", cfg => { - 'fw' => $httpd{'4'}->endpoint(), + 'fw' => httpd('4')->endpoint(), 'fw-skip' => '', 'use' => $builtinfw, }, @@ -136,7 +112,7 @@ sub run_test_case { run_test_case( desc => 'fw-skip=undef uses built-in skip', cfg => { - 'fw' => $httpd{'4'}->endpoint(), + 'fw' => httpd('4')->endpoint(), 'fw-skip' => undef, 'use' => $builtinfw, }, @@ -147,7 +123,7 @@ sub run_test_case { run_test_case( desc => "fwv4-skip='' cancels built-in skip", cfg => { - 'fwv4' => $httpd{'4'}->endpoint(), + 'fwv4' => httpd('4')->endpoint(), 'fwv4-skip' => '', 'usev4' => $builtinfw, }, @@ -156,7 +132,7 @@ sub run_test_case { run_test_case( desc => 'fwv4-skip=undef uses built-in skip', cfg => { - 'fwv4' => $httpd{'4'}->endpoint(), + 'fwv4' => httpd('4')->endpoint(), 'fwv4-skip' => undef, 'usev4' => $builtinfw, }, diff --git a/t/ssl-validate.pl b/t/ssl-validate.pl index bf2265d6..36e510ab 100644 --- a/t/ssl-validate.pl +++ b/t/ssl-validate.pl @@ -1,55 +1,23 @@ use Test::More; -eval { - require ddclient::Test::Fake::HTTPD; - require HTTP::Daemon::SSL; -} 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); -}; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); +} +use ddclient::t::ip; + +httpd_ssl_required(); # Note: $ddclient::globals{'ssl_ca_file'} is intentionally NOT set to "$certdir/dummy-ca-cert.pem" # so that we can test what happens when certificate validation fails. -my $certdir = "$ENV{abs_top_srcdir}/t/lib/ddclient/Test/Fake/HTTPD"; -sub run_httpd { - my ($ipv6) = @_; - return undef if $ipv6 && (!$ipv6_supported || !$http_daemon_supports_ipv6); - my $addr = $ipv6 ? '::1' : '127.0.0.1'; - my $httpd = ddclient::Test::Fake::HTTPD->new( - host => $addr, - scheme => 'https', - daemon_args => { - SSL_cert_file => "$certdir/dummy-server-cert.pem", - SSL_key_file => "$certdir/dummy-server-key.pem", - V6Only => 1, - }, - ); - $httpd->run(sub { - return [200, ['Content-Type' => 'text/plain'], [$addr]]; - }); - diag(sprintf("started IPv%s SSL server running at %s", $ipv6 ? '6' : '4', $httpd->endpoint())); - return $httpd; -} +httpd('4', 1)->run(sub { return [200, $textplain, ['127.0.0.1']]; }); +httpd('6', 1)->run(sub { return [200, $textplain, ['::1']]; }) if httpd('6', 1); my $h = 't/ssl-validate.pl'; -my %httpd = ( - '4' => run_httpd(0), - '6' => run_httpd(1), -); my %ep = ( - '4' => $httpd{'4'}->endpoint(), - '6' => $httpd{'6'} ? $httpd{'6'}->endpoint() : undef, + '4' => httpd('4', 1)->endpoint(), + '6' => httpd('6', 1) ? httpd('6', 1)->endpoint() : undef, ); my @test_cases = ( @@ -104,8 +72,7 @@ sub run_httpd { for my $tc (@test_cases) { 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; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc->{ipv6} && !$httpd_ipv6_supported; $ddclient::config{$h} = $tc->{cfg}; %ddclient::config if 0; # suppress spurious warning "Name used only once: possible typo" is(ddclient::get_ipv4($tc->{cfg}{usev4}, $h), $tc->{want}, $tc->{desc}) diff --git a/t/update_nics.pl b/t/update_nics.pl index e7720219..913b7757 100644 --- a/t/update_nics.pl +++ b/t/update_nics.pl @@ -1,44 +1,46 @@ use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } use File::Temp; +BEGIN { eval { require HTTP::Request; 1; } or plan(skip_all => $@); } +BEGIN { eval { require JSON::PP; 1; } or plan(skip_all => $@); JSON::PP->import(); } use List::Util qw(max); -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); -}; - -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 $ip = $ipv eq '4' ? '192.0.2.1' : '2001:db8::1'; - $httpd->run(sub { return [200, ['content-type' => 'text/plain; charset=utf-8'], [$ip]]; }); - diag("started IPv$ipv HTTP server running at " . $httpd->endpoint()); - return $httpd; +use Scalar::Util qw(refaddr); +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); } -my %httpd = ( - '4' => run_httpd('4'), - '6' => run_httpd('6'), -); +use ddclient::t::ip; + +httpd('4')->run(); +httpd('6')->run() if httpd('6'); local %ddclient::builtinweb = ( - v4 => {url => "" . $httpd{'4'}->endpoint()}, - defined($httpd{'6'}) ? (v6 => {url => "" . $httpd{'6'}->endpoint()}) : (), + v4 => {url => "" . httpd('4')->endpoint()}, + defined(httpd('6')) ? (v6 => {url => "" . httpd('6')->endpoint()}) : (), ); +# Sentinel value used by `mergecfg` that means "this hash entry should be deleted if it exists." +my $DOES_NOT_EXIST = []; + +sub mergecfg { + my %ret; + for my $cfg (@_) { + next if !defined($cfg); + for my $h (keys(%$cfg)) { + if (refaddr($cfg->{$h}) == refaddr($DOES_NOT_EXIST)) { + delete($ret{$h}); + next; + } + $ret{$h} = {%{$ret{$h} // {}}, %{$cfg->{$h}}}; + for my $k (keys(%{$ret{$h}})) { + my $a = refaddr($ret{$h}{$k}); + delete($ret{$h}{$k}) if defined($a) && $a == refaddr($DOES_NOT_EXIST); + } + } + } + return \%ret; +} + local $ddclient::globals{debug} = 1; local $ddclient::globals{verbose} = 1; local $ddclient::now = 1000; @@ -51,10 +53,10 @@ sub run_httpd { update => sub { my $self = shift; ddclient::debug('in update'); + push(@updates, [@_]); for my $h (@_) { local $ddclient::_l = ddclient::pushlogctx($h); ddclient::debug('updating host'); - push(@updates, [@_]); $ddclient::recap{$h}{status} = 'good'; $ddclient::recap{$h}{ip} = delete($ddclient::config{$h}{wantip}); $ddclient::recap{$h}{mtime} = $ddclient::now; @@ -70,82 +72,88 @@ sub run_httpd { my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); { desc => "legacy, fresh, $desc", - cfg => { + cfg => {host => { 'protocol' => 'legacy', %cfg, - }, - want_update => 1, - want_recap_changes => { + }}, + want_reqs_webv4 => 1, + want_updates => [['host']], + want_recap_changes => {host => { 'atime' => $ddclient::now, 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now, 'status-ipv4' => 'good', - }, + }}, %$_, }; } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), { desc => 'legacy, fresh, use=web (IPv6)', ipv6 => 1, - cfg => { + cfg => {host => { 'protocol' => 'legacy', 'use' => 'web', 'web' => 'v6', - }, - want_update => 1, - want_recap_changes => { + }}, + want_reqs_webv6 => 1, + want_updates => [['host']], + want_recap_changes => {host => { 'atime' => $ddclient::now, 'ipv6' => '2001:db8::1', 'mtime' => $ddclient::now, 'status-ipv6' => 'good', - }, + }}, }, { desc => 'legacy, fresh, usev6=webv6', ipv6 => 1, - cfg => { + cfg => {host => { 'protocol' => 'legacy', 'usev6' => 'webv6', - }, - want_update => 1, - want_recap_changes => { + }}, + want_reqs_webv6 => 1, + want_updates => [['host']], + want_recap_changes => {host => { 'atime' => $ddclient::now, 'ipv6' => '2001:db8::1', 'mtime' => $ddclient::now, 'status-ipv6' => 'good', - }, + }}, }, { desc => 'legacy, fresh, usev4=webv4 usev6=webv6', ipv6 => 1, - cfg => { + cfg => {host => { 'protocol' => 'legacy', 'usev4' => 'webv4', 'usev6' => 'webv6', - }, - want_update => 1, - want_recap_changes => { + }}, + want_reqs_webv4 => 1, + want_reqs_webv6 => 1, + want_updates => [['host']], + want_recap_changes => {host => { 'atime' => $ddclient::now, 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now, 'status-ipv4' => 'good', - }, + }}, }, map({ my %cfg = %{delete($_->{cfg})}; my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); { desc => "legacy, no change, not yet time, $desc", - recap => { + recap => {host => { 'atime' => $ddclient::now - ddclient::opt('min-interval'), 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now - ddclient::opt('min-interval'), 'status-ipv4' => 'good', - }, - cfg => { + }}, + cfg => {host => { 'protocol' => 'legacy', %cfg, - }, + }}, + want_reqs_webv4 => 1, %$_, }; } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), @@ -154,16 +162,17 @@ sub run_httpd { my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); { desc => "legacy, min-interval elapsed but no change, $desc", - recap => { + recap => {host => { 'atime' => $ddclient::now - ddclient::opt('min-interval') - 1, 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now - ddclient::opt('min-interval') - 1, 'status-ipv4' => 'good', - }, - cfg => { + }}, + cfg => {host => { 'protocol' => 'legacy', %cfg, - }, + }}, + want_reqs_webv4 => 1, %$_, }; } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), @@ -172,19 +181,20 @@ sub run_httpd { my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); { desc => "legacy, needs update, not yet time, $desc", - recap => { + recap => {host => { 'atime' => $ddclient::now - ddclient::opt('min-interval'), 'ipv4' => '192.0.2.2', 'mtime' => $ddclient::now - ddclient::opt('min-interval'), 'status-ipv4' => 'good', - }, - cfg => { + }}, + cfg => {host => { 'protocol' => 'legacy', %cfg, - }, - want_recap_changes => { + }}, + want_reqs_webv4 => 1, + want_recap_changes => {host => { 'warned-min-interval' => $ddclient::now, - }, + }}, %$_, }; } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), @@ -193,22 +203,23 @@ sub run_httpd { my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); { desc => "legacy, min-interval elapsed, needs update, $desc", - recap => { + recap => {host => { 'atime' => $ddclient::now - ddclient::opt('min-interval') - 1, 'ipv4' => '192.0.2.2', 'mtime' => $ddclient::now - ddclient::opt('min-interval') - 1, 'status-ipv4' => 'good', - }, - cfg => { + }}, + cfg => {host => { 'protocol' => 'legacy', %cfg, - }, - want_update => 1, - want_recap_changes => { + }}, + want_reqs_webv4 => 1, + want_updates => [['host']], + want_recap_changes => {host => { 'atime' => $ddclient::now, 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now, - }, + }}, %$_, }; } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), @@ -217,20 +228,21 @@ sub run_httpd { my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); { desc => "legacy, previous failed update, not yet time to retry, $desc", - recap => { + recap => {host => { 'atime' => $ddclient::now - ddclient::opt('min-error-interval'), 'ipv4' => '192.0.2.2', 'mtime' => $ddclient::now - max(ddclient::opt('min-error-interval'), ddclient::opt('min-interval')) - 1, 'status-ipv4' => 'failed', - }, - cfg => { + }}, + cfg => {host => { 'protocol' => 'legacy', %cfg, - }, - want_recap_changes => { + }}, + want_reqs_webv4 => 1, + want_recap_changes => {host => { 'warned-min-error-interval' => $ddclient::now, - }, + }}, %$_, }; } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), @@ -239,23 +251,24 @@ sub run_httpd { my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); { desc => "legacy, previous failed update, time to retry, $desc", - recap => { + recap => {host => { 'atime' => $ddclient::now - ddclient::opt('min-error-interval') - 1, 'ipv4' => '192.0.2.2', 'mtime' => $ddclient::now - ddclient::opt('min-error-interval') - 2, 'status-ipv4' => 'failed', - }, - cfg => { + }}, + cfg => {host => { 'protocol' => 'legacy', %cfg, - }, - want_update => 1, - want_recap_changes => { + }}, + want_reqs_webv4 => 1, + want_updates => [['host']], + want_recap_changes => {host => { 'atime' => $ddclient::now, 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now, 'status-ipv4' => 'good', - }, + }}, %$_, }; } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), @@ -264,46 +277,60 @@ sub run_httpd { for my $tc (@test_cases) { 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; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc->{ipv6} && !$httpd_ipv6_supported; subtest($tc->{desc} => sub { local $ddclient::_l = ddclient::pushlogctx($tc->{desc}); - # Copy %{$tc->{recap}} so that updates to $recap{$h} don't update %{$tc->{recap}}. - local %ddclient::recap = (host => {%{$tc->{recap} // {}}}); + for my $ipv ('4', '6') { + $tc->{"want_reqs_webv$ipv"} //= 0; + my $want = $tc->{"want_reqs_webv$ipv"}; + next if !defined(httpd($ipv)) && $want == 0; + local $ddclient::_l = ddclient::pushlogctx("IPv$ipv"); + my $ip = $ipv eq '4' ? '192.0.2.1' : '2001:db8::1'; + httpd($ipv)->reset(([200, $textplain, [$ip]]) x $want); + } + $tc->{recap}{$_}{host} //= $_ for keys(%{$tc->{recap} // {}}); + # Deep copy `%{$tc->{recap}}` so that updates to `%ddclient::recap` don't mutate it. + local %ddclient::recap = %{mergecfg($tc->{recap})}; my $cachef = File::Temp->new(); # $cachef is an object that stringifies to a filename. local $ddclient::globals{cache} = "$cachef"; - my %cfg = ( - web => 'v4', - webv4 => 'v4', - webv6 => 'v6', - %{$tc->{cfg} // {}}, - ); - # Copy %cfg so that updates to $config{$h} don't update %cfg. - local %ddclient::config = (host => {%cfg}); + $tc->{cfg} = {map({ + ($_ => { + host => $_, + web => 'v4', + webv4 => 'v4', + webv6 => 'v6', + %{$tc->{cfg}{$_}}, + }); + } keys(%{$tc->{cfg} // {}}))}; + # Deep copy `%{$tc->{cfg}}` so that updates to `%ddclient::config` don't mutate it. + local %ddclient::config = %{mergecfg($tc->{cfg})}; local @updates; ddclient::update_nics(); + for my $ipv ('4', '6') { + next if !defined(httpd($ipv)); + local $ddclient::_l = ddclient::pushlogctx("IPv$ipv"); + my @gotreqs = httpd($ipv)->reset(); + my $got = @gotreqs; + my $want = $tc->{"want_reqs_webv$ipv"}; + is($got, $want, "number of requests to webv$ipv service"); + } TODO: { - local $TODO = $tc->{want_update_TODO}; - is_deeply(\@updates, [(['host']) x ($tc->{want_update} ? 1 : 0)], - 'got expected update'); + local $TODO = $tc->{want_updates_TODO}; + is_deeply(\@updates, $tc->{want_updates} // [], 'got expected updates') + or diag(ddclient::repr(Values => [\@updates, $tc->{want_updates}], + Names => ['*got', '*want'])); } - my %want_recap = (host => { - %{$tc->{recap} // {}}, - %{$tc->{want_recap_changes} // {}}, - }); + my %want_recap = %{mergecfg($tc->{recap}, $tc->{want_recap_changes})}; TODO: { local $TODO = $tc->{want_recap_changes_TODO}; is_deeply(\%ddclient::recap, \%want_recap, 'recap matches') or diag(ddclient::repr(Values => [\%ddclient::recap, \%want_recap], Names => ['*got', '*want'])); } - my %want_cfg = (host => { - %cfg, - %{$tc->{want_cfg_changes} // {}}, - }); + my %want_cfg = %{mergecfg($tc->{cfg}, $tc->{want_cfg_changes})}; TODO: { local $TODO = $tc->{want_cfg_changes_TODO}; is_deeply(\%ddclient::config, \%want_cfg, 'config matches') diff --git a/t/use_web.pl b/t/use_web.pl index e9a9771e..139f492a 100644 --- a/t/use_web.pl +++ b/t/use_web.pl @@ -1,51 +1,27 @@ use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } 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); -}; +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); +} +use ddclient::t::ip; 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 $headers = [ + @$textplain, + 'this-ipv4-should-be-ignored' => 'skip skip2 192.0.2.255', + 'this-ipv6-should-be-ignored' => 'skip skip2 2001:db8::ff', +]; +httpd('4')->run(sub { return [200, $headers, ['192.0.2.1 skip 192.0.2.2 skip2 192.0.2.3']]; }); +httpd('6')->run(sub { return [200, $headers, ['2001:db8::1 skip 2001:db8::2 skip2 2001:db8::3']]; }) + if httpd('6'); my %ep = ( - '4' => $httpd{'4'}->endpoint(), - '6' => $httpd{'6'} ? $httpd{'6'}->endpoint() : undef, + '4' => httpd('4')->endpoint(), + '6' => httpd('6') ? httpd('6')->endpoint() : undef, ); my @test_cases; @@ -110,8 +86,7 @@ sub run_httpd { $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; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc->{ipv6} && !$httpd_ipv6_supported; 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}) diff --git a/t/variable_defaults.pl b/t/variable_defaults.pl index c0e8320a..8f2495d5 100644 --- a/t/variable_defaults.pl +++ b/t/variable_defaults.pl @@ -1,7 +1,7 @@ use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } use re qw(is_regexp); -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); my %variable_collections = ( map({ ($_ => $ddclient::cfgvars{$_}) } grep($_ ne 'merged', keys(%ddclient::cfgvars))),