Fabio/ddclient
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

tests: Factor out duplicate HTTP server code

Browse source
This commit is contained in:
Richard Hansen 2024-09-05 19:01:21 -04:00
parent 62f3759c54
commit 5ed43a2e4c
12 changed files with 257 additions and 274 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

@ -162,5 +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

1
configure.ac
View file

@ -95,7 +95,6 @@ m4_foreach_w([_m], [
HTTP::Request
HTTP::Response
JSON::PP
LWP::UserAgent
Test::MockModule
Test::TCP
Test::Warnings

3
ddclient.in
View file

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

45
t/geturl_connectivity.pl
View file

@ -1,44 +1,23 @@
use Test::More;
BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } }
BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); }
BEGIN { eval { require ddclient::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
BEGIN {
eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@);
ddclient::t::HTTPD->import();
}
use ddclient::t::ip;
my $has_http_daemon_ssl = eval { require HTTP::Daemon::SSL; 1; };
my $http_daemon_supports_ipv6 = eval {
require HTTP::Daemon;
HTTP::Daemon->VERSION(6.12);
};
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,
},
);
for my $ipv ('4', '6') {
for my $ssl (0, 1) {
my $httpd = httpd($ipv, $ssl) or next;
$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;
}
}
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'},
@ -65,9 +44,9 @@ for my $tc (@test_cases) {
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};

135
t/lib/ddclient/t/HTTPD.pm Normal file
View file

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

11
t/protocol_directnic.pl
View file

@ -2,12 +2,14 @@ use Test::More;
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::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
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());
@ -27,7 +29,6 @@ $httpd->run(sub {
}
return [400, $headers, ['unexpected request: ' . $req->uri()]]
});
diag("started IPv4 HTTP server running at " . $httpd->endpoint());
{
package Logger;
@ -46,7 +47,7 @@ diag("started IPv4 HTTP server running at " . $httpd->endpoint());
}
}
my $hostname = $httpd->endpoint();
my $hostname = httpd()->endpoint();
my @test_cases = (
{
desc => 'IPv4, good',

74
t/protocol_dnsexit2.pl
View file

@ -1,42 +1,25 @@
use Test::More;
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 LWP::UserAgent; 1; } or plan(skip_all => $@); }
BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); }
BEGIN { eval { require ddclient::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
BEGIN {
eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@);
ddclient::t::HTTPD->import();
}
ddclient::load_json_support('dnsexit2');
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 decode_and_sort_array {
my ($data) = @_;
if (!ref $data) {
@ -46,18 +29,8 @@ 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;
}
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 {
httpd()->reset();
local %ddclient::config = (
'host.my.example.com' => {
'usev4' => 'ipv4',
@ -67,19 +40,19 @@ subtest 'Testing nic_dnsexit2_update' => sub {
'protocol' => 'dnsexit2',
'password' => 'mytestingpassword',
'zone' => 'my.example.com',
'server' => $httpd->endpoint(),
'server' => httpd()->endpoint(),
'path' => '/update',
'ttl' => 5
});
ddclient::nic_dnsexit2_update(undef, 'host.my.example.com');
my @requests = get_requests();
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}, '/update', 'URI contains correct path');
like($req->{headers}, qr/Content-Type: application\/json/, 'Content-Type header is correct');
like($req->{headers}, qr/Accept: application\/json/, 'Accept header is correct');
my $got = decode_and_sort_array($req->{content});
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',
@ -99,25 +72,25 @@ subtest 'Testing nic_dnsexit2_update' => sub {
]
});
is_deeply($got, $want, 'Data is correct');
reset_test_data();
};
subtest 'Testing nic_dnsexit2_update without a zone set' => sub {
httpd()->reset();
local %ddclient::config = (
'myhost.example.com' => {
'usev4' => 'ipv4',
'wantipv4' => '192.0.2.1',
'protocol' => 'dnsexit2',
'password' => 'anotherpassword',
'server' => $httpd->endpoint(),
'server' => httpd()->endpoint(),
'path' => '/update-alt',
'ttl' => 10
});
ddclient::nic_dnsexit2_update(undef, 'myhost.example.com');
my @requests = get_requests();
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 $got = decode_and_sort_array($req->content());
my $want = decode_and_sort_array({
'domain' => 'myhost.example.com',
'apikey' => 'anotherpassword',
@ -131,17 +104,17 @@ subtest 'Testing nic_dnsexit2_update without a zone set' => sub {
]
});
is_deeply($got, $want, 'Data is correct');
reset_test_data($ua);
};
subtest 'Testing nic_dnsexit2_update with two hostnames, one with a zone and one without' => sub {
httpd()->reset();
local %ddclient::config = (
'host1.example.com' => {
'usev4' => 'ipv4',
'wantipv4' => '192.0.2.1',
'protocol' => 'dnsexit2',
'password' => 'testingpassword',
'server' => $httpd->endpoint(),
'server' => httpd()->endpoint(),
'path' => '/update',
'ttl' => 5
},
@ -150,15 +123,15 @@ subtest 'Testing nic_dnsexit2_update with two hostnames, one with a zone and one
'wantipv6' => '2001:db8::1',
'protocol' => 'dnsexit2',
'password' => 'testingpassword',
'server' => $httpd->endpoint(),
'server' => httpd()->endpoint(),
'path' => '/update',
'ttl' => 10,
'zone' => 'example.com'
}
);
ddclient::nic_dnsexit2_update(undef, 'host1.example.com', 'host2.example.com');
my @requests = get_requests();
my @got = map(decode_and_sort_array($_->{content}), @requests);
my @requests = httpd()->reset();
my @got = map(decode_and_sort_array($_->content()), @requests);
my @want = (
decode_and_sort_array({
'domain' => 'host1.example.com',
@ -182,7 +155,6 @@ subtest 'Testing nic_dnsexit2_update with two hostnames, one with a zone and one
}),
);
is_deeply(\@got, \@want, 'data is correct');
reset_test_data();
};
done_testing();

32
t/protocol_dyndns2.pl
View file

@ -3,24 +3,22 @@ BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } }
use MIME::Base64;
use Scalar::Util qw(blessed);
BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); }
BEGIN { eval { require ddclient::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
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;
@ -256,18 +254,20 @@ for my $tc (@test_cases) {
$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']));

52
t/skip.pl
View file

@ -1,40 +1,25 @@
use Test::More;
BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } }
BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); }
BEGIN { eval { require ddclient::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
use ddclient::t::ip;
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 {
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"
@ -42,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"
@ -119,7 +103,7 @@ subtest "use='$builtinfw'" => sub {
run_test_case(
desc => "fw-skip='' cancels built-in skip",
cfg => {
'fw' => $httpd{'4'}->endpoint(),
'fw' => httpd('4')->endpoint(),
'fw-skip' => '',
'use' => $builtinfw,
},
@ -128,7 +112,7 @@ subtest "use='$builtinfw'" => sub {
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,
},
@ -139,7 +123,7 @@ subtest "usev4='$builtinfw'" => sub {
run_test_case(
desc => "fwv4-skip='' cancels built-in skip",
cfg => {
'fwv4' => $httpd{'4'}->endpoint(),
'fwv4' => httpd('4')->endpoint(),
'fwv4-skip' => '',
'usev4' => $builtinfw,
},
@ -148,7 +132,7 @@ subtest "usev4='$builtinfw'" => sub {
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,
},

45
t/ssl-validate.pl
View file

@ -1,45 +1,23 @@
use Test::More;
BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } }
BEGIN { eval { require HTTP::Daemon::SSL; 1; } or plan(skip_all => $@); }
BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); }
BEGIN { eval { require ddclient::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
BEGIN {
eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@);
ddclient::t::HTTPD->import();
}
use ddclient::t::ip;
my $http_daemon_supports_ipv6 = eval {
require HTTP::Daemon;
HTTP::Daemon->VERSION(6.12);
};
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 = (
@ -94,8 +72,7 @@ my @test_cases = (
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})

75
t/update_nics.pl
View file

@ -6,54 +6,17 @@ BEGIN { eval { require JSON::PP; 1; } or plan(skip_all => $@); JSON::PP->import(
use List::Util qw(max);
use Scalar::Util qw(refaddr);
BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); }
BEGIN { eval { require ddclient::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
use ddclient::t::ip;
my $http_daemon_supports_ipv6 = eval {
require HTTP::Daemon;
HTTP::Daemon->VERSION(6.12);
};
my @httpd_requests; # Log of received requests.
my @httpd_responses; # Script of responses to play back.
my $textplain = ['content-type' => 'text/plain; charset=utf-8'];
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 {
my ($req) = @_;
if ($req->uri()->path() eq '/control') {
if ($req->method() eq 'PUT') {
return [400, $textplain, ['content must be json']]
if $req->headers()->content_type() ne 'application/json';
eval { @httpd_responses = @{decode_json($req->content())}; 1; }
or return [400, $textplain, ['content is not valid json']];
@httpd_requests = ();
return [200, $textplain, []];
} elsif ($req->method() eq 'GET') {
my @reqs = map($_->as_string(), @httpd_requests);
return [200, ['content-type' => 'application/json'], [encode_json(\@reqs)]];
} else {
return [405, $textplain, ['unsupported method: ' . $req->method()]];
}
}
push(@httpd_requests, $req);
return shift(@httpd_responses) // [500, $textplain, ['ran out of scripted responses']];
});
diag("started IPv$ipv HTTP server running at " . $httpd->endpoint());
return $httpd;
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."
@ -314,22 +277,16 @@ my @test_cases = (
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});
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;
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';
ddclient::header_ok(ddclient::geturl(
url => $httpd{$ipv}->endpoint() . '/control',
method => 'PUT',
headers => ['content-type: application/json'],
data => encode_json([([200, $textplain, [$ip]]) x $want]),
)) or BAIL_OUT('failed to prepare the test http server');
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.
@ -353,13 +310,9 @@ for my $tc (@test_cases) {
ddclient::update_nics();
for my $ipv ('4', '6') {
next if !defined($httpd{$ipv});
next if !defined(httpd($ipv));
local $ddclient::_l = ddclient::pushlogctx("IPv$ipv");
my $gotreqs = ddclient::geturl(url => $httpd{$ipv}->endpoint() . '/control');
ddclient::header_ok($gotreqs)
or BAIL_OUT("failed to get log of IPv$ipv http requests");
$gotreqs =~ s/^.*?\n\n//s;
my @gotreqs = map(HTTP::Request->parse($_), @{decode_json($gotreqs)});
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");

43
t/use_web.pl
View file

@ -2,42 +2,26 @@ use Test::More;
BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } }
use Scalar::Util qw(blessed);
BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); }
BEGIN { eval { require ddclient::Test::Fake::HTTPD; 1; } or plan(skip_all => $@); }
BEGIN {
eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@);
ddclient::t::HTTPD->import();
}
use ddclient::t::ip;
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',
my $headers = [
@$textplain,
'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'),
);
];
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;
@ -102,8 +86,7 @@ for my $tc (@test_cases) {
$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})