|
|
|
@ -0,0 +1,569 @@
|
|
|
|
|
From 77f557ef84698efeb6eed04e4a9704eaf85b741d Mon Sep 17 00:00:00 2001
|
|
|
|
|
From: Stig Palmquist <git@stig.io>
|
|
|
|
|
Date: Mon, 5 Jun 2023 16:46:22 +0200
|
|
|
|
|
Subject: [PATCH] Change verify_SSL default to 1, add ENV var to enable
|
|
|
|
|
insecure default
|
|
|
|
|
|
|
|
|
|
- Changes the `verify_SSL` default parameter from `0` to `1`
|
|
|
|
|
|
|
|
|
|
Based on patch by Dominic Hargreaves:
|
|
|
|
|
https://salsa.debian.org/perl-team/interpreter/perl/-/commit/1490431e40e22052f75a0b3449f1f53cbd27ba92
|
|
|
|
|
|
|
|
|
|
Fixes CVE-2023-31486
|
|
|
|
|
|
|
|
|
|
- Add check for `$ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT}` that
|
|
|
|
|
enables the previous insecure default behaviour if set to `1`.
|
|
|
|
|
|
|
|
|
|
This provides a workaround for users who encounter problems with the
|
|
|
|
|
new `verify_SSL` default.
|
|
|
|
|
|
|
|
|
|
Example to disable certificate checks:
|
|
|
|
|
```
|
|
|
|
|
$ PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1 ./script.pl
|
|
|
|
|
```
|
|
|
|
|
|
|
|
|
|
- Updates to documentation:
|
|
|
|
|
- Describe changing the verify_SSL value
|
|
|
|
|
- Describe the escape-hatch environment variable
|
|
|
|
|
- Remove rationale for not enabling verify_SSL
|
|
|
|
|
- Add missing certificate search paths
|
|
|
|
|
- Replace "SSL" with "TLS/SSL" where appropriate
|
|
|
|
|
- Use "machine-in-the-middle" instead of "man-in-the-middle"
|
|
|
|
|
|
|
|
|
|
- Update `210_live_ssl.t`
|
|
|
|
|
- Use github.com, cpan.org and badssl.com hosts for checking
|
|
|
|
|
certificates.
|
|
|
|
|
- Add self signed snake-oil certificate for checking failures rather
|
|
|
|
|
than bypassing the `SSL_verify_callback`
|
|
|
|
|
- Test `verify_SSL` parameter in addition to low level SSL_options
|
|
|
|
|
- Test that `PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1` behaves as
|
|
|
|
|
expected against badssl.com
|
|
|
|
|
|
|
|
|
|
- Added `180_verify_SSL.t`
|
|
|
|
|
- Test that `verify_SSL` default is `1`
|
|
|
|
|
- Test that `PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT` behaves as expected
|
|
|
|
|
- Test that using different values for `verify_SSL` and legacy `verify_ssl`
|
|
|
|
|
doesn't disable cert checks
|
|
|
|
|
|
|
|
|
|
Backported from HTTP::Tiny 0.083
|
|
|
|
|
|
|
|
|
|
---
|
|
|
|
|
lib/HTTP/Tiny.pm | 86 ++++++++++++++++++----------
|
|
|
|
|
t/180_verify_SSL.t | 109 ++++++++++++++++++++++++++++++++++++
|
|
|
|
|
t/210_live_ssl.t | 136 ++++++++++++++++++++++++++++++---------------
|
|
|
|
|
t/snake-oil.crt | 33 +++++++++++
|
|
|
|
|
4 files changed, 291 insertions(+), 73 deletions(-)
|
|
|
|
|
create mode 100644 t/180_verify_SSL.t
|
|
|
|
|
create mode 100644 t/snake-oil.crt
|
|
|
|
|
|
|
|
|
|
diff --git a/lib/HTTP/Tiny.pm b/lib/HTTP/Tiny.pm
|
|
|
|
|
index 2ece5ca..58be640 100644
|
|
|
|
|
--- a/lib/HTTP/Tiny.pm
|
|
|
|
|
+++ b/lib/HTTP/Tiny.pm
|
|
|
|
|
@@ -39,10 +39,14 @@ sub _croak { require Carp; Carp::croak(@
|
|
|
|
|
#pod C<$ENV{no_proxy}> —)
|
|
|
|
|
#pod * C<timeout> — Request timeout in seconds (default is 60) If a socket open,
|
|
|
|
|
#pod read or write takes longer than the timeout, an exception is thrown.
|
|
|
|
|
-#pod * C<verify_SSL> — A boolean that indicates whether to validate the SSL
|
|
|
|
|
-#pod certificate of an C<https> — connection (default is false)
|
|
|
|
|
+#pod * C<verify_SSL> — A boolean that indicates whether to validate the TLS/SSL
|
|
|
|
|
+#pod certificate of an C<https> ? connection (default is true). Changed from false
|
|
|
|
|
+#pod to true for CVE-2023-31486.
|
|
|
|
|
#pod * C<SSL_options> — A hashref of C<SSL_*> — options to pass through to
|
|
|
|
|
#pod L<IO::Socket::SSL>
|
|
|
|
|
+#pod * C<$ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT}> - Changes the default
|
|
|
|
|
+#pod certificate verification behavior to not check server identity if set to 1.
|
|
|
|
|
+#pod Only effective if C<verify_SSL> is not set. Added for CVE-2023-31486.
|
|
|
|
|
#pod
|
|
|
|
|
#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
|
|
|
|
|
#pod prevent getting the corresponding proxies from the environment.
|
|
|
|
|
@@ -108,11 +112,17 @@ sub timeout {
|
|
|
|
|
sub new {
|
|
|
|
|
my($class, %args) = @_;
|
|
|
|
|
|
|
|
|
|
+ # Support lower case verify_ssl argument, but only if verify_SSL is not
|
|
|
|
|
+ # true.
|
|
|
|
|
+ if ( exists $args{verify_ssl} ) {
|
|
|
|
|
+ $args{verify_SSL} ||= $args{verify_ssl};
|
|
|
|
|
+ }
|
|
|
|
|
+
|
|
|
|
|
my $self = {
|
|
|
|
|
max_redirect => 5,
|
|
|
|
|
timeout => defined $args{timeout} ? $args{timeout} : 60,
|
|
|
|
|
keep_alive => 1,
|
|
|
|
|
- verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
|
|
|
|
|
+ verify_SSL => defined $args{verify_SSL} ? $args{verify_SSL} : _verify_SSL_default(),
|
|
|
|
|
no_proxy => $ENV{no_proxy},
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
@@ -131,6 +141,13 @@ sub new {
|
|
|
|
|
return $self;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
+sub _verify_SSL_default {
|
|
|
|
|
+ my ($self) = @_;
|
|
|
|
|
+ # Check if insecure default certificate verification behaviour has been
|
|
|
|
|
+ # changed by the user by setting PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1
|
|
|
|
|
+ return (($ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} || '') eq '1') ? 0 : 1;
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
sub _set_proxies {
|
|
|
|
|
my ($self) = @_;
|
|
|
|
|
|
|
|
|
|
@@ -1034,7 +1051,7 @@ sub new {
|
|
|
|
|
timeout => 60,
|
|
|
|
|
max_line_size => 16384,
|
|
|
|
|
max_header_lines => 64,
|
|
|
|
|
- verify_SSL => 0,
|
|
|
|
|
+ verify_SSL => HTTP::Tiny::_verify_SSL_default(),
|
|
|
|
|
SSL_options => {},
|
|
|
|
|
%args
|
|
|
|
|
}, $class;
|
|
|
|
|
@@ -2005,11 +2022,11 @@ proxy
|
|
|
|
|
timeout
|
|
|
|
|
verify_SSL
|
|
|
|
|
|
|
|
|
|
-=head1 SSL SUPPORT
|
|
|
|
|
+=head1 TLS/SSL SUPPORT
|
|
|
|
|
|
|
|
|
|
Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
|
|
|
|
|
greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
|
|
|
|
|
-thrown if new enough versions of these modules are not installed or if the SSL
|
|
|
|
|
+thrown if new enough versions of these modules are not installed or if the TLS
|
|
|
|
|
encryption fails. You can also use C<HTTP::Tiny::can_ssl()> utility function
|
|
|
|
|
that returns boolean to see if the required modules are installed.
|
|
|
|
|
|
|
|
|
|
@@ -2017,7 +2034,7 @@ An C<https> connection may be made via a
|
|
|
|
|
command (i.e. RFC 2817). You may not proxy C<https> via a proxy that itself
|
|
|
|
|
requires C<https> to communicate.
|
|
|
|
|
|
|
|
|
|
-SSL provides two distinct capabilities:
|
|
|
|
|
+TLS/SSL provides two distinct capabilities:
|
|
|
|
|
|
|
|
|
|
=over 4
|
|
|
|
|
|
|
|
|
|
@@ -2031,24 +2048,17 @@ Verification of server identity
|
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
-B<By default, HTTP::Tiny does not verify server identity>.
|
|
|
|
|
+B<By default, HTTP::Tiny verifies server identity>.
|
|
|
|
|
|
|
|
|
|
-Server identity verification is controversial and potentially tricky because it
|
|
|
|
|
-depends on a (usually paid) third-party Certificate Authority (CA) trust model
|
|
|
|
|
-to validate a certificate as legitimate. This discriminates against servers
|
|
|
|
|
-with self-signed certificates or certificates signed by free, community-driven
|
|
|
|
|
-CA's such as L<CAcert.org|http://cacert.org>.
|
|
|
|
|
-
|
|
|
|
|
-By default, HTTP::Tiny does not make any assumptions about your trust model,
|
|
|
|
|
-threat level or risk tolerance. It just aims to give you an encrypted channel
|
|
|
|
|
-when you need one.
|
|
|
|
|
-
|
|
|
|
|
-Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
|
|
|
|
|
-that an SSL connection has a valid SSL certificate corresponding to the host
|
|
|
|
|
-name of the connection and that the SSL certificate has been verified by a CA.
|
|
|
|
|
-Assuming you trust the CA, this will protect against a L<man-in-the-middle
|
|
|
|
|
-attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>. If you are
|
|
|
|
|
-concerned about security, you should enable this option.
|
|
|
|
|
+This was changed for CVE-2023-31486 due to security concerns. The previous default
|
|
|
|
|
+behavior can be enabled by setting C<$ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT}>
|
|
|
|
|
+to 1.
|
|
|
|
|
+
|
|
|
|
|
+Verification is done by checking that that the TLS/SSL connection has a valid
|
|
|
|
|
+certificate corresponding to the host name of the connection and that the
|
|
|
|
|
+certificate has been verified by a CA. Assuming you trust the CA, this will
|
|
|
|
|
+protect against L<machine-in-the-middle
|
|
|
|
|
+attacks|http://en.wikipedia.org/wiki/Machine-in-the-middle_attack>.
|
|
|
|
|
|
|
|
|
|
Certificate verification requires a file containing trusted CA certificates.
|
|
|
|
|
|
|
|
|
|
@@ -2056,9 +2066,7 @@ If the environment variable C<SSL_CERT_F
|
|
|
|
|
will try to find a CA certificate file in that location.
|
|
|
|
|
|
|
|
|
|
If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
|
|
|
|
|
-included with it as a source of trusted CA's. (This means you trust Mozilla,
|
|
|
|
|
-the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
|
|
|
|
|
-toolchain used to install it, and your operating system security, right?)
|
|
|
|
|
+included with it as a source of trusted CA's.
|
|
|
|
|
|
|
|
|
|
If that module is not available, then HTTP::Tiny will search several
|
|
|
|
|
system-specific default locations for a CA certificate file:
|
|
|
|
|
@@ -2077,13 +2085,33 @@ system-specific default locations for a
|
|
|
|
|
|
|
|
|
|
/etc/ssl/ca-bundle.pem
|
|
|
|
|
|
|
|
|
|
+=item *
|
|
|
|
|
+
|
|
|
|
|
+/etc/openssl/certs/ca-certificates.crt
|
|
|
|
|
+
|
|
|
|
|
+=item *
|
|
|
|
|
+
|
|
|
|
|
+/etc/ssl/cert.pem
|
|
|
|
|
+
|
|
|
|
|
+=item *
|
|
|
|
|
+
|
|
|
|
|
+/usr/local/share/certs/ca-root-nss.crt
|
|
|
|
|
+
|
|
|
|
|
+=item *
|
|
|
|
|
+
|
|
|
|
|
+/etc/pki/tls/cacert.pem
|
|
|
|
|
+
|
|
|
|
|
+=item *
|
|
|
|
|
+
|
|
|
|
|
+/etc/certs/ca-certificates.crt
|
|
|
|
|
+
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
An exception will be raised if C<verify_SSL> is true and no CA certificate file
|
|
|
|
|
is available.
|
|
|
|
|
|
|
|
|
|
-If you desire complete control over SSL connections, the C<SSL_options> attribute
|
|
|
|
|
-lets you provide a hash reference that will be passed through to
|
|
|
|
|
+If you desire complete control over TLS/SSL connections, the C<SSL_options>
|
|
|
|
|
+attribute lets you provide a hash reference that will be passed through to
|
|
|
|
|
C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
|
|
|
|
|
example, to provide your own trusted CA file:
|
|
|
|
|
|
|
|
|
|
@@ -2093,7 +2121,7 @@ example, to provide your own trusted CA
|
|
|
|
|
|
|
|
|
|
The C<SSL_options> attribute could also be used for such things as providing a
|
|
|
|
|
client certificate for authentication to a server or controlling the choice of
|
|
|
|
|
-cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
|
|
|
|
|
+cipher used for the TLS/SSL connection. See L<IO::Socket::SSL> documentation for
|
|
|
|
|
details.
|
|
|
|
|
|
|
|
|
|
=head1 PROXY SUPPORT
|
|
|
|
|
diff --git a/t/180_verify_SSL.t b/t/180_verify_SSL.t
|
|
|
|
|
new file mode 100644
|
|
|
|
|
index 0000000..d6bc412
|
|
|
|
|
--- /dev/null
|
|
|
|
|
+++ b/t/180_verify_SSL.t
|
|
|
|
|
@@ -0,0 +1,109 @@
|
|
|
|
|
+#!perl
|
|
|
|
|
+
|
|
|
|
|
+use strict;
|
|
|
|
|
+use warnings;
|
|
|
|
|
+use Test::More 0.88;
|
|
|
|
|
+use lib 't';
|
|
|
|
|
+
|
|
|
|
|
+use HTTP::Tiny;
|
|
|
|
|
+
|
|
|
|
|
+delete $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT};
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ my $ht = HTTP::Tiny->new();
|
|
|
|
|
+ is($ht->verify_SSL, 1, "verify_SSL is 1 by default");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_SSL => 0
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 0, "verify_SSL=>0 sets 0");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_ssl => 0
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 0, "verify_ssl=>0 sets 0");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_SSL => 1,
|
|
|
|
|
+ verify_ssl => 0
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 1, "verify_SSL=>1 and verify_ssl=>0 sets 1");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_SSL => 0,
|
|
|
|
|
+ verify_ssl => 1
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 1, "verify_SSL=>0 and verify_ssl=>1 sets 1");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_SSL => 0,
|
|
|
|
|
+ verify_ssl => 0
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 0, "verify_SSL=>0 and verify_ssl=>0 sets 0");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = "1";
|
|
|
|
|
+ my $ht = HTTP::Tiny->new();
|
|
|
|
|
+ is($ht->verify_SSL, 0, "PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1 changes verify_SSL default to 0");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = "0";
|
|
|
|
|
+ my $ht = HTTP::Tiny->new();
|
|
|
|
|
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=0 keeps verify_SSL default at 1");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = "False";
|
|
|
|
|
+ my $ht = HTTP::Tiny->new();
|
|
|
|
|
+ is($ht->verify_SSL, 1, "Unsupported PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=False keeps verify_SSL default at 1");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = "1";
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(verify_SSL=>1);
|
|
|
|
|
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1 does not override verify_SSL attribute set to 1");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = "1";
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_SSL => 1,
|
|
|
|
|
+ verify_ssl => 1
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1, verify_SSL=>1 and verify_ssl=>1 sets 1");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = "1";
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_SSL => 1,
|
|
|
|
|
+ verify_ssl => 0
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1, verify_SSL=>1 and verify_ssl=>0 sets 1");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = "1";
|
|
|
|
|
+ my $ht = HTTP::Tiny->new(
|
|
|
|
|
+ verify_SSL => 0,
|
|
|
|
|
+ verify_ssl => 0
|
|
|
|
|
+ );
|
|
|
|
|
+ is($ht->verify_SSL, 0, "PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1, verify_SSL=>0 and verify_ssl=>0 sets 0");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+done_testing;
|
|
|
|
|
+
|
|
|
|
|
diff --git a/t/210_live_ssl.t b/t/210_live_ssl.t
|
|
|
|
|
index 6f80e51..7b84f93 100644
|
|
|
|
|
--- a/t/210_live_ssl.t
|
|
|
|
|
+++ b/t/210_live_ssl.t
|
|
|
|
|
@@ -18,6 +18,8 @@ BEGIN {
|
|
|
|
|
}
|
|
|
|
|
use HTTP::Tiny;
|
|
|
|
|
|
|
|
|
|
+delete $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT};
|
|
|
|
|
+
|
|
|
|
|
plan skip_all => 'Only run for $ENV{AUTOMATED_TESTING}'
|
|
|
|
|
unless $ENV{AUTOMATED_TESTING};
|
|
|
|
|
|
|
|
|
|
@@ -27,33 +29,73 @@ if ( can_run('openssl') ) {
|
|
|
|
|
diag "\nNote: running test with ", qx/openssl version/;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
-my $data = {
|
|
|
|
|
- 'https://www.google.ca/' => {
|
|
|
|
|
- host => 'www.google.ca',
|
|
|
|
|
- pass => { SSL_verifycn_scheme => 'http', SSL_verifycn_name => 'www.google.ca', SSL_verify_mode => 0x01, SSL_ca_file => Mozilla::CA::SSL_ca_file() },
|
|
|
|
|
- fail => { SSL_verify_callback => sub { 0 }, SSL_verify_mode => 0x01 },
|
|
|
|
|
- default_should_yield => '1',
|
|
|
|
|
- },
|
|
|
|
|
- 'https://twitter.com/' => {
|
|
|
|
|
- host => 'twitter.com',
|
|
|
|
|
- pass => { SSL_verifycn_scheme => 'http', SSL_verifycn_name => 'twitter.com', SSL_verify_mode => 0x01, SSL_ca_file => Mozilla::CA::SSL_ca_file() },
|
|
|
|
|
- fail => { SSL_verify_callback => sub { 0 }, SSL_verify_mode => 0x01 },
|
|
|
|
|
- default_should_yield => '1',
|
|
|
|
|
- },
|
|
|
|
|
- 'https://github.com/' => {
|
|
|
|
|
- host => 'github.com',
|
|
|
|
|
- pass => { SSL_verifycn_scheme => 'http', SSL_verifycn_name => 'github.com', SSL_verify_mode => 0x01, SSL_ca_file => Mozilla::CA::SSL_ca_file() },
|
|
|
|
|
- fail => { SSL_verify_callback => sub { 0 }, SSL_verify_mode => 0x01 },
|
|
|
|
|
- default_should_yield => '1',
|
|
|
|
|
- },
|
|
|
|
|
- 'https://spinrite.com/' => {
|
|
|
|
|
- host => 'spinrite.com',
|
|
|
|
|
- pass => { SSL_verifycn_scheme => 'none', SSL_verifycn_name => 'spinrite.com', SSL_verify_mode => 0x00 },
|
|
|
|
|
- fail => { SSL_verifycn_scheme => 'http', SSL_verifycn_name => 'spinrite.com', SSL_verify_mode => 0x01, SSL_ca_file => Mozilla::CA::SSL_ca_file() },
|
|
|
|
|
- default_should_yield => '',
|
|
|
|
|
- }
|
|
|
|
|
-};
|
|
|
|
|
-plan tests => 1+ scalar keys %$data;
|
|
|
|
|
+test_ssl('https://cpan.org/' => {
|
|
|
|
|
+ host => 'cpan.org',
|
|
|
|
|
+ pass => { verify_SSL => 1 },
|
|
|
|
|
+ fail => { verify_SSL => 1, SSL_options => { SSL_ca_file => "t/snake-oil.crt" } },
|
|
|
|
|
+ default_verify_should_return => !!1,
|
|
|
|
|
+});
|
|
|
|
|
+
|
|
|
|
|
+test_ssl('https://github.com/' => {
|
|
|
|
|
+ host => 'github.com',
|
|
|
|
|
+ pass => { verify_SSL => 1 },
|
|
|
|
|
+ fail => { verify_SSL => 1, SSL_options => { SSL_ca_file => "t/snake-oil.crt" } },
|
|
|
|
|
+ default_verify_should_return => !!1,
|
|
|
|
|
+});
|
|
|
|
|
+
|
|
|
|
|
+test_ssl('https://wrong.host.badssl.com/' => {
|
|
|
|
|
+ host => 'wrong.host.badssl.com',
|
|
|
|
|
+ pass => { SSL_options => { SSL_verifycn_scheme => 'none', SSL_verifycn_name => 'wrong.host.badssl.com', SSL_verify_mode => 0x00 } },
|
|
|
|
|
+ fail => { SSL_options => { SSL_verifycn_scheme => 'http', SSL_verifycn_name => 'wrong.host.badssl.com', SSL_verify_mode => 0x01, SSL_ca_file => Mozilla::CA::SSL_ca_file() } },
|
|
|
|
|
+ default_verify_should_return => !!0,
|
|
|
|
|
+});
|
|
|
|
|
+
|
|
|
|
|
+test_ssl('https://untrusted-root.badssl.com/' => {
|
|
|
|
|
+ host => 'untrusted-root.badssl.com',
|
|
|
|
|
+ pass => { verify_SSL => 0 },
|
|
|
|
|
+ fail => { verify_SSL => 1 },
|
|
|
|
|
+ default_verify_should_return => !!0,
|
|
|
|
|
+});
|
|
|
|
|
+
|
|
|
|
|
+test_ssl('https://mozilla-modern.badssl.com/' => {
|
|
|
|
|
+ host => 'mozilla-modern.badssl.com',
|
|
|
|
|
+ pass => { verify_SSL => 1 },
|
|
|
|
|
+ fail => { verify_SSL => 1, SSL_options => { SSL_ca_file => "t/snake-oil.crt" } },
|
|
|
|
|
+ default_verify_should_return => !!1,
|
|
|
|
|
+});
|
|
|
|
|
+
|
|
|
|
|
+{
|
|
|
|
|
+ local $ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} = 1;
|
|
|
|
|
+ test_ssl('https://wrong.host.badssl.com/' => {
|
|
|
|
|
+ host => 'wrong.host.badssl.com',
|
|
|
|
|
+ pass => { verify_SSL => 0 },
|
|
|
|
|
+ fail => { verify_SSL => 1 },
|
|
|
|
|
+ default_verify_should_return => !!1,
|
|
|
|
|
+ });
|
|
|
|
|
+ test_ssl('https://expired.badssl.com/' => {
|
|
|
|
|
+ host => 'expired.badssl.com',
|
|
|
|
|
+ pass => { verify_SSL => 0 },
|
|
|
|
|
+ fail => { verify_SSL => 1 },
|
|
|
|
|
+ default_verify_should_return => !!1,
|
|
|
|
|
+ });
|
|
|
|
|
+
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+test_ssl('https://wrong.host.badssl.com/' => {
|
|
|
|
|
+ host => 'wrong.host.badssl.com',
|
|
|
|
|
+ pass => { verify_SSL => 0 },
|
|
|
|
|
+ fail => { verify_SSL => 1 },
|
|
|
|
|
+ default_verify_should_return => !!0,
|
|
|
|
|
+});
|
|
|
|
|
+
|
|
|
|
|
+test_ssl('https://expired.badssl.com/' => {
|
|
|
|
|
+ host => 'expired.badssl.com',
|
|
|
|
|
+ pass => { verify_SSL => 0 },
|
|
|
|
|
+ fail => { verify_SSL => 1 },
|
|
|
|
|
+ default_verify_should_return => !!0,
|
|
|
|
|
+});
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
|
|
|
|
|
subtest "can_ssl" => sub {
|
|
|
|
|
ok( HTTP::Tiny->can_ssl, "class method" );
|
|
|
|
|
@@ -69,8 +111,10 @@ subtest "can_ssl" => sub {
|
|
|
|
|
like( $why, qr/not found or not readable/, "failure reason" );
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
+done_testing();
|
|
|
|
|
|
|
|
|
|
-while (my ($url, $data) = each %$data) {
|
|
|
|
|
+sub test_ssl {
|
|
|
|
|
+ my ($url, $data) = @_;
|
|
|
|
|
subtest $url => sub {
|
|
|
|
|
plan 'skip_all' => 'Internet connection timed out'
|
|
|
|
|
unless IO::Socket::INET->new(
|
|
|
|
|
@@ -81,8 +125,8 @@ while (my ($url, $data) = each %$data) {
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
# the default verification
|
|
|
|
|
- my $response = HTTP::Tiny->new(verify_ssl => 1)->get($url);
|
|
|
|
|
- is $response->{success}, $data->{default_should_yield}, "Request to $url passed/failed using default as expected"
|
|
|
|
|
+ my $response = HTTP::Tiny->new()->get($url);
|
|
|
|
|
+ is $response->{success}, $data->{default_verify_should_return}, "Request to $url passed/failed using default as expected"
|
|
|
|
|
or do {
|
|
|
|
|
# $response->{content} = substr $response->{content}, 0, 50;
|
|
|
|
|
$response->{content} =~ s{\n.*}{}s;
|
|
|
|
|
@@ -90,21 +134,25 @@ while (my ($url, $data) = each %$data) {
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
# force validation to succeed
|
|
|
|
|
- my $pass = HTTP::Tiny->new( SSL_options => $data->{pass} )->get($url);
|
|
|
|
|
- isnt $pass->{status}, '599', "Request to $url completed (forced pass)"
|
|
|
|
|
- or do {
|
|
|
|
|
- $pass->{content} =~ s{\n.*}{}s;
|
|
|
|
|
- diag explain $pass
|
|
|
|
|
- };
|
|
|
|
|
- ok $pass->{content}, 'Got some content';
|
|
|
|
|
+ if ($data->{pass}) {
|
|
|
|
|
+ my $pass = HTTP::Tiny->new( %{$data->{pass}} )->get($url);
|
|
|
|
|
+ isnt $pass->{status}, '599', "Request to $url completed (forced pass)"
|
|
|
|
|
+ or do {
|
|
|
|
|
+ $pass->{content} =~ s{\n.*}{}s;
|
|
|
|
|
+ diag explain $pass
|
|
|
|
|
+ };
|
|
|
|
|
+ ok $pass->{content}, 'Got some content';
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
|
|
# force validation to fail
|
|
|
|
|
- my $fail = HTTP::Tiny->new( SSL_options => $data->{fail} )->get($url);
|
|
|
|
|
- is $fail->{status}, '599', "Request to $url failed (forced fail)"
|
|
|
|
|
- or do {
|
|
|
|
|
- $fail->{content} =~ s{\n.*}{}s;
|
|
|
|
|
- diag explain [IO::Socket::SSL::errstr(), $fail]
|
|
|
|
|
- };
|
|
|
|
|
- ok $fail->{content}, 'Got some content';
|
|
|
|
|
+ if ($data->{fail}) {
|
|
|
|
|
+ my $fail = HTTP::Tiny->new( %{$data->{fail}} )->get($url);
|
|
|
|
|
+ is $fail->{status}, '599', "Request to $url failed (forced fail)"
|
|
|
|
|
+ or do {
|
|
|
|
|
+ $fail->{content} =~ s{\n.*}{}s;
|
|
|
|
|
+ diag explain [IO::Socket::SSL::errstr(), $fail]
|
|
|
|
|
+ };
|
|
|
|
|
+ ok $fail->{content}, 'Got some content';
|
|
|
|
|
+ }
|
|
|
|
|
};
|
|
|
|
|
}
|
|
|
|
|
diff --git a/t/snake-oil.crt b/t/snake-oil.crt
|
|
|
|
|
new file mode 100644
|
|
|
|
|
index 0000000..c0a5bdc
|
|
|
|
|
--- /dev/null
|
|
|
|
|
+++ b/t/snake-oil.crt
|
|
|
|
|
@@ -0,0 +1,33 @@
|
|
|
|
|
+Generated with:
|
|
|
|
|
+
|
|
|
|
|
+ openssl req -new -newkey rsa:4096 -x509 -new -nodes -sha256 -days 7300 -keyout /dev/null -out snake-oil.crt -subj '/CN=snake.oil/'
|
|
|
|
|
+
|
|
|
|
|
+-----BEGIN CERTIFICATE-----
|
|
|
|
|
+MIIFCTCCAvGgAwIBAgIUUUWe96AgoaW3pyYxlJfMxUMA6bgwDQYJKoZIhvcNAQEL
|
|
|
|
|
+BQAwFDESMBAGA1UEAwwJc25ha2Uub2lsMB4XDTIzMDUyMTE1NDkxMVoXDTQzMDUx
|
|
|
|
|
+NjE1NDkxMVowFDESMBAGA1UEAwwJc25ha2Uub2lsMIICIjANBgkqhkiG9w0BAQEF
|
|
|
|
|
+AAOCAg8AMIICCgKCAgEAnScXg4MGa6CmCFOYzr8ggzqsDAR0CoVdOaqQ6XtRoRcP
|
|
|
|
|
+PzptoqHDFtr4NqWwmeWAGIcey6CKFZXsm9LvPly/VUDDjctYZig3UoLaoQpygwae
|
|
|
|
|
+2BgslsfuhwomxXuinatF6bo1vz+EaRpASJyHOBOp3Yvh2cLSXmD+YuTU8rci1IG/
|
|
|
|
|
+FFmjsrftPsxKFZiI9meAtsGayQGdUIBsEvawhs5y7TDcblPfbBM21sg3touTrfzZ
|
|
|
|
|
+Yk9dXd7hX3uq5ZX4H9BWcqeGux3speYC2STClnGMl8DqGdAV4XssbFCVqIhvmzrW
|
|
|
|
|
+L6Ce9vt0x/gxQQB4EYJlvECSqm7IiwO85I8XJ04EzmVU4e2+c1B7WS/swhGLr8JJ
|
|
|
|
|
+4yk/gbCe98ErU3ccnXPzZznNQXTt2iAQLqa5zNDmxjzyZXhDA1nijg2cJb1RnQVu
|
|
|
|
|
+m5YrUXOXt9b5664nLCVUf0s/yMqPbcIUA3puAPS6BgDEExnYL48rmTT1gazMO6S5
|
|
|
|
|
+ZwpycEVkwYUFj364vIHJvQO0xB54dqNul9kMLUwPLmP9H6nBIsGgJhZCAp+WDEzp
|
|
|
|
|
+Y4eqp0drTlJlpfjd/QOaOsKZgwrqiD0yh35bj43zcVHKaFYGLcS8M1+XlbYNYx90
|
|
|
|
|
+w7+GpbY+MebCYF//dXAFXzORxdA1XZ30I7CAxAVK5l5cokrMIHJ01kkzYEGA1Y0C
|
|
|
|
|
+AwEAAaNTMFEwHQYDVR0OBBYEFAyj5N91aOt4TxNEOJ18JUPEBsOyMB8GA1UdIwQY
|
|
|
|
|
+MBaAFAyj5N91aOt4TxNEOJ18JUPEBsOyMA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZI
|
|
|
|
|
+hvcNAQELBQADggIBAHGiT2h0SU2tlFmUQ8CzgJ7JRTg91ltRwEvs/SQ/YN7DdDwt
|
|
|
|
|
+dQy/0nMIeFstdDIkdQyjcAUO92msLzd8AniiwAjynxamiQqdA57+rdhp7oEbFgw+
|
|
|
|
|
+nF56bG4tiBG1gAIxtY9f2sG/Sqf6UuimxOX43nybG8RdRu8hOh/TQXcj8raa2PMT
|
|
|
|
|
+pTdphjMJUKSplHtFpbLFuf5FxklpeAYxYAReMzQhVgTzi7fcz3QhT/l6eqK6G05v
|
|
|
|
|
+gi+QsgesMiGdHKiTtx8N70JFZ+8BzJ0CJDI8PR2XZTLbpKxNfk426hTjJBkRULT5
|
|
|
|
|
+s7IWuuEO4Bb1p27K2WgHGh0mxFk4POPFmotxupVqzl8g2umcfWLDq0UR3BcRyR3B
|
|
|
|
|
+GWZNCcDTVLaAsarbSJoY1L/6j4O0RQdgpOWiENLbEcelGprGLBVe4s/NDA6aUYA+
|
|
|
|
|
+2Dll+0tHe6oKI+RCRoDhhiAH7UVIGQdORzcbY3Fxbf1OlFdpOyXLI751b1DjSYRu
|
|
|
|
|
+9cVFXZIBRTTiEvGbUfoDEXDmKxpWHkGRel2864FBodcwGv7yW6mC3o6vpOqQFcW7
|
|
|
|
|
+MjJsFhtVj8PdPmue+ye766PeH45ydDD01nr1I92w6E1C0pEEqRNEpoOGgORyNgit
|
|
|
|
|
+EZag4DlWFs5MFdlj32haztRgi2dhVuJxlzx4lAmvOoqvGVQVIicN1JSlikBk
|
|
|
|
|
+-----END CERTIFICATE-----
|
|
|
|
|
--
|
|
|
|
|
2.41.0
|
|
|
|
|
|