commit
bafe142692
7 changed files with 294 additions and 8 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -17,5 +17,6 @@ release
|
||||||
/ddclient.conf
|
/ddclient.conf
|
||||||
/t/*.log
|
/t/*.log
|
||||||
/t/*.trs
|
/t/*.trs
|
||||||
|
/t/geturl_connectivity.pl
|
||||||
/t/version.pl
|
/t/version.pl
|
||||||
/test-suite.log
|
/test-suite.log
|
||||||
|
|
|
@ -36,6 +36,13 @@ repository history](https://github.com/ddclient/ddclient/commits/master).
|
||||||
- `siemens-ss4200`: Siemens SpeedStream 4200
|
- `siemens-ss4200`: Siemens SpeedStream 4200
|
||||||
- `thomson-st536v6`: Thomson SpeedTouch 536v6
|
- `thomson-st536v6`: Thomson SpeedTouch 536v6
|
||||||
- `thomson-tg782`: Thomson/Technicolor TG782
|
- `thomson-tg782`: Thomson/Technicolor TG782
|
||||||
|
* Added option `-curl` to access network with system Curl command instead
|
||||||
|
of the Perl built-in IO::Socket classes.
|
||||||
|
* Added option `-{no}web-ssl-validate` and `-{no}fw-ssl-validate`to provide
|
||||||
|
option to disable SSL certificate validation. Note that these only apply for
|
||||||
|
network access when obtaining an IP address with `use=web` or `use=fw`
|
||||||
|
(any firewall). Network access to Dynamic DNS servers to set or retrieve
|
||||||
|
IP address will always require certificate validation.
|
||||||
|
|
||||||
### Bug fixes
|
### Bug fixes
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,8 @@ subst = sed \
|
||||||
-e '1 s|^\#\!.*perl$$|\#\!$(PERL)|g' \
|
-e '1 s|^\#\!.*perl$$|\#\!$(PERL)|g' \
|
||||||
-e 's|@localstatedir[@]|$(localstatedir)|g' \
|
-e 's|@localstatedir[@]|$(localstatedir)|g' \
|
||||||
-e 's|@runstatedir[@]|$(runstatedir)|g' \
|
-e 's|@runstatedir[@]|$(runstatedir)|g' \
|
||||||
-e 's|@sysconfdir[@]|$(sysconfdir)|g'
|
-e 's|@sysconfdir[@]|$(sysconfdir)|g' \
|
||||||
|
-e 's|@CURL[@]|$(CURL)|g'
|
||||||
|
|
||||||
# Files that will be generated by passing their *.in file through
|
# Files that will be generated by passing their *.in file through
|
||||||
# $(subst).
|
# $(subst).
|
||||||
|
@ -70,7 +71,6 @@ AM_PL_LOG_FLAGS = -Mstrict -w \
|
||||||
-I'$(abs_top_srcdir)'/t/lib \
|
-I'$(abs_top_srcdir)'/t/lib \
|
||||||
-MDevel::Autoflush
|
-MDevel::Autoflush
|
||||||
handwritten_tests = \
|
handwritten_tests = \
|
||||||
t/geturl_connectivity.pl \
|
|
||||||
t/geturl_ssl.pl \
|
t/geturl_ssl.pl \
|
||||||
t/is-and-extract-ipv4.pl \
|
t/is-and-extract-ipv4.pl \
|
||||||
t/is-and-extract-ipv6.pl \
|
t/is-and-extract-ipv6.pl \
|
||||||
|
@ -78,6 +78,7 @@ handwritten_tests = \
|
||||||
t/parse_assignments.pl \
|
t/parse_assignments.pl \
|
||||||
t/write_cache.pl
|
t/write_cache.pl
|
||||||
generated_tests = \
|
generated_tests = \
|
||||||
|
t/geturl_connectivity.pl \
|
||||||
t/version.pl
|
t/version.pl
|
||||||
TESTS = $(handwritten_tests) $(generated_tests)
|
TESTS = $(handwritten_tests) $(generated_tests)
|
||||||
EXTRA_DIST += $(handwritten_tests) \
|
EXTRA_DIST += $(handwritten_tests) \
|
||||||
|
|
|
@ -27,6 +27,8 @@ AC_PROG_MKDIR_P
|
||||||
AC_PATH_PROG([FIND], [find])
|
AC_PATH_PROG([FIND], [find])
|
||||||
AS_IF([test -z "${FIND}"], [AC_MSG_ERROR(['find' utility not found])])
|
AS_IF([test -z "${FIND}"], [AC_MSG_ERROR(['find' utility not found])])
|
||||||
|
|
||||||
|
AC_PATH_PROG([CURL], [curl])
|
||||||
|
|
||||||
AX_WITH_PROG([PERL], perl)
|
AX_WITH_PROG([PERL], perl)
|
||||||
AX_PROG_PERL_VERSION([5.10.1], [],
|
AX_PROG_PERL_VERSION([5.10.1], [],
|
||||||
[AC_MSG_ERROR([Perl 5.10.1 or newer not found])])
|
[AC_MSG_ERROR([Perl 5.10.1 or newer not found])])
|
||||||
|
@ -39,6 +41,7 @@ AC_SUBST([PERL])
|
||||||
m4_foreach_w([_m], [
|
m4_foreach_w([_m], [
|
||||||
File::Basename
|
File::Basename
|
||||||
File::Path
|
File::Path
|
||||||
|
File::Temp
|
||||||
Getopt::Long
|
Getopt::Long
|
||||||
IO::Socket::INET
|
IO::Socket::INET
|
||||||
Socket
|
Socket
|
||||||
|
@ -70,6 +73,7 @@ m4_foreach_w([_m], [
|
||||||
HTTP::Response
|
HTTP::Response
|
||||||
IO::Socket::INET6
|
IO::Socket::INET6
|
||||||
IO::Socket::IP
|
IO::Socket::IP
|
||||||
|
IO::Socket::SSL
|
||||||
Scalar::Util
|
Scalar::Util
|
||||||
Test::MockModule
|
Test::MockModule
|
||||||
Test::TCP
|
Test::TCP
|
||||||
|
@ -81,6 +85,7 @@ m4_foreach_w([_m], [
|
||||||
|
|
||||||
AC_CONFIG_FILES([
|
AC_CONFIG_FILES([
|
||||||
Makefile
|
Makefile
|
||||||
|
t/geturl_connectivity.pl
|
||||||
t/version.pl
|
t/version.pl
|
||||||
])
|
])
|
||||||
AC_OUTPUT
|
AC_OUTPUT
|
||||||
|
|
249
ddclient.in
249
ddclient.in
|
@ -24,6 +24,7 @@ use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use File::Basename;
|
use File::Basename;
|
||||||
use File::Path qw(make_path);
|
use File::Path qw(make_path);
|
||||||
|
use File::Temp;
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
use IO::Socket::INET;
|
use IO::Socket::INET;
|
||||||
use Socket qw(AF_INET AF_INET6 PF_INET PF_INET6);
|
use Socket qw(AF_INET AF_INET6 PF_INET PF_INET6);
|
||||||
|
@ -403,6 +404,7 @@ my %variables = (
|
||||||
'retry' => setv(T_BOOL, 0, 0, 0, undef),
|
'retry' => setv(T_BOOL, 0, 0, 0, undef),
|
||||||
'force' => setv(T_BOOL, 0, 0, 0, undef),
|
'force' => setv(T_BOOL, 0, 0, 0, undef),
|
||||||
'ssl' => setv(T_BOOL, 0, 0, 0, undef),
|
'ssl' => setv(T_BOOL, 0, 0, 0, undef),
|
||||||
|
'curl' => setv(T_BOOL, 0, 0, 0, undef),
|
||||||
'ipv6' => setv(T_BOOL, 0, 0, 0, undef),
|
'ipv6' => setv(T_BOOL, 0, 0, 0, undef),
|
||||||
'syslog' => setv(T_BOOL, 0, 0, 0, undef),
|
'syslog' => setv(T_BOOL, 0, 0, 0, undef),
|
||||||
'facility' => setv(T_STRING,0, 0, 'daemon', undef),
|
'facility' => setv(T_STRING,0, 0, 'daemon', undef),
|
||||||
|
@ -432,10 +434,12 @@ my %variables = (
|
||||||
'if' => setv(T_IF, 0, 0, 'ppp0', undef),
|
'if' => setv(T_IF, 0, 0, 'ppp0', undef),
|
||||||
'web' => setv(T_STRING,0, 0, 'dyndns', undef),
|
'web' => setv(T_STRING,0, 0, 'dyndns', undef),
|
||||||
'web-skip' => setv(T_STRING,0, 0, '', undef),
|
'web-skip' => setv(T_STRING,0, 0, '', undef),
|
||||||
|
'web-ssl-validate' => setv(T_BOOL, 0, 0, 1, undef),
|
||||||
'fw' => setv(T_ANY, 0, 0, '', undef),
|
'fw' => setv(T_ANY, 0, 0, '', undef),
|
||||||
'fw-skip' => setv(T_STRING,0, 0, '', undef),
|
'fw-skip' => setv(T_STRING,0, 0, '', undef),
|
||||||
'fw-login' => setv(T_LOGIN, 0, 0, '', undef),
|
'fw-login' => setv(T_LOGIN, 0, 0, '', undef),
|
||||||
'fw-password' => setv(T_PASSWD,0, 0, '', undef),
|
'fw-password' => setv(T_PASSWD,0, 0, '', undef),
|
||||||
|
'fw-ssl-validate' => setv(T_BOOL, 0, 0, 1, undef),
|
||||||
'cmd' => setv(T_PROG, 0, 0, '', undef),
|
'cmd' => setv(T_PROG, 0, 0, '', undef),
|
||||||
'cmd-skip' => setv(T_STRING,0, 0, '', undef),
|
'cmd-skip' => setv(T_STRING,0, 0, '', undef),
|
||||||
'ipv6' => setv(T_BOOL, 0, 0, 0, undef),
|
'ipv6' => setv(T_BOOL, 0, 0, 0, undef),
|
||||||
|
@ -812,6 +816,9 @@ my @opt = (
|
||||||
["ssl", "!", "-{no}ssl : do updates over encrypted SSL connection"],
|
["ssl", "!", "-{no}ssl : do updates over encrypted SSL connection"],
|
||||||
["ssl_ca_dir", "=s", "-ssl_ca_dir <dir> : look in <dir> for certificates of trusted certificate authorities (default: auto-detect)"],
|
["ssl_ca_dir", "=s", "-ssl_ca_dir <dir> : look in <dir> for certificates of trusted certificate authorities (default: auto-detect)"],
|
||||||
["ssl_ca_file", "=s", "-ssl_ca_file <file> : look at <file> for certificates of trusted certificate authorities (default: auto-detect)"],
|
["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"],
|
["retry", "!", "-{no}retry : retry failed updates"],
|
||||||
["force", "!", "-{no}force : force an update even if the update may be unnecessary"],
|
["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"],
|
["timeout", "=i", "-timeout <max> : when fetching a URL, wait at most <max> seconds for a response"],
|
||||||
|
@ -2037,10 +2044,15 @@ EOM
|
||||||
}
|
}
|
||||||
import JSON::PP (qw/decode_json encode_json/);
|
import JSON::PP (qw/decode_json encode_json/);
|
||||||
}
|
}
|
||||||
|
|
||||||
######################################################################
|
######################################################################
|
||||||
## geturl
|
## geturl
|
||||||
######################################################################
|
######################################################################
|
||||||
sub geturl {
|
sub geturl {
|
||||||
|
return opt('curl') ? fetch_via_curl(@_) : fetch_via_socket_io(@_);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub fetch_via_socket_io {
|
||||||
my %params = @_;
|
my %params = @_;
|
||||||
my $proxy = $params{proxy};
|
my $proxy = $params{proxy};
|
||||||
my $url = $params{url};
|
my $url = $params{url};
|
||||||
|
@ -2072,7 +2084,8 @@ sub geturl {
|
||||||
debug("proxy = %s", $proxy // '<undefined>');
|
debug("proxy = %s", $proxy // '<undefined>');
|
||||||
debug("protocol = %s", $use_ssl ? "https" : "http");
|
debug("protocol = %s", $use_ssl ? "https" : "http");
|
||||||
debug("server = %s", $server);
|
debug("server = %s", $server);
|
||||||
debug("url = %s", $url);
|
(my $_url = $url) =~ s%\?.*%?<redacted>%; #redact possible credentials
|
||||||
|
debug("url = %s", $_url);
|
||||||
debug("ip ver = %s", $ipversion);
|
debug("ip ver = %s", $ipversion);
|
||||||
|
|
||||||
## determine peer and port to use.
|
## determine peer and port to use.
|
||||||
|
@ -2127,6 +2140,9 @@ sub geturl {
|
||||||
$socket_class = 'IO::Socket::SSL';
|
$socket_class = 'IO::Socket::SSL';
|
||||||
$socket_args{SSL_ca_file} = opt('ssl_ca_file') if defined(opt('ssl_ca_file'));
|
$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_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;
|
||||||
} elsif ($globals{'ipv6'} || $ipversion eq '6') {
|
} elsif ($globals{'ipv6'} || $ipversion eq '6') {
|
||||||
load_ipv6_support;
|
load_ipv6_support;
|
||||||
$socket_class = 'IO::Socket::INET6';
|
$socket_class = 'IO::Socket::INET6';
|
||||||
|
@ -2207,6 +2223,226 @@ sub geturl {
|
||||||
return $reply;
|
return $reply;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
######################################################################
|
||||||
|
## curl_cmd() function to execute system curl command
|
||||||
|
######################################################################
|
||||||
|
sub curl_cmd {
|
||||||
|
my @params = @_;
|
||||||
|
my $tmpfile;
|
||||||
|
my $tfh;
|
||||||
|
my $system_curl = quotemeta(subst_var('@CURL@', 'curl'));
|
||||||
|
my %curl_codes = ( ## Subset of error codes from https://curl.haxx.se/docs/manpage.html
|
||||||
|
2 => "Failed to initialize. (Most likely a bug in ddclient, please open issue at https://github.com/ddclient/ddclient)",
|
||||||
|
3 => "URL malformed. The syntax was not correct",
|
||||||
|
5 => "Couldn't resolve proxy. The given proxy host could not be resolved.",
|
||||||
|
6 => "Couldn't resolve host. The given remote host was not resolved.",
|
||||||
|
7 => "Failed to connect to host.",
|
||||||
|
22 => "HTTP page not retrieved. The requested url was not found or returned another error.",
|
||||||
|
28 => "Operation timeout. The specified time-out period was reached according to the conditions.",
|
||||||
|
35 => "SSL connect error. The SSL handshaking failed.",
|
||||||
|
47 => "Too many redirects. When following redirects, curl hit the maximum amount.",
|
||||||
|
52 => "The server didn't reply anything, which here is considered an error.",
|
||||||
|
51 => "The peer's SSL certificate or SSH MD5 fingerprint was not OK.",
|
||||||
|
58 => "Problem with the local certificate.",
|
||||||
|
60 => "Peer certificate cannot be authenticated with known CA certificates.",
|
||||||
|
67 => "The user name, password, or similar was not accepted and curl failed to log in.",
|
||||||
|
77 => "Problem with reading the SSL CA cert (path? access rights?).",
|
||||||
|
78 => "The resource referenced in the URL does not exist.",
|
||||||
|
127 => "You requested network access with curl but $system_curl was not found",
|
||||||
|
);
|
||||||
|
|
||||||
|
debug("CURL: %s", $system_curl);
|
||||||
|
fatal("curl not found") if ($system_curl eq '');
|
||||||
|
return '' if (scalar(@params) == 0); ## no parameters provided
|
||||||
|
|
||||||
|
# Hard code to /tmp rather than use system TMPDIR to protect from malicious
|
||||||
|
# shell instructions in TMPDIR environment variable. All systems should have /tmp.
|
||||||
|
$tfh = File::Temp->new(DIR => '/tmp',
|
||||||
|
TEMPLATE => 'ddclient_XXXXXXXXXX');
|
||||||
|
$tmpfile = $tfh->filename;
|
||||||
|
|
||||||
|
debug("CURL Tempfile: %s", $tmpfile);
|
||||||
|
{
|
||||||
|
local $\ = "\n"; ## Terminate the file,
|
||||||
|
local $, = "\n"; ## and each parameter, with a newline.
|
||||||
|
print($tfh @params);
|
||||||
|
}
|
||||||
|
close($tfh);
|
||||||
|
my $reply = qx{ $system_curl --config $tmpfile 2>/dev/null; };
|
||||||
|
if ((my $rc = $?>>8) != 0) {
|
||||||
|
warning("CURL error (%d) %s", $rc, $curl_codes{$rc} // "Unknown return code. Check $system_curl is installed and its manpage.");
|
||||||
|
}
|
||||||
|
return $reply;
|
||||||
|
}
|
||||||
|
|
||||||
|
######################################################################
|
||||||
|
## escape_curl_param() makes sure any special characters within a
|
||||||
|
## curl parameter is properly escaped.
|
||||||
|
######################################################################
|
||||||
|
sub escape_curl_param {
|
||||||
|
my $str = shift // '';
|
||||||
|
|
||||||
|
return '' if ($str eq '');
|
||||||
|
$str =~ s/\\/\\\\/g;## Escape backslashes
|
||||||
|
$str =~ s/"/\\"/g; ## Escape double-quotes
|
||||||
|
$str =~ s/\n/\\n/g; ## Escape newline
|
||||||
|
$str =~ s/\r/\\r/g; ## Escape carrage return
|
||||||
|
$str =~ s/\t/\\t/g; ## Escape tabs
|
||||||
|
$str =~ s/\v/\\v/g; ## Escape vertical whitespace
|
||||||
|
return $str;
|
||||||
|
}
|
||||||
|
|
||||||
|
######################################################################
|
||||||
|
## fetch_via_curl() is used for geturl() when global curl option set
|
||||||
|
######################################################################
|
||||||
|
sub fetch_via_curl {
|
||||||
|
my %params = @_;
|
||||||
|
my $proxy = $params{proxy};
|
||||||
|
my $url = $params{url};
|
||||||
|
my $login = $params{login};
|
||||||
|
my $password = $params{password};
|
||||||
|
my $ipversion = ($params{ipversion}) ? int($params{ipversion}) : 0;
|
||||||
|
my $headers = $params{headers} // '';
|
||||||
|
my $method = $params{method} // 'GET';
|
||||||
|
my $data = $params{data} // '';
|
||||||
|
|
||||||
|
my $reply;
|
||||||
|
my $server;
|
||||||
|
my $use_ssl = 0;
|
||||||
|
my $force_ssl = 0;
|
||||||
|
my $protocol;
|
||||||
|
my $timeout = opt('timeout');
|
||||||
|
my @curlopt = ();
|
||||||
|
my @header_lines = ();
|
||||||
|
|
||||||
|
## canonify proxy and url
|
||||||
|
$force_ssl = 1 if ($url =~ /^https:/);
|
||||||
|
$proxy =~ s%^https?://%%i if defined($proxy);
|
||||||
|
$url =~ s%^https?://%%i;
|
||||||
|
$server = $url;
|
||||||
|
$server =~ s%[?/].*%%;
|
||||||
|
$url =~ s%^[^?/]*/?%%;
|
||||||
|
|
||||||
|
$use_ssl = 1 if ($force_ssl || ($globals{'ssl'} && !($params{ignore_ssl_option} // 0)));
|
||||||
|
|
||||||
|
$protocol = ($use_ssl ? "https" : "http");
|
||||||
|
|
||||||
|
debug("proxy = %s", $proxy // '<undefined>');
|
||||||
|
debug("protocol = %s", $protocol);
|
||||||
|
debug("server = %s", $server);
|
||||||
|
(my $_url = $url) =~ s%\?.*%?<redacted>%; #redact possible credentials
|
||||||
|
debug("url = %s", $_url);
|
||||||
|
debug("ip ver = %s", $ipversion);
|
||||||
|
|
||||||
|
if (!opt('exec')) {
|
||||||
|
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;
|
||||||
|
|
||||||
|
$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);
|
||||||
|
|
||||||
|
$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
|
||||||
|
|
||||||
|
$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}");
|
||||||
|
|
||||||
|
# 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);
|
||||||
|
}
|
||||||
|
verbose("RECEIVE:", "%s", $reply // "<undefined>");
|
||||||
|
if (!$reply) {
|
||||||
|
# don't include ${url} as that might expose login credentials
|
||||||
|
warning("curl cannot connect to %s://%s using IPv%s",${protocol},${server},$ipversion);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
## 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;
|
||||||
|
}
|
||||||
|
|
||||||
######################################################################
|
######################################################################
|
||||||
## get_ip
|
## get_ip
|
||||||
######################################################################
|
######################################################################
|
||||||
|
@ -2247,7 +2483,11 @@ sub get_ip {
|
||||||
$arg = $url;
|
$arg = $url;
|
||||||
|
|
||||||
if ($url) {
|
if ($url) {
|
||||||
$reply = geturl(proxy => opt('proxy', $h), url => $url) // '';
|
$reply = geturl(
|
||||||
|
proxy => opt('proxy', $h),
|
||||||
|
url => $url,
|
||||||
|
ssl_validate => opt('web-ssl-validate', $h),
|
||||||
|
) // '';
|
||||||
}
|
}
|
||||||
|
|
||||||
} elsif (($use eq 'cisco')) {
|
} elsif (($use eq 'cisco')) {
|
||||||
|
@ -2269,6 +2509,7 @@ sub get_ip {
|
||||||
login => opt('fw-login', $h),
|
login => opt('fw-login', $h),
|
||||||
password => opt('fw-password', $h),
|
password => opt('fw-password', $h),
|
||||||
ignore_ssl_option => 1,
|
ignore_ssl_option => 1,
|
||||||
|
ssl_validate => opt('fw-ssl-validate', $h),
|
||||||
) // '';
|
) // '';
|
||||||
$arg = $url;
|
$arg = $url;
|
||||||
|
|
||||||
|
@ -2291,6 +2532,7 @@ sub get_ip {
|
||||||
login => opt('fw-login', $h),
|
login => opt('fw-login', $h),
|
||||||
password => opt('fw-password', $h),
|
password => opt('fw-password', $h),
|
||||||
ignore_ssl_option => 1,
|
ignore_ssl_option => 1,
|
||||||
|
ssl_validate => opt('fw-ssl-validate', $h),
|
||||||
) // '';
|
) // '';
|
||||||
$arg = $url;
|
$arg = $url;
|
||||||
|
|
||||||
|
@ -2310,6 +2552,7 @@ sub get_ip {
|
||||||
login => opt('fw-login', $h),
|
login => opt('fw-login', $h),
|
||||||
password => opt('fw-password', $h),
|
password => opt('fw-password', $h),
|
||||||
ignore_ssl_option => 1,
|
ignore_ssl_option => 1,
|
||||||
|
ssl_validate => opt('fw-ssl-validate', $h),
|
||||||
) // '';
|
) // '';
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -2674,7 +2917,7 @@ sub header_ok {
|
||||||
my ($host, $line) = @_;
|
my ($host, $line) = @_;
|
||||||
my $ok = 0;
|
my $ok = 0;
|
||||||
|
|
||||||
if ($line =~ m%^s*HTTP/1.*\s+(\d+)%i) {
|
if ($line =~ m%^s*HTTP/.*\s+(\d+)%i) {
|
||||||
my $result = $1;
|
my $result = $1;
|
||||||
|
|
||||||
if ($result =~ m/^2\d\d$/) {
|
if ($result =~ m/^2\d\d$/) {
|
||||||
|
|
|
@ -13,6 +13,8 @@ my $ipv6_supported = eval {
|
||||||
);
|
);
|
||||||
defined($ipv6_socket);
|
defined($ipv6_socket);
|
||||||
};
|
};
|
||||||
|
my $has_curl = qx{ @CURL@ --version 2>/dev/null; } && $? == 0;
|
||||||
|
|
||||||
my $http_daemon_supports_ipv6 = eval {
|
my $http_daemon_supports_ipv6 = eval {
|
||||||
require HTTP::Daemon;
|
require HTTP::Daemon;
|
||||||
HTTP::Daemon->VERSION(6.12);
|
HTTP::Daemon->VERSION(6.12);
|
||||||
|
@ -71,23 +73,39 @@ my @test_cases = (
|
||||||
{ssl => 1, server_ipv => '4', client_ipv => '4'},
|
{ssl => 1, server_ipv => '4', client_ipv => '4'},
|
||||||
{ssl => 1, server_ipv => '6', client_ipv => ''},
|
{ssl => 1, server_ipv => '6', client_ipv => ''},
|
||||||
{ssl => 1, server_ipv => '6', client_ipv => '6'},
|
{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' },
|
||||||
);
|
);
|
||||||
|
|
||||||
for my $tc (@test_cases) {
|
for my $tc (@test_cases) {
|
||||||
$tc->{ipv6_opt} //= 0;
|
$tc->{ipv6_opt} //= 0;
|
||||||
$tc->{ssl} //= 0;
|
$tc->{ssl} //= 0;
|
||||||
|
$tc->{curl} //= 0;
|
||||||
SKIP: {
|
SKIP: {
|
||||||
skip("IO::Socket::INET6 not available", 1)
|
skip("IO::Socket::INET6 not available", 1)
|
||||||
if ($tc->{ipv6_opt} || $tc->{client_ipv} eq '6') && !$has_io_socket_inet6;
|
if ($tc->{ipv6_opt} || $tc->{client_ipv} eq '6') && !$tc->{curl} && !$has_io_socket_inet6;
|
||||||
skip("IPv6 not supported on this system", 1)
|
skip("IPv6 not supported on this system", 1)
|
||||||
if $tc->{server_ipv} eq '6' && !$ipv6_supported;
|
if $tc->{server_ipv} eq '6' && !$ipv6_supported;
|
||||||
skip("HTTP::Daemon too old for IPv6 support", 1)
|
skip("HTTP::Daemon too old for IPv6 support", 1)
|
||||||
if $tc->{server_ipv} eq '6' && !$http_daemon_supports_ipv6;
|
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("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 $uri = $httpd{$tc->{server_ipv}}{$tc->{ssl} ? 'https' : 'http'}->endpoint();
|
||||||
my $name = sprintf("IPv%s client to %s%s",
|
my $name = sprintf("IPv%s client to %s%s%s",
|
||||||
$tc->{client_ipv} || '*', $uri, $tc->{ipv6_opt} ? ' (-ipv6)' : '');
|
$tc->{client_ipv} || '*', $uri, $tc->{ipv6_opt} ? ' (-ipv6)' : '',
|
||||||
|
$tc->{curl} ? ' (curl)' : '');
|
||||||
$ddclient::globals{'ipv6'} = $tc->{ipv6_opt};
|
$ddclient::globals{'ipv6'} = $tc->{ipv6_opt};
|
||||||
|
$ddclient::globals{'curl'} = $tc->{curl};
|
||||||
my $got = ddclient::geturl(url => $uri, ipversion => $tc->{client_ipv});
|
my $got = ddclient::geturl(url => $uri, ipversion => $tc->{client_ipv});
|
||||||
isnt($got // '', '', $name);
|
isnt($got // '', '', $name);
|
||||||
}
|
}
|
|
@ -4,6 +4,7 @@ eval {
|
||||||
require HTTP::Request;
|
require HTTP::Request;
|
||||||
require HTTP::Response;
|
require HTTP::Response;
|
||||||
require IO::Socket::IP;
|
require IO::Socket::IP;
|
||||||
|
require IO::Socket::SSL;
|
||||||
require ddclient::Test::Fake::HTTPD;
|
require ddclient::Test::Fake::HTTPD;
|
||||||
} or plan(skip_all => $@);
|
} or plan(skip_all => $@);
|
||||||
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
|
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
|
||||||
|
@ -57,6 +58,7 @@ my @test_cases = (
|
||||||
want_args => {
|
want_args => {
|
||||||
PeerAddr => 'hostname',
|
PeerAddr => 'hostname',
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => '/',
|
want_req_uri => '/',
|
||||||
},
|
},
|
||||||
|
@ -69,6 +71,7 @@ my @test_cases = (
|
||||||
want_args => {
|
want_args => {
|
||||||
PeerAddr => 'hostname',
|
PeerAddr => 'hostname',
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => '/',
|
want_req_uri => '/',
|
||||||
},
|
},
|
||||||
|
@ -80,6 +83,7 @@ my @test_cases = (
|
||||||
want_args => {
|
want_args => {
|
||||||
PeerAddr => 'hostname',
|
PeerAddr => 'hostname',
|
||||||
PeerPort => '123',
|
PeerPort => '123',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => '/',
|
want_req_uri => '/',
|
||||||
},
|
},
|
||||||
|
@ -92,6 +96,7 @@ my @test_cases = (
|
||||||
want_args => {
|
want_args => {
|
||||||
PeerAddr => 'hostname',
|
PeerAddr => 'hostname',
|
||||||
PeerPort => '123',
|
PeerPort => '123',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => '/',
|
want_req_uri => '/',
|
||||||
},
|
},
|
||||||
|
@ -104,6 +109,7 @@ my @test_cases = (
|
||||||
want_args => {
|
want_args => {
|
||||||
PeerAddr => 'proxy',
|
PeerAddr => 'proxy',
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => 'http://hostname/',
|
want_req_uri => 'http://hostname/',
|
||||||
todo => "broken",
|
todo => "broken",
|
||||||
|
@ -132,6 +138,7 @@ my @test_cases = (
|
||||||
want_args => {
|
want_args => {
|
||||||
PeerAddr => 'proxy',
|
PeerAddr => 'proxy',
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_method => 'CONNECT',
|
want_req_method => 'CONNECT',
|
||||||
want_req_uri => 'hostname:443',
|
want_req_uri => 'hostname:443',
|
||||||
|
@ -147,6 +154,7 @@ my @test_cases = (
|
||||||
want_args => {
|
want_args => {
|
||||||
PeerAddr => 'proxy',
|
PeerAddr => 'proxy',
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_method => 'CONNECT',
|
want_req_method => 'CONNECT',
|
||||||
want_req_uri => 'hostname:443',
|
want_req_uri => 'hostname:443',
|
||||||
|
@ -190,6 +198,7 @@ my @test_cases = (
|
||||||
PeerAddr => 'hostname',
|
PeerAddr => 'hostname',
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
SSL_ca_path => '/ca/dir',
|
SSL_ca_path => '/ca/dir',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => '/',
|
want_req_uri => '/',
|
||||||
},
|
},
|
||||||
|
@ -203,6 +212,7 @@ my @test_cases = (
|
||||||
PeerAddr => 'hostname',
|
PeerAddr => 'hostname',
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
SSL_ca_file => '/ca/file',
|
SSL_ca_file => '/ca/file',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => '/',
|
want_req_uri => '/',
|
||||||
},
|
},
|
||||||
|
@ -218,6 +228,7 @@ my @test_cases = (
|
||||||
PeerPort => '443',
|
PeerPort => '443',
|
||||||
SSL_ca_file => '/ca/file',
|
SSL_ca_file => '/ca/file',
|
||||||
SSL_ca_path => '/ca/dir',
|
SSL_ca_path => '/ca/dir',
|
||||||
|
SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER,
|
||||||
},
|
},
|
||||||
want_req_uri => '/',
|
want_req_uri => '/',
|
||||||
},
|
},
|
||||||
|
|
Loading…
Reference in a new issue