diff --git a/Makefile.am b/Makefile.am index d80050f..13367ad 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 diff --git a/configure.ac b/configure.ac index fa0c856..7f1c580 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 463661b..ae9ab9e 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/geturl_connectivity.pl b/t/geturl_connectivity.pl index db9258a..b0dd94d 100644 --- a/t/geturl_connectivity.pl +++ b/t/geturl_connectivity.pl @@ -1,43 +1,22 @@ 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 $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"; - -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; +BEGIN { + eval { require ddclient::t::HTTPD; 1; } or plan(skip_all => $@); + ddclient::t::HTTPD->import(); } +use ddclient::t::ip; -my %httpd = ( - '4' => {'http' => run_httpd(0, 0), 'https' => run_httpd(0, 1)}, - '6' => {'http' => run_httpd(1, 0), 'https' => run_httpd(1, 1)}, -); +$ddclient::globals{'ssl_ca_file'} = $ca_file; + +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 @test_cases = ( {ipv6_opt => 0, server_ipv => '4', client_ipv => ''}, @@ -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}; diff --git a/t/lib/ddclient/t/HTTPD.pm b/t/lib/ddclient/t/HTTPD.pm new file mode 100644 index 0000000..f9a5f1a --- /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/protocol_directnic.pl b/t/protocol_directnic.pl index ed13667..30be5d5 100644 --- a/t/protocol_directnic.pl +++ b/t/protocol_directnic.pl @@ -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', diff --git a/t/protocol_dnsexit2.pl b/t/protocol_dnsexit2.pl index f145ba3..0586276 100644 --- a/t/protocol_dnsexit2.pl +++ b/t/protocol_dnsexit2.pl @@ -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(); diff --git a/t/protocol_dyndns2.pl b/t/protocol_dyndns2.pl index 4635012..682be57 100644 --- a/t/protocol_dyndns2.pl +++ b/t/protocol_dyndns2.pl @@ -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'])); diff --git a/t/skip.pl b/t/skip.pl index 536cfd1..ba5dac9 100644 --- a/t/skip.pl +++ b/t/skip.pl @@ -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, }, diff --git a/t/ssl-validate.pl b/t/ssl-validate.pl index 19db0e9..36e510a 100644 --- a/t/ssl-validate.pl +++ b/t/ssl-validate.pl @@ -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}) diff --git a/t/update_nics.pl b/t/update_nics.pl index 1e98bc9..913b775 100644 --- a/t/update_nics.pl +++ b/t/update_nics.pl @@ -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"); diff --git a/t/use_web.pl b/t/use_web.pl index bc9f420..139f492 100644 --- a/t/use_web.pl +++ b/t/use_web.pl @@ -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', - '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; @@ -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})