Add support for curl and option to not validate SSL certificates for getip from web or firewall

Check exists not just length
This commit is contained in:
David Kerr 2020-07-17 09:50:32 -04:00
parent 3730ff54be
commit d24b75960d
7 changed files with 231 additions and 6 deletions

1
.gitignore vendored
View file

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

View file

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

View file

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

View file

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

View file

@ -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};
@ -2127,6 +2139,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 +2222,166 @@ 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 double-quotes
$str =~ s/\\/\\\\/g;## Escape backslashes
$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);
debug("url = %s", $url);
debug("ip ver = %s", $ipversion);
if (!opt('exec')) {
debug("skipped network connection");
verbose("SENDING:", "%s", "${server}/${url}");
} else {
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}").'"');
@header_lines = split('\n', $headers);
$_ = "header=\"".escape_curl_param($_).'"' foreach (@header_lines);
push(@curlopt, @header_lines);
push(@curlopt, "data=\"".escape_curl_param(${data}).'"') if ($data ne '');
# don't include ${url} as that might expose login credentials
$0 = sprintf("%s - curl sending to %s", $program, "${protocol}://${server}");
verbose("SENDING:", "curl to %s", "${protocol}://${server}");
$reply = curl_cmd(@curlopt);
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 +2422,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 +2448,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 +2471,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 +2491,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),
) // ''; ) // '';
} }
} }

View file

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

View file

@ -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 => '/',
}, },