Require curl
Use command-line curl, and remove alternative Perl and Curl-via-Perl implementations of network code.
This commit is contained in:
Reuben Thomas
parent
211404b5d1
commit
a9c1e545fb
8 changed files with 45 additions and 596 deletions
26
.github/workflows/ci.yml
vendored
26
.github/workflows/ci.yml
vendored
|
|
@ -9,7 +9,7 @@ jobs:
|
|||
matrix:
|
||||
image:
|
||||
- ubuntu:latest
|
||||
- ubuntu:16.04
|
||||
- ubuntu:20.04
|
||||
- debian:testing
|
||||
- debian:stable
|
||||
- debian:oldstable
|
||||
|
|
@ -24,6 +24,7 @@ jobs:
|
|||
automake \
|
||||
ca-certificates \
|
||||
git \
|
||||
curl \
|
||||
libhttp-daemon-perl \
|
||||
libhttp-daemon-ssl-perl \
|
||||
libio-socket-inet6-perl \
|
||||
|
|
@ -48,28 +49,6 @@ jobs:
|
|||
- name: distribution tarball is complete
|
||||
run: ./.github/workflows/scripts/dist-tarball-check
|
||||
|
||||
#test-centos6:
|
||||
# runs-on: ubuntu-latest
|
||||
# container: centos:6
|
||||
# steps:
|
||||
# - uses: actions/checkout@v1
|
||||
# - name: install dependencies
|
||||
# run: |
|
||||
# yum install -y \
|
||||
# automake \
|
||||
# perl-IO-Socket-INET6 \
|
||||
# perl-core \
|
||||
# perl-libwww-perl \
|
||||
# ;
|
||||
# - name: autogen
|
||||
# run: ./autogen
|
||||
# - name: configure
|
||||
# run: ./configure
|
||||
# - name: check
|
||||
# run: make VERBOSE=1 AM_COLOR_TESTS=always check
|
||||
# - name: distcheck
|
||||
# run: make VERBOSE=1 AM_COLOR_TESTS=always distcheck
|
||||
|
||||
#test-centos8:
|
||||
# runs-on: ubuntu-latest
|
||||
# container: centos:8
|
||||
|
|
@ -105,6 +84,7 @@ jobs:
|
|||
automake \
|
||||
findutils \
|
||||
make \
|
||||
curl \
|
||||
perl \
|
||||
perl-HTTP-Daemon \
|
||||
perl-HTTP-Daemon-SSL \
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ repository history](https://github.com/ddclient/ddclient/commits/master).
|
|||
|
||||
### Breaking changes
|
||||
|
||||
* ddclient now requires curl.
|
||||
* ddclient no longer ships any example files for init systems that use `/etc/init.d`.
|
||||
This was done because those files where effectively unmaintained, untested by the developers and only updated by downstream distros.
|
||||
If you where relying on those files, please copy them into your packaging.
|
||||
|
|
@ -23,7 +24,7 @@ repository history](https://github.com/ddclient/ddclient/commits/master).
|
|||
|
||||
### Bug fixes
|
||||
|
||||
* DynDNS2 now uses the newer ipv4/ipv6 syntax's
|
||||
* DynDNS2 now uses the newer ipv4/ipv6 syntaxes
|
||||
* The OVH provider now ignores extra data returned
|
||||
* Allow to define usev4 and usev6 options per hostname
|
||||
* Merge multiple configs for the same hostname instead of use the last
|
||||
|
|
|
|||
|
|
@ -63,7 +63,6 @@ AM_PL_LOG_FLAGS = -Mstrict -w \
|
|||
-MDevel::Autoflush
|
||||
handwritten_tests = \
|
||||
t/get_ip_from_if.pl \
|
||||
t/geturl_ssl.pl \
|
||||
t/is-and-extract-ipv4.pl \
|
||||
t/is-and-extract-ipv6.pl \
|
||||
t/is-and-extract-ipv6-global.pl \
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
# DDCLIENT
|
||||
|
||||
`ddclient` is a Perl client used to update dynamic DNS entries for accounts
|
||||
on many dynamic DNS services.
|
||||
on many dynamic DNS services. It uses `curl` for internet access.
|
||||
|
||||
This is a friendly fork/continuation of https://github.com/ddclient/ddclient
|
||||
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@ AC_PATH_PROG([FIND], [find])
|
|||
AS_IF([test -z "${FIND}"], [AC_MSG_ERROR(['find' utility not found])])
|
||||
|
||||
AC_PATH_PROG([CURL], [curl])
|
||||
AS_IF([test -z "${CURL}"], [AC_MSG_ERROR([curl not found])])
|
||||
|
||||
AX_WITH_PROG([PERL], perl)
|
||||
AX_PROG_PERL_VERSION([5.10.1], [],
|
||||
|
|
|
|||
303
ddclient.in
303
ddclient.in
|
|
@ -17,8 +17,6 @@ use File::Basename;
|
|||
use File::Path qw(make_path);
|
||||
use File::Temp;
|
||||
use Getopt::Long;
|
||||
use IO::Socket::IP;
|
||||
use Socket qw(AF_INET AF_INET6 PF_INET PF_INET6);
|
||||
use Sys::Hostname;
|
||||
|
||||
use version 0.77; our $VERSION = version->declare('@PACKAGE_VERSION@');
|
||||
|
|
@ -454,7 +452,6 @@ my %variables = (
|
|||
'retry' => setv(T_BOOL, 0, 0, 0, undef),
|
||||
'force' => setv(T_BOOL, 0, 0, 0, undef),
|
||||
'ssl' => setv(T_BOOL, 0, 0, 0, undef),
|
||||
'curl' => setv(T_BOOL, 0, 0, 0, undef),
|
||||
'syslog' => setv(T_BOOL, 0, 0, 0, undef),
|
||||
'facility' => setv(T_STRING,0, 0, 'daemon', undef),
|
||||
'priority' => setv(T_STRING,0, 0, 'notice', undef),
|
||||
|
|
@ -1090,7 +1087,6 @@ my @opt = (
|
|||
["ssl_ca_file", "=s", "-ssl_ca_file <file> : look at <file> for certificates of trusted certificate authorities (default: auto-detect)"],
|
||||
["fw-ssl-validate", "!", "-{no}fw-ssl-validate : Validate SSL certificate when retrieving IP address from firewall"],
|
||||
["web-ssl-validate", "!","-{no}web-ssl-validate : Validate SSL certificate when retrieving IP address from web"],
|
||||
["curl", "!", "-{no}curl : use curl for network connections"],
|
||||
["retry", "!", "-{no}retry : retry failed updates"],
|
||||
["force", "!", "-{no}force : force an update even if the update may be unnecessary"],
|
||||
["timeout", "=i", "-timeout <max> : when fetching a URL, wait at most <max> seconds for a response"],
|
||||
|
|
@ -2460,22 +2456,6 @@ sub encode_base64 ($;$) {
|
|||
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
|
||||
$res;
|
||||
}
|
||||
######################################################################
|
||||
## load_ssl_support
|
||||
######################################################################
|
||||
sub load_ssl_support {
|
||||
my $ssl_loaded = eval { require IO::Socket::SSL };
|
||||
unless ($ssl_loaded) {
|
||||
fatal("%s", <<"EOM");
|
||||
Error loading the Perl module IO::Socket::SSL needed for SSL connect.
|
||||
On Debian, the package libio-socket-ssl-perl must be installed.
|
||||
On Red Hat, the package perl-IO-Socket-SSL must be installed.
|
||||
On Alpine, the package perl-io-socket-ssl must be installed.
|
||||
EOM
|
||||
}
|
||||
import IO::Socket::SSL;
|
||||
{ no warnings; $IO::Socket::SSL::DEBUG = 0; }
|
||||
}
|
||||
|
||||
######################################################################
|
||||
## load_sha1_support
|
||||
|
|
@ -2510,180 +2490,6 @@ EOM
|
|||
import JSON::PP (qw/decode_json encode_json/);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
## geturl
|
||||
######################################################################
|
||||
sub geturl {
|
||||
return opt('curl') ? fetch_via_curl(@_) : fetch_via_socket_io(@_);
|
||||
}
|
||||
|
||||
sub fetch_via_socket_io {
|
||||
my %params = @_;
|
||||
my $proxy = $params{proxy};
|
||||
my $url = $params{url};
|
||||
my $login = $params{login};
|
||||
my $password = $params{password};
|
||||
my $ipversion = $params{ipversion} // '';
|
||||
my $headers = $params{headers} // '';
|
||||
my $method = $params{method} // 'GET';
|
||||
my $data = $params{data} // '';
|
||||
my ($peer, $server, $port, $default_port, $use_ssl);
|
||||
my ($sd, $request, $reply);
|
||||
|
||||
## canonify proxy and url
|
||||
my $force_ssl;
|
||||
$force_ssl = 1 if ($url =~ /^https:/);
|
||||
$proxy =~ s%^https?://%%i if defined($proxy);
|
||||
$url =~ s%^https?://%%i;
|
||||
$server = $url;
|
||||
$server =~ s%[?/].*%%;
|
||||
$url =~ s%^[^?/]*/?%%;
|
||||
|
||||
if ($force_ssl || ($globals{'ssl'} && !($params{ignore_ssl_option} // 0))) {
|
||||
$use_ssl = 1;
|
||||
$default_port = '443';
|
||||
} else {
|
||||
$use_ssl = 0;
|
||||
$default_port = '80';
|
||||
}
|
||||
debug("proxy = %s", $proxy // '<undefined>');
|
||||
debug("protocol = %s", $use_ssl ? "https" : "http");
|
||||
debug("server = %s", $server);
|
||||
(my $_url = $url) =~ s%\?.*%?<redacted>%; #redact ALL parameters passed on URL, including possible passwords
|
||||
debug("url = %s", $_url);
|
||||
debug("ip ver = %s", $ipversion);
|
||||
|
||||
## determine peer and port to use.
|
||||
$peer = $proxy // $server;
|
||||
$peer =~ s%[?/].*%%;
|
||||
if ($peer =~ /^\[([^]]+)\](?::(\d+))?$/ || $peer =~ /^([^:]+)(?::(\d+))?/) {
|
||||
$peer = $1;
|
||||
$port = $2 // $default_port;
|
||||
} else {
|
||||
failed("unable to extract host and port from %s", $peer);
|
||||
return undef;
|
||||
}
|
||||
|
||||
$request = "$method ";
|
||||
if (!$use_ssl) {
|
||||
$request .= "http://$server" if defined($proxy);
|
||||
} else {
|
||||
$request .= "https://$server" if defined($proxy);
|
||||
}
|
||||
$request .= "/$url HTTP/1.1\n";
|
||||
$request .= "Host: $server\n";
|
||||
|
||||
if (defined($login) || defined($password)) {
|
||||
my $auth = encode_base64(($login // '') . ':' . ($password // ''), '');
|
||||
$request .= "Authorization: Basic $auth\n";
|
||||
}
|
||||
$request .= "User-Agent: ${program}/${version}\n";
|
||||
if ($data) {
|
||||
$request .= "Content-Type: application/x-www-form-urlencoded\n" if $headers !~ /^Content-Type:/mi;
|
||||
$request .= "Content-Length: " . length($data) . "\n";
|
||||
}
|
||||
$request .= "Connection: close\n";
|
||||
$headers .= "\n" if $headers ne '' && substr($headers, -1) ne "\n";
|
||||
$request .= $headers;
|
||||
$request .= "\n";
|
||||
# RFC 7230 says that all lines before the body must end with <cr><lf>.
|
||||
(my $rq = $request) =~ s/(?<!\r)\n/\r\n/g;
|
||||
$request .= $data;
|
||||
$rq .= $data;
|
||||
|
||||
my %socket_args = (
|
||||
PeerAddr => $peer,
|
||||
PeerPort => $port,
|
||||
Proto => 'tcp',
|
||||
Timeout => opt('timeout'),
|
||||
);
|
||||
my $socket_class = 'IO::Socket::IP';
|
||||
if ($use_ssl) {
|
||||
# IO::Socket::SSL will load IPv6 support if available on the system.
|
||||
load_ssl_support;
|
||||
$socket_class = 'IO::Socket::SSL';
|
||||
$socket_args{SSL_ca_file} = opt('ssl_ca_file') if defined(opt('ssl_ca_file'));
|
||||
$socket_args{SSL_ca_path} = opt('ssl_ca_dir') if defined(opt('ssl_ca_dir'));
|
||||
$socket_args{SSL_verify_mode} = ($params{ssl_validate} // 1)
|
||||
? IO::Socket::SSL->SSL_VERIFY_PEER
|
||||
: IO::Socket::SSL->SSL_VERIFY_NONE;
|
||||
}
|
||||
if (defined($params{_testonly_socket_class})) {
|
||||
$socket_args{original_socket_class} = $socket_class;
|
||||
$socket_class = $params{_testonly_socket_class};
|
||||
}
|
||||
if ($ipversion eq '4') {
|
||||
$socket_args{Domain} = PF_INET;
|
||||
$socket_args{Family} = AF_INET;
|
||||
} elsif ($ipversion eq '6') {
|
||||
$socket_args{Domain} = PF_INET6;
|
||||
$socket_args{Family} = AF_INET6;
|
||||
} elsif ($ipversion ne '') {
|
||||
fatal("geturl passed unsupported 'ipversion' value %s", $ipversion);
|
||||
}
|
||||
|
||||
my $ipv = $ipversion eq '' ? '' : sprintf(" (IPv%s)", $ipversion);
|
||||
my $peer_port_ipv = sprintf("%s:%s%s", $peer, $port, $ipv);
|
||||
my $to = sprintf("%s%s%s", $server, defined($proxy) ? " via proxy $peer:$port" : "", $ipv);
|
||||
verbose("CONNECT:", "%s", $to);
|
||||
$0 = sprintf("%s - connecting to %s", $program, $peer_port_ipv);
|
||||
if (opt('exec')) {
|
||||
$sd = $socket_class->new(%socket_args);
|
||||
defined($sd) or warning("cannot connect to %s socket: %s%s", $peer_port_ipv, $@,
|
||||
$use_ssl ? ' ' . IO::Socket::SSL::errstr() : '');
|
||||
} else {
|
||||
debug("skipped network connection");
|
||||
verbose("SENDING:", "%s", $request);
|
||||
}
|
||||
if (defined $sd) {
|
||||
## send the request to the http server
|
||||
verbose("CONNECTED: ", $use_ssl ? 'using SSL' : 'using HTTP');
|
||||
verbose("SENDING:", "%s", $request);
|
||||
|
||||
$0 = sprintf("%s - sending to %s", $program, $peer_port_ipv);
|
||||
my $result = syswrite $sd, $rq;
|
||||
if ($result != length($rq)) {
|
||||
warning("cannot send to %s (%s).", $peer_port_ipv, $!);
|
||||
} else {
|
||||
$0 = sprintf("%s - reading from %s", $program, $peer_port_ipv);
|
||||
eval {
|
||||
local $SIG{'ALRM'} = sub { die "timeout"; };
|
||||
alarm(opt('timeout')) if opt('timeout') > 0;
|
||||
while ($_ = <$sd>) {
|
||||
$0 = sprintf("%s - read from %s", $program, $peer_port_ipv);
|
||||
verbose("RECEIVE:", "%s", $_ // "<undefined>");
|
||||
$reply .= $_ // '';
|
||||
}
|
||||
if (opt('timeout') > 0) {
|
||||
alarm(0);
|
||||
}
|
||||
};
|
||||
close($sd);
|
||||
|
||||
if ($@ and $@ =~ /timeout/) {
|
||||
warning("TIMEOUT: %s after %s seconds", $to, opt('timeout'));
|
||||
$reply = '';
|
||||
}
|
||||
$reply //= '';
|
||||
}
|
||||
}
|
||||
$0 = sprintf("%s - closed %s", $program, $peer_port_ipv);
|
||||
|
||||
## during testing simulate reading the URL
|
||||
if (opt('test')) {
|
||||
my $filename = "$server/$url";
|
||||
$filename =~ s|/|%2F|g;
|
||||
if (opt('exec')) {
|
||||
$reply = save_file("$savedir/$filename", $reply, 'unique');
|
||||
} else {
|
||||
$reply = load_file("$savedir/$filename");
|
||||
}
|
||||
}
|
||||
|
||||
$reply =~ s/\r//g if defined $reply;
|
||||
return $reply;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
## curl_cmd() function to execute system curl command
|
||||
######################################################################
|
||||
|
|
@ -2753,10 +2559,7 @@ sub escape_curl_param {
|
|||
return $str;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
## fetch_via_curl() is used for geturl() when global curl option set
|
||||
######################################################################
|
||||
sub fetch_via_curl {
|
||||
sub geturl {
|
||||
my %params = @_;
|
||||
my $proxy = $params{proxy};
|
||||
my $url = $params{url};
|
||||
|
|
@ -2799,89 +2602,35 @@ sub fetch_via_curl {
|
|||
debug("skipped network connection");
|
||||
verbose("SENDING:", "%s", "${server}/${url}");
|
||||
} else {
|
||||
my $curl_loaded = eval { require WWW::Curl::Easy };
|
||||
if ($curl_loaded) {
|
||||
# System has the WWW::Curl::Easy module so use that
|
||||
import WWW::Curl::Easy;
|
||||
my $curl = WWW::Curl::Easy->new;
|
||||
push(@curlopt, "silent");
|
||||
push(@curlopt, "include"); ## Include HTTP response for compatibility
|
||||
push(@curlopt, "insecure") if ($use_ssl && !($params{ssl_validate} // 1));
|
||||
push(@curlopt, "cacert=\"".escape_curl_param(opt('ssl_ca_file')).'"') if defined(opt('ssl_ca_file'));
|
||||
push(@curlopt, "capath=\"".escape_curl_param(opt('ssl_ca_dir')).'"') if defined(opt('ssl_ca_dir'));
|
||||
push(@curlopt, "ipv4") if ($ipversion == 4);
|
||||
push(@curlopt, "ipv6") if ($ipversion == 6);
|
||||
push(@curlopt, "user-agent=\"".escape_curl_param("${program}/${version}").'"');
|
||||
push(@curlopt, "connect-timeout=$timeout");
|
||||
push(@curlopt, "max-time=$timeout");
|
||||
push(@curlopt, "request=$method");
|
||||
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}").'"');
|
||||
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_HEADER, 1); ## Include HTTP response for compatibility
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_SSL_VERIFYPEER, ($params{ssl_validate} // 1) ? 1 : 0 );
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_SSL_VERIFYHOST, ($params{ssl_validate} // 1) ? 1 : 0 );
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_CAINFO, opt('ssl_ca_file')) if defined(opt('ssl_ca_file'));
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_CAPATH, opt('ssl_ca_dir')) if defined(opt('ssl_ca_dir'));
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_IPRESOLVE,
|
||||
($ipversion == 4) ? WWW::Curl::Easy->CURL_IPRESOLVE_V4 :
|
||||
($ipversion == 6) ? WWW::Curl::Easy->CURL_IPRESOLVE_V6 :
|
||||
WWW::Curl::Easy->CURL_IPRESOLVE_WHATEVER);
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_USERAGENT, "${program}/${version}");
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_CONNECTTIMEOUT, $timeout);
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_TIMEOUT, $timeout);
|
||||
# Each header line is added individually
|
||||
@header_lines = split('\n', $headers);
|
||||
$_ = "header=\"".escape_curl_param($_).'"' foreach (@header_lines);
|
||||
push(@curlopt, @header_lines);
|
||||
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_POST, 1) if ($method eq 'POST');
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_PUT, 1) if ($method eq 'PUT');
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_CUSTOMREQUEST, $method) if ($method ne 'GET'); ## for PATCH
|
||||
# Add in the data if any was provided (for POST/PATCH)
|
||||
push(@curlopt, "data=\"".escape_curl_param(${data}).'"') if ($data);
|
||||
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_USERPWD, "${login}:${password}") if (defined($login) && defined($password));
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_PROXY, "${protocol}://${proxy}") if defined($proxy);
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_URL, "${protocol}://${server}/${url}");
|
||||
# don't include ${url} as that might expose login credentials
|
||||
$0 = sprintf("%s - Curl system cmd sending to %s", $program, "${protocol}://${server}");
|
||||
verbose("SENDING:", "Curl system cmd to %s", "${protocol}://${server}");
|
||||
verbose("SENDING:", "%s", $_) foreach (@curlopt);
|
||||
|
||||
# Add header lines if any was provided
|
||||
if ($headers) {
|
||||
@header_lines = split('\n', $headers);
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_HTTPHEADER, \@header_lines);
|
||||
}
|
||||
# Add in the data if any was provided (for POST/PATCH)
|
||||
if (my $datalen = length($data)) {
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_POSTFIELDS, ${data});
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_POSTFIELDSIZE, $datalen);
|
||||
}
|
||||
$curl->setopt(WWW::Curl::Easy->CURLOPT_WRITEDATA,\$reply);
|
||||
|
||||
# don't include ${url} as that might expose login credentials
|
||||
$0 = sprintf("%s - WWW::Curl::Easy sending to %s", $program, "${protocol}://${server}");
|
||||
verbose("SENDING:", "WWW::Curl::Easy to %s", "${protocol}://${server}");
|
||||
verbose("SENDING:", "%s", $headers) if ($headers);
|
||||
verbose("SENDING:", "%s", $data) if ($data);
|
||||
|
||||
my $rc = $curl->perform;
|
||||
|
||||
if ($rc != 0) {
|
||||
warning("CURL error (%d) %s", $rc, $curl->strerror($rc));
|
||||
debug($curl->errbuf);
|
||||
}
|
||||
} else {
|
||||
# System does not have the WWW::Curl::Easy module so attempt with system Curl command
|
||||
push(@curlopt, "silent");
|
||||
push(@curlopt, "include"); ## Include HTTP response for compatibility
|
||||
push(@curlopt, "insecure") if ($use_ssl && !($params{ssl_validate} // 1));
|
||||
push(@curlopt, "cacert=\"".escape_curl_param(opt('ssl_ca_file')).'"') if defined(opt('ssl_ca_file'));
|
||||
push(@curlopt, "capath=\"".escape_curl_param(opt('ssl_ca_dir')).'"') if defined(opt('ssl_ca_dir'));
|
||||
push(@curlopt, "ipv4") if ($ipversion == 4);
|
||||
push(@curlopt, "ipv6") if ($ipversion == 6);
|
||||
push(@curlopt, "user-agent=\"".escape_curl_param("${program}/${version}").'"');
|
||||
push(@curlopt, "connect-timeout=$timeout");
|
||||
push(@curlopt, "max-time=$timeout");
|
||||
push(@curlopt, "request=$method");
|
||||
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}").'"');
|
||||
|
||||
# Each header line is added individually
|
||||
@header_lines = split('\n', $headers);
|
||||
$_ = "header=\"".escape_curl_param($_).'"' foreach (@header_lines);
|
||||
push(@curlopt, @header_lines);
|
||||
|
||||
# Add in the data if any was provided (for POST/PATCH)
|
||||
push(@curlopt, "data=\"".escape_curl_param(${data}).'"') if ($data);
|
||||
|
||||
# don't include ${url} as that might expose login credentials
|
||||
$0 = sprintf("%s - Curl system cmd sending to %s", $program, "${protocol}://${server}");
|
||||
verbose("SENDING:", "Curl system cmd to %s", "${protocol}://${server}");
|
||||
verbose("SENDING:", "%s", $_) foreach (@curlopt);
|
||||
|
||||
$reply = curl_cmd(@curlopt);
|
||||
}
|
||||
$reply = curl_cmd(@curlopt);
|
||||
verbose("RECEIVE:", "%s", $reply // "<undefined>");
|
||||
if (!$reply) {
|
||||
# don't include ${url} as that might expose login credentials
|
||||
|
|
|
|||
|
|
@ -12,7 +12,6 @@ my $ipv6_supported = eval {
|
|||
);
|
||||
defined($ipv6_socket);
|
||||
};
|
||||
my $has_curl = qx{ @CURL@ --version 2>/dev/null; } && $? == 0;
|
||||
|
||||
my $http_daemon_supports_ipv6 = eval {
|
||||
require HTTP::Daemon;
|
||||
|
|
@ -55,54 +54,37 @@ my %httpd = (
|
|||
);
|
||||
|
||||
my @test_cases = (
|
||||
# Fetch via IO::Socket::IP
|
||||
{ipv6_opt => 0, server_ipv => '4', client_ipv => ''},
|
||||
{ipv6_opt => 0, server_ipv => '4', client_ipv => '4'},
|
||||
# IPv* client to a non-SSL IPv6 server is not expected to work unless opt('ipv6') is true
|
||||
{ipv6_opt => 0, server_ipv => '6', client_ipv => '6'},
|
||||
|
||||
# Fetch via IO::Socket::IP
|
||||
{ipv6_opt => 1, server_ipv => '4', client_ipv => ''},
|
||||
{ipv6_opt => 1, server_ipv => '4', client_ipv => '4'},
|
||||
{ipv6_opt => 1, server_ipv => '6', client_ipv => ''},
|
||||
{ipv6_opt => 1, server_ipv => '6', client_ipv => '6'},
|
||||
# Fetch without ssl
|
||||
{ server_ipv => '4', client_ipv => '' },
|
||||
{ server_ipv => '4', client_ipv => '4' },
|
||||
{ server_ipv => '6', client_ipv => '' },
|
||||
{ server_ipv => '6', client_ipv => '6' },
|
||||
|
||||
# Fetch via IO::Socket::SSL
|
||||
{ssl => 1, server_ipv => '4', client_ipv => ''},
|
||||
{ssl => 1, server_ipv => '4', client_ipv => '4'},
|
||||
{ssl => 1, server_ipv => '6', client_ipv => ''},
|
||||
{ssl => 1, server_ipv => '6', client_ipv => '6'},
|
||||
|
||||
# Fetch with curl
|
||||
{ curl => 1, server_ipv => '4', client_ipv => '' },
|
||||
{ curl => 1, server_ipv => '4', client_ipv => '4' },
|
||||
{ curl => 1, server_ipv => '6', client_ipv => '' },
|
||||
{ curl => 1, server_ipv => '6', client_ipv => '6' },
|
||||
|
||||
# Fetch with curl and ssl
|
||||
{ curl => 1, ssl => 1, server_ipv => '4', client_ipv => '' },
|
||||
{ curl => 1, ssl => 1, server_ipv => '4', client_ipv => '4' },
|
||||
{ curl => 1, ssl => 1, server_ipv => '6', client_ipv => '' },
|
||||
{ curl => 1, ssl => 1, server_ipv => '6', client_ipv => '6' },
|
||||
# Fetch with ssl
|
||||
{ ssl => 1, server_ipv => '4', client_ipv => '' },
|
||||
{ ssl => 1, server_ipv => '4', client_ipv => '4' },
|
||||
{ ssl => 1, server_ipv => '6', client_ipv => '' },
|
||||
{ ssl => 1, server_ipv => '6', client_ipv => '6' },
|
||||
);
|
||||
|
||||
for my $tc (@test_cases) {
|
||||
$tc->{ipv6_opt} //= 0;
|
||||
$tc->{ssl} //= 0;
|
||||
$tc->{curl} //= 0;
|
||||
SKIP: {
|
||||
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;
|
||||
skip("Curl not available on this system", 1) if $tc->{curl} && !$has_curl;
|
||||
my $uri = $httpd{$tc->{server_ipv}}{$tc->{ssl} ? 'https' : 'http'}->endpoint();
|
||||
my $name = sprintf("IPv%s client to %s%s%s",
|
||||
$tc->{client_ipv} || '*', $uri, $tc->{ipv6_opt} ? ' (-ipv6)' : '',
|
||||
$tc->{curl} ? ' (curl)' : '');
|
||||
my $name = sprintf("IPv%s client to %s%s",
|
||||
$tc->{client_ipv} || '*', $uri, $tc->{ipv6_opt} ? ' (-ipv6)' : '');
|
||||
$ddclient::globals{'ipv6'} = $tc->{ipv6_opt};
|
||||
$ddclient::globals{'curl'} = $tc->{curl};
|
||||
my $got = ddclient::geturl(url => $uri, ipversion => $tc->{client_ipv});
|
||||
isnt($got // '', '', $name);
|
||||
}
|
||||
|
|
|
|||
263
t/geturl_ssl.pl
263
t/geturl_ssl.pl
|
|
@ -1,263 +0,0 @@
|
|||
use Test::More;
|
||||
use Data::Dumper;
|
||||
eval {
|
||||
require HTTP::Request;
|
||||
require HTTP::Response;
|
||||
require IO::Socket::IP;
|
||||
require IO::Socket::SSL;
|
||||
require ddclient::Test::Fake::HTTPD;
|
||||
} or plan(skip_all => $@);
|
||||
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
|
||||
eval { require 'ddclient'; } or BAIL_OUT($@);
|
||||
|
||||
$Data::Dumper::Sortkeys = 1;
|
||||
|
||||
my $httpd = ddclient::Test::Fake::HTTPD->new();
|
||||
$httpd->run(sub {
|
||||
my $req = shift;
|
||||
# Echo back the full request.
|
||||
my $resp = [ 200, [ 'Content-Type' => 'application/octet-stream' ], [ $req->as_string() ] ];
|
||||
if ($req->method() ne 'GET') {
|
||||
# TODO: Add support for CONNECT to test https via proxy.
|
||||
$resp->[0] = 501; # 501 == Not Implemented
|
||||
}
|
||||
return $resp;
|
||||
});
|
||||
|
||||
my $args;
|
||||
|
||||
{
|
||||
package InterceptSocket;
|
||||
require base;
|
||||
base->import(qw(IO::Socket::IP));
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
$args = \%args;
|
||||
return $class->SUPER::new(%args, PeerAddr => $httpd->host(), PeerPort => $httpd->port());
|
||||
}
|
||||
}
|
||||
|
||||
# Keys:
|
||||
# * name: Display name.
|
||||
# * params: Parameters to pass to geturl.
|
||||
# * opt_ssl: Value to return from opt('ssl'). Defaults to 0.
|
||||
# * opt_ssl_ca_dir: Value to return from opt('ssl_ca_dir'). Defaults to undef.
|
||||
# * opt_ssl_ca_file: Value to return from opt('ssl_ca_file'). Defaults to undef.
|
||||
# * want_args: Args that should be passed to the socket constructor minus Proto,
|
||||
# Timeout, and original_socket_class.
|
||||
# * want_req_method: The HTTP method geturl is expected to use. Defaults to 'GET'.
|
||||
# * want_req_uri: URI that geturl is expected to request.
|
||||
# * todo: If defined, mark this test as expected to fail.
|
||||
my @test_cases = (
|
||||
{
|
||||
name => 'https',
|
||||
params => {
|
||||
url => 'https://hostname',
|
||||
},
|
||||
want_args => {
|
||||
PeerAddr => 'hostname',
|
||||
PeerPort => '443',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => '/',
|
||||
},
|
||||
{
|
||||
name => 'http with ssl=true',
|
||||
params => {
|
||||
url => 'http://hostname',
|
||||
},
|
||||
opt_ssl => 1,
|
||||
want_args => {
|
||||
PeerAddr => 'hostname',
|
||||
PeerPort => '443',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => '/',
|
||||
},
|
||||
{
|
||||
name => 'https with port',
|
||||
params => {
|
||||
url => 'https://hostname:123',
|
||||
},
|
||||
want_args => {
|
||||
PeerAddr => 'hostname',
|
||||
PeerPort => '123',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => '/',
|
||||
},
|
||||
{
|
||||
name => 'http with port and ssl=true',
|
||||
params => {
|
||||
url => 'https://hostname:123',
|
||||
},
|
||||
opt_ssl => 1,
|
||||
want_args => {
|
||||
PeerAddr => 'hostname',
|
||||
PeerPort => '123',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => '/',
|
||||
},
|
||||
{
|
||||
name => 'https proxy, http URL',
|
||||
params => {
|
||||
proxy => 'https://proxy',
|
||||
url => 'http://hostname',
|
||||
},
|
||||
want_args => {
|
||||
PeerAddr => 'proxy',
|
||||
PeerPort => '443',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => 'http://hostname/',
|
||||
todo => "broken",
|
||||
},
|
||||
{
|
||||
name => 'http proxy, https URL',
|
||||
params => {
|
||||
proxy => 'http://proxy',
|
||||
url => 'https://hostname',
|
||||
},
|
||||
want_args => {
|
||||
PeerAddr => 'proxy',
|
||||
PeerPort => '80',
|
||||
SSL_startHandshake => 0,
|
||||
},
|
||||
want_req_method => 'CONNECT',
|
||||
want_req_uri => 'hostname:443',
|
||||
todo => "not yet supported; silently fails",
|
||||
},
|
||||
{
|
||||
name => 'https proxy, https URL',
|
||||
params => {
|
||||
proxy => 'https://proxy',
|
||||
url => 'https://hostname',
|
||||
},
|
||||
want_args => {
|
||||
PeerAddr => 'proxy',
|
||||
PeerPort => '443',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_method => 'CONNECT',
|
||||
want_req_uri => 'hostname:443',
|
||||
todo => "not yet supported; silently fails",
|
||||
},
|
||||
{
|
||||
name => 'http proxy, http URL, ssl=true',
|
||||
params => {
|
||||
proxy => 'http://proxy',
|
||||
url => 'http://hostname',
|
||||
},
|
||||
opt_ssl => 1,
|
||||
want_args => {
|
||||
PeerAddr => 'proxy',
|
||||
PeerPort => '443',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_method => 'CONNECT',
|
||||
want_req_uri => 'hostname:443',
|
||||
todo => "not yet supported; silently fails",
|
||||
},
|
||||
{
|
||||
name => 'https proxy with port, http URL with port',
|
||||
params => {
|
||||
proxy => 'https://proxy:123',
|
||||
url => 'http://hostname:456',
|
||||
},
|
||||
want_args => {
|
||||
PeerAddr => 'proxy',
|
||||
PeerPort => '123',
|
||||
},
|
||||
want_req_uri => 'http://hostname:456/',
|
||||
todo => "broken",
|
||||
},
|
||||
{
|
||||
name => 'http proxy with port, https URL with port',
|
||||
params => {
|
||||
proxy => 'http://proxy:123',
|
||||
url => 'https://hostname:456',
|
||||
},
|
||||
want_args => {
|
||||
PeerAddr => 'proxy',
|
||||
PeerPort => '123',
|
||||
SSL_startHandshake => 0,
|
||||
},
|
||||
want_req_method => 'CONNECT',
|
||||
want_req_uri => 'hostname:456',
|
||||
todo => "not yet supported; silently fails",
|
||||
},
|
||||
{
|
||||
name => 'CA dir',
|
||||
params => {
|
||||
url => 'https://hostname',
|
||||
},
|
||||
opt_ssl_ca_dir => '/ca/dir',
|
||||
want_args => {
|
||||
PeerAddr => 'hostname',
|
||||
PeerPort => '443',
|
||||
SSL_ca_path => '/ca/dir',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => '/',
|
||||
},
|
||||
{
|
||||
name => 'CA file',
|
||||
params => {
|
||||
url => 'https://hostname',
|
||||
},
|
||||
opt_ssl_ca_file => '/ca/file',
|
||||
want_args => {
|
||||
PeerAddr => 'hostname',
|
||||
PeerPort => '443',
|
||||
SSL_ca_file => '/ca/file',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => '/',
|
||||
},
|
||||
{
|
||||
name => 'CA dir and file',
|
||||
params => {
|
||||
url => 'https://hostname',
|
||||
},
|
||||
opt_ssl_ca_dir => '/ca/dir',
|
||||
opt_ssl_ca_file => '/ca/file',
|
||||
want_args => {
|
||||
PeerAddr => 'hostname',
|
||||
PeerPort => '443',
|
||||
SSL_ca_file => '/ca/file',
|
||||
SSL_ca_path => '/ca/dir',
|
||||
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||
},
|
||||
want_req_uri => '/',
|
||||
},
|
||||
);
|
||||
|
||||
for my $tc (@test_cases) {
|
||||
$args = undef;
|
||||
$ddclient::globals{'ssl'} = $tc->{opt_ssl} // 0;
|
||||
$ddclient::globals{'ssl_ca_dir'} = $tc->{opt_ssl_ca_dir};
|
||||
$ddclient::globals{'ssl_ca_file'} = $tc->{opt_ssl_ca_file};
|
||||
my $resp_str = ddclient::geturl(_testonly_socket_class => 'InterceptSocket', %{$tc->{params}});
|
||||
TODO: {
|
||||
local $TODO = $tc->{todo};
|
||||
subtest $tc->{name} => sub {
|
||||
my %want_args = (
|
||||
Proto => 'tcp',
|
||||
Timeout => ddclient::opt('timeout'),
|
||||
original_socket_class => 'IO::Socket::SSL',
|
||||
%{$tc->{want_args}},
|
||||
);
|
||||
is(Dumper($args), Dumper(\%want_args), "socket constructor args");
|
||||
ok(defined($resp_str), "response is defined") or return;
|
||||
ok(my $resp = HTTP::Response->parse($resp_str), "parse response") or return;
|
||||
ok(my $req_str = $resp->decoded_content(), "decode request from response") or return;
|
||||
ok(my $req = HTTP::Request->parse($req_str), "parse request") or return;
|
||||
is($req->method(), $tc->{want_req_method} // 'GET', "request method");
|
||||
is($req->uri(), $tc->{want_req_uri}, "request URI");
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
done_testing();
|
||||
Loading…
Reference in a new issue