Upgrade to 0.083 as provided in perl-5.37.12

This commit is contained in:
Jitka Plesnikova 2023-06-12 15:19:33 +02:00
parent b7eeef95a4
commit 95ebff9a65
2 changed files with 652 additions and 6 deletions

View File

@ -0,0 +1,640 @@
From 5e3716163dac9ca2b6249ee7683b023aba6e101a Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Mon, 12 Jun 2023 14:59:50 +0200
Subject: [PATCH] Upgrade to 0.083
---
corpus/snake-oil.crt | 33 ++++++++++
lib/HTTP/Tiny.pm | 105 +++++++++++++++++++++-----------
t/00-report-prereqs.t | 18 +++---
t/001_api.t | 0
t/180_verify_SSL.t | 109 +++++++++++++++++++++++++++++++++
t/210_live_ssl.t | 136 ++++++++++++++++++++++++++++--------------
6 files changed, 316 insertions(+), 85 deletions(-)
create mode 100644 corpus/snake-oil.crt
mode change 100755 => 100644 t/001_api.t
create mode 100644 t/180_verify_SSL.t
diff --git a/corpus/snake-oil.crt b/corpus/snake-oil.crt
new file mode 100644
index 0000000..c0a5bdc
--- /dev/null
+++ b/corpus/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-----
diff --git a/lib/HTTP/Tiny.pm b/lib/HTTP/Tiny.pm
index 48da104..180686d 100644
--- a/lib/HTTP/Tiny.pm
+++ b/lib/HTTP/Tiny.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
# ABSTRACT: A small, simple, correct HTTP/1.1 client
-our $VERSION = '0.082';
+our $VERSION = '0.083'; # TRIAL
sub _croak { require Carp; Carp::croak(@_) }
@@ -40,10 +40,15 @@ sub _croak { require Carp; Carp::croak(@_) }
#pod * C<timeout> — Request timeout in seconds (default is 60) If a socket open,
#pod read or write takes longer than the timeout, the request response status code
#pod will be 599.
-#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 in version 0.083.
#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 in version 0.083.
+#pod
#pod
#pod An accessor/mutator method exists for each attribute.
#pod
@@ -111,11 +116,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},
};
@@ -134,6 +145,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_INSECURE_BY_DEFAULT} || '') eq '1') ? 0 : 1;
+}
+
sub _set_proxies {
my ($self) = @_;
@@ -1060,7 +1078,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;
@@ -1709,7 +1727,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client
=head1 VERSION
-version 0.082
+version 0.083
=head1 SYNOPSIS
@@ -1802,12 +1820,16 @@ C<timeout> — Request timeout in seconds (default is 60) If a socket open, read
=item *
-C<verify_SSL> — A boolean that indicates whether to validate the SSL certificate of an C<https> — connection (default is false)
+C<verify_SSL> — A boolean that indicates whether to validate the TLS/SSL certificate of an C<https> — connection (default is true). Changed from false to true in version 0.083.
=item *
C<SSL_options> — A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>
+=item *
+
+C<$ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT}> - Changes the default certificate verification behavior to not check server identity if set to 1. Only effective if C<verify_SSL> is not set. Added in version 0.083.
+
=back
An accessor/mutator method exists for each attribute.
@@ -2052,11 +2074,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 error will occur
-if new enough versions of these modules are not installed or if the SSL
+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.
@@ -2064,7 +2086,7 @@ An C<https> connection may be made via an C<http> proxy that supports the CONNEC
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
@@ -2078,24 +2100,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>.
+This was changed in version 0.083 due to security concerns. The previous default
+behavior can be enabled by setting C<$ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT}>
+to 1.
-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.
+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.
@@ -2103,9 +2118,7 @@ If the environment variable C<SSL_CERT_FILE> is present, HTTP::Tiny
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:
@@ -2124,13 +2137,33 @@ system-specific default locations for a CA certificate file:
/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 error will be occur 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:
@@ -2140,7 +2173,7 @@ example, to provide your own trusted CA file:
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
@@ -2346,7 +2379,7 @@ David Golden <dagolden@cpan.org>
=head1 CONTRIBUTORS
-=for stopwords Alan Gardner Alessandro Ghedini A. Sinan Unur Brad Gilbert brian m. carlson Chris Nehren Weyl Claes Jakobsson Clinton Gormley Craig Berry David Golden Mitchell Dean Pearce Edward Zborowski Felipe Gasper Graham Knop Greg Kennedy James E Keenan Raspass Jeremy Mates Jess Robinson Karen Etheridge Lukas Eklund Martin J. Evans Martin-Louis Bright Matthew Horsfall Michael R. Davis Mike Doherty Nicolas Rochelemagne Olaf Alders Olivier Mengué Petr Písař sanjay-cpu Serguei Trouchelle Shoichi Kaji SkyMarshal Sören Kornetzki Steve Grazzini Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook Xavier Guimard
+=for stopwords Alan Gardner Alessandro Ghedini A. Sinan Unur Brad Gilbert brian m. carlson Chris Nehren Weyl Claes Jakobsson Clinton Gormley Craig Berry David Golden Mitchell Dean Pearce Edward Zborowski Felipe Gasper Graham Knop Greg Kennedy James E Keenan Raspass Jeremy Mates Jess Robinson Karen Etheridge Lukas Eklund Martin J. Evans Martin-Louis Bright Matthew Horsfall Michael R. Davis Mike Doherty Nicolas Rochelemagne Olaf Alders Olivier Mengué Petr Písař sanjay-cpu Serguei Trouchelle Shoichi Kaji SkyMarshal Sören Kornetzki Steve Grazzini Stig Palmquist Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook Xavier Guimard
=over 4
@@ -2508,6 +2541,10 @@ Steve Grazzini <steve.grazzini@grantstreet.com>
=item *
+Stig Palmquist <git@stig.io>
+
+=item *
+
Syohei YOSHIDA <syohex@gmail.com>
=item *
@@ -2530,7 +2567,7 @@ Xavier Guimard <yadd@debian.org>
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2022 by Christian Hansen.
+This software is copyright (c) 2023 by Christian Hansen.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/t/00-report-prereqs.t b/t/00-report-prereqs.t
index c3a94ca..5696476 100644
--- a/t/00-report-prereqs.t
+++ b/t/00-report-prereqs.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.028
+# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029
use Test::More tests => 1;
@@ -109,20 +109,24 @@ for my $phase ( qw(configure build test runtime develop other) ) {
my @reports = [qw/Module Want Have/];
for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
- next if $mod eq 'perl';
next if grep { $_ eq $mod } @exclude;
- my $file = $mod;
- $file =~ s{::}{/}g;
- $file .= ".pm";
- my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
-
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
+ if ($mod eq 'perl') {
+ push @reports, ['perl', $want, $]];
+ next;
+ }
+
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
+ my $file = $mod;
+ $file =~ s{::}{/}g;
+ $file .= ".pm";
+ my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
+
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
diff --git a/t/001_api.t b/t/001_api.t
old mode 100755
new mode 100644
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_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_INSECURE_BY_DEFAULT} = "1";
+ my $ht = HTTP::Tiny->new();
+ is($ht->verify_SSL, 0, "PERL_HTTP_TINY_INSECURE_BY_DEFAULT=1 changes verify_SSL default to 0");
+}
+
+{
+ local $ENV{PERL_HTTP_TINY_INSECURE_BY_DEFAULT} = "0";
+ my $ht = HTTP::Tiny->new();
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_INSECURE_BY_DEFAULT=0 keeps verify_SSL default at 1");
+}
+
+{
+ local $ENV{PERL_HTTP_TINY_INSECURE_BY_DEFAULT} = "False";
+ my $ht = HTTP::Tiny->new();
+ is($ht->verify_SSL, 1, "Unsupported PERL_HTTP_TINY_INSECURE_BY_DEFAULT=False keeps verify_SSL default at 1");
+}
+
+{
+ local $ENV{PERL_HTTP_TINY_INSECURE_BY_DEFAULT} = "1";
+ my $ht = HTTP::Tiny->new(verify_SSL=>1);
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_INSECURE_BY_DEFAULT=1 does not override verify_SSL attribute set to 1");
+}
+
+{
+ local $ENV{PERL_HTTP_TINY_INSECURE_BY_DEFAULT} = "1";
+ my $ht = HTTP::Tiny->new(
+ verify_SSL => 1,
+ verify_ssl => 1
+ );
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_INSECURE_BY_DEFAULT=1, verify_SSL=>1 and verify_ssl=>1 sets 1");
+}
+
+{
+ local $ENV{PERL_HTTP_TINY_INSECURE_BY_DEFAULT} = "1";
+ my $ht = HTTP::Tiny->new(
+ verify_SSL => 1,
+ verify_ssl => 0
+ );
+ is($ht->verify_SSL, 1, "PERL_HTTP_TINY_INSECURE_BY_DEFAULT=1, verify_SSL=>1 and verify_ssl=>0 sets 1");
+}
+
+{
+ local $ENV{PERL_HTTP_TINY_INSECURE_BY_DEFAULT} = "1";
+ my $ht = HTTP::Tiny->new(
+ verify_SSL => 0,
+ verify_ssl => 0
+ );
+ is($ht->verify_SSL, 0, "PERL_HTTP_TINY_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..4be05cd 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_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 => "corpus/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 => "corpus/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 => "corpus/snake-oil.crt" } },
+ default_verify_should_return => !!1,
+});
+
+{
+ local $ENV{PERL_HTTP_TINY_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';
+ }
};
}
--
2.40.1

View File

@ -1,16 +1,20 @@
%global base_version 0.082
# Run optional test
%bcond_without perl_HTTP_Tiny_enables_optional_deps
Name: perl-HTTP-Tiny
Version: 0.082
Release: 2%{?dist}
Version: 0.083
Release: 1%{?dist}
Summary: Small, simple, correct HTTP/1.1 client
License: GPL-1.0-or-later OR Artistic-1.0-Perl
URL: https://metacpan.org/release/HTTP-Tiny
Source0: https://cpan.metacpan.org/authors/id/D/DA/DAGOLDEN/HTTP-Tiny-%{version}.tar.gz
Source0: https://cpan.metacpan.org/authors/id/D/DA/DAGOLDEN/HTTP-Tiny-%{base_version}.tar.gz
# Unbundled from perl 5.37.12
Patch0: HTTP-Tiny-0.082-Upgrade-to-0.083.patch
# Check for write failure, bug #1031096, refused by upstream,
# <https://github.com/chansen/p5-http-tiny/issues/32>
Patch0: HTTP-Tiny-0.070-Croak-on-failed-write-into-a-file.patch
Patch1: HTTP-Tiny-0.070-Croak-on-failed-write-into-a-file.patch
BuildArch: noarch
BuildRequires: coreutils
BuildRequires: make
@ -86,8 +90,7 @@ Tests from %{name}. Execute them
with "%{_libexecdir}/%{name}/test".
%prep
%setup -q -n HTTP-Tiny-%{version}
%patch0 -p1
%autosetup -p1 -n HTTP-Tiny-%{base_version}
# Help generators to recognize Perl scripts
for F in t/*.t; do
@ -126,6 +129,9 @@ make test
%{_libexecdir}/%{name}
%changelog
* Mon Jun 12 2023 Jitka Plesnikova <jplesnik@redhat.com> - 0.083-1
- Upgrade to 0.083 as provided in perl-5.37.12
* Fri Jan 20 2023 Fedora Release Engineering <releng@fedoraproject.org> - 0.082-2
- Rebuilt for https://fedoraproject.org/wiki/Fedora_38_Mass_Rebuild