Hello community,
here is the log from the commit of package perl-IO-Socket-SSL for
openSUSE:Factory checked in at 2014-02-12 17:32:12
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-IO-Socket-SSL (Old)
and /work/SRC/openSUSE:Factory/.perl-IO-Socket-SSL.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-IO-Socket-SSL"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-IO-Socket-SSL/perl-IO-Socket-SSL.changes
2013-11-29 16:25:10.000000000 +0100
+++
/work/SRC/openSUSE:Factory/.perl-IO-Socket-SSL.new/perl-IO-Socket-SSL.changes
2014-02-12 17:32:13.000000000 +0100
@@ -1,0 +2,37 @@
+Sun Feb 9 13:30:59 UTC 2014 - [email protected]
+
+- updated to 1.967
+ - verify the hostname inside a certificate by default with a superset of
+ common verification schemes instead of not verifying identity at all.
+ For now it will only complain if name verification failed, in the future
+ it will fail certificate verification, forcing you to set the expected
+ SSL_verifycn_name if you want to accept the certificate.
+ - new option SSL_fingerprint and new methods get_fingerprint and
+ get_fingerprint_bin. Together they can be used to selectively accept
+ specific certificates which would otherwise fail verification, like
+ self-signed, outdated or from unknown CAs.
+ This makes another reason to disable verification obsolete.
+ - Utils:
+ - default RSA key length 2048
+ - digest algorithm to sign certificate in CERT_create can be given,
+ defaults to SHA-256
+ - CERT_create can now issue non-CA selfsigned certificate
+ - CERT_create add some more useful constraints to certificate
+ - spelling fixes, thanks to ville[dot]skytta[at]iki[dot]fi
+ 1.966 2014/01/21
+ - fixed bug introduced in 1.964 - disabling TLSv1_2 worked no longer with
+ specifying !TLSv12, only !TLSv1_2 worked
+ - fixed leak of session objects in SessionCache, if another session
+ replaced an existing session (introduced in 1.965)
+ 1.965 2014/01/16
+ - new key SSL_session_key to influence how sessions are inserted and looked
+ up in the clients session cache. This makes it possible to share sessions
+ over different ip:host (like required with some FTPS servers)
+ - t/core.t - handle case, were default loopback source is not 127.0.0.1, like
+ in FreeBSD jails
+ 1.964 2014/01/15
+ - Disabling TLSv1_1 did not work, because the constant was wrong. Now it gets
+ the constants from calling Net::SSLeay::SSL_OP_NO_TLSv1_1 etc
+ - The new syntax for the protocols is TLSv1_1 instead of TLSv11.
+
+-------------------------------------------------------------------
Old:
----
IO-Socket-SSL-1.962.tar.gz
New:
----
IO-Socket-SSL-1.967.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-IO-Socket-SSL.spec ++++++
--- /var/tmp/diff_new_pack.nL0kEE/_old 2014-02-12 17:32:14.000000000 +0100
+++ /var/tmp/diff_new_pack.nL0kEE/_new 2014-02-12 17:32:14.000000000 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-IO-Socket-SSL
#
-# Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2014 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,7 +17,7 @@
Name: perl-IO-Socket-SSL
-Version: 1.962
+Version: 1.967
Release: 0
%define cpan_name IO-Socket-SSL
Summary: Nearly transparent SSL encapsulation for IO::Socket::INET.
@@ -43,8 +43,11 @@
verification, Server Name Indication (SNI), Next Protocol Negotiation
(NPN), SSL version selection and more.
-If you have never used SSL before, you should read the appendix labelled
-'Using SSL' before attempting to use this module.
+If you have never used SSL before, you should read the section 'Using SSL'
+before attempting to use this module.
+
+If you used IO::Socket before you should read the following section
+'Differences to IO::Socket'.
If you want to use SSL with non-blocking sockets and/or within an event
loop please read very carefully the sections about non-blocking I/O and
++++++ IO-Socket-SSL-1.962.tar.gz -> IO-Socket-SSL-1.967.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/Changes
new/IO-Socket-SSL-1.967/Changes
--- old/IO-Socket-SSL-1.962/Changes 2013-11-27 22:08:38.000000000 +0100
+++ new/IO-Socket-SSL-1.967/Changes 2014-02-06 22:22:04.000000000 +0100
@@ -1,3 +1,51 @@
+1.967 2014/02/06
+- verify the hostname inside a certificate by default with a superset of
+ common verification schemes instead of not verifying identity at all.
+ For now it will only complain if name verification failed, in the future
+ it will fail certificate verification, forcing you to set the expected
+ SSL_verifycn_name if you want to accept the certificate.
+- new option SSL_fingerprint and new methods get_fingerprint and
+ get_fingerprint_bin. Together they can be used to selectively accept
+ specific certificates which would otherwise fail verification, like
+ self-signed, outdated or from unknown CAs.
+ This makes another reason to disable verification obsolete.
+- Utils:
+ - default RSA key length 2048
+ - digest algorithm to sign certificate in CERT_create can be given,
+ defaults to SHA-256
+ - CERT_create can now issue non-CA selfsigned certificate
+ - CERT_create add some more useful constraints to certificate
+- spelling fixes, thanks to ville[dot]skytta[at]iki[dot]fi
+1.966 2014/01/21
+- fixed bug introduced in 1.964 - disabling TLSv1_2 worked no longer with
+ specifying !TLSv12, only !TLSv1_2 worked
+- fixed leak of session objects in SessionCache, if another session
+ replaced an existing session (introduced in 1.965)
+1.965 2014/01/16
+- new key SSL_session_key to influence how sessions are inserted and looked
+ up in the clients session cache. This makes it possible to share sessions
+ over different ip:host (like required with some FTPS servers)
+- t/core.t - handle case, were default loopback source is not 127.0.0.1, like
+ in FreeBSD jails
+1.964 2014/01/15
+- Disabling TLSv1_1 did not work, because the constant was wrong. Now it gets
+ the constants from calling Net::SSLeay::SSL_OP_NO_TLSv1_1 etc
+- The new syntax for the protocols is TLSv1_1 instead of TLSv11. This matches
+ the syntax from OpenSSL. The old syntax continues to work in SSL_version.
+- New functions get_sslversion and get_sslversion_int which get the SSL version
+ of the establish session as string or int.
+- disable t/io-socket-inet6.t if Acme::Override::INET is installed
+1.963 2014/01/13
+- fix behavior of stop_SSL: for blocking sockets it now enough to call it
+ once, for non-blocking it should be called again as long as EAGAIN and
+ SSL_ERROR is set to SSL_WANT_(READ|WRITE).
+- don't call blocking if start_SSL failed and downgraded socket has no
+ blocking method, thanks to tokuhirom
+- documentation enhancements:
+ - special section for differences to IO::Socket
+ - describe problem with blocking accept on non-blocking socket
+ - describe arguments to new_from_fd and make clear, that for upgrading an
+ existing IO::Socket start_SSL should be used directly
1.962 2013/11/27
- work around problems with older F5 BIG-IP by offering fewer ciphers on the
client side by default, so that the client hello stays below 255 byte
@@ -43,10 +91,10 @@
- prefer ECDHE/DHE ciphers and add necessary ECDH curve and DH keys, so that
it uses by default forward secrecy, if underlying Net::SSLeay/openssl
supports it
- - move RC4 at the end, e.g. 3DES is prefered (BEAST attack should hopefully
+ - move RC4 at the end, e.g. 3DES is preferred (BEAST attack should hopefully
been fixed and now RC4 is considered less safe than 3DES)
- default SSL_honor_cipher_order to 1, e.g. when used as server it tries to
- get the best cipher even if client preferes other ciphers
+ get the best cipher even if client prefers other ciphers
PLEASE NOTE that this might break connections with older, less secure
implementations. In this case revert to 'ALL:!LOW:!EXP:!aNULL' or so.
- BEHAVIOR CHANGE: SSL_cipher_list now gets set on context not SSL object and
@@ -135,14 +183,14 @@
v1.85 2013.04.14
- probe for available modules with local __DIE__ and __WARN__handlers.
fixes RT#84574, thanks to FRAZER
-- fix warning, when IO::Socket::IP is installed and inet6 support gets
explictly
+- fix warning, when IO::Socket::IP is installed and inet6 support gets
explicitly
requested. RT#84619, thanks to Prashant[DOT]Tekriwal[AT]netapp[DOT]com
v1.84 2013.02.15
- disabled client side SNI for openssl version < 1.0.0 because of RT#83289
-- added functions can_client_sni, can_server_sni, can_npn to check avaibility
+- added functions can_client_sni, can_server_sni, can_npn to check availability
of SNI and NPN features. Added more documentation for SNI and NPN.
v1.83_1 2013.02.14
-- seperated documention of non-blocking I/O from error handling
+- separated documentation of non-blocking I/O from error handling
- changed and documented behavior of readline to return the read
data on EAGAIN/EWOULDBLOCK in case of non-blocking socket.
See https://github.com/noxxi/p5-io-socket-ssl/issues/1, thanks to
@@ -240,7 +288,7 @@
- added NPN (Next Protocol Negotiation) support based on patch from kmx
https://rt.cpan.org/Ticket/Display.html?id=76223
v1.64 2012.04.06
-- clarify some behavior regarding hostname verfication.
+- clarify some behavior regarding hostname verification.
Thanks to DOHERTY for reporting.
v1.63 2012.04.06
- applied patch of DOUGDUDE to ignore die from within eval to make tests
@@ -627,7 +675,7 @@
regarding $/ like written in the $/ dokumentation.
v0.996
-- removed links and comments to inofficial release of
+- removed links and comments to unofficial release of
Net::SSLeay, because there is a newer version already
v0.995
@@ -878,7 +926,7 @@
- All other known bugs have been fixed.
-v0.81a (Not publically released)
+v0.81a (Not publicly released)
- Added support for SSL_passwd_cb.
- Added accept() server socket support to socketToSSL().
@@ -943,4 +991,4 @@
- libwww-perl and IO::Socket::SSL UML models added in docs
- URL changes in test scripts
- preliminary support for startTLS in IO::Socket::SSL::socketToSSL()
-- miscellanous patches for Net::SSLeay added in diffs
+- miscellaneous patches for Net::SSLeay added in diffs
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/MANIFEST
new/IO-Socket-SSL-1.967/MANIFEST
--- old/IO-Socket-SSL-1.962/MANIFEST 2013-11-27 22:19:13.000000000 +0100
+++ new/IO-Socket-SSL-1.967/MANIFEST 2014-02-06 23:00:55.000000000 +0100
@@ -50,6 +50,7 @@
t/sni.t
t/mitm.t
t/ecdhe.t
+t/verify_fingerprint.t
util/export_certs.pl
META.yml Module YAML meta-data (added by
MakeMaker)
META.json Module JSON meta-data (added by
MakeMaker)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/META.json
new/IO-Socket-SSL-1.967/META.json
--- old/IO-Socket-SSL-1.962/META.json 2013-11-27 22:19:13.000000000 +0100
+++ new/IO-Socket-SSL-1.967/META.json 2014-02-06 23:00:55.000000000 +0100
@@ -50,5 +50,5 @@
"url" : "https://github.com/noxxi/p5-io-socket-ssl";
}
},
- "version" : "1.962"
+ "version" : "1.967"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/META.yml
new/IO-Socket-SSL-1.967/META.yml
--- old/IO-Socket-SSL-1.962/META.yml 2013-11-27 22:19:13.000000000 +0100
+++ new/IO-Socket-SSL-1.967/META.yml 2014-02-06 23:00:55.000000000 +0100
@@ -25,4 +25,4 @@
homepage: https://github.com/noxxi/p5-io-socket-ssl
license: http://dev.perl.org/licenses/
repository: https://github.com/noxxi/p5-io-socket-ssl
-version: 1.962
+version: 1.967
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/lib/IO/Socket/SSL/Utils.pm
new/IO-Socket-SSL-1.967/lib/IO/Socket/SSL/Utils.pm
--- old/IO-Socket-SSL-1.962/lib/IO/Socket/SSL/Utils.pm 2013-11-26
15:35:31.000000000 +0100
+++ new/IO-Socket-SSL-1.967/lib/IO/Socket/SSL/Utils.pm 2014-02-06
22:53:31.000000000 +0100
@@ -98,9 +98,9 @@
}
sub KEY_create_rsa {
- my $bits = shift || 1024;
+ my $bits = shift || 2048;
my $key = Net::SSLeay::EVP_PKEY_new();
- my $rsa = Net::SSLeay::RSA_generate_key(1024, 0x10001); # 0x10001 = RSA_F4
+ my $rsa = Net::SSLeay::RSA_generate_key($bits, 0x10001); # 0x10001 = RSA_F4
Net::SSLeay::EVP_PKEY_assign_RSA($key,$rsa);
return $key;
}
@@ -148,15 +148,16 @@
return \%hash;
}
-my $sha1_digest;
+my %digest;
sub CERT_create {
my %args = @_%2 ? %{ shift() } : @_;
my $cert = Net::SSLeay::X509_new();
- $sha1_digest ||= do {
+ my $digest_name = delete $args{digest} || 'sha256';
+ my $digest = $digest{$digest_name} ||= do {
Net::SSLeay::SSLeay_add_ssl_algorithms();
- Net::SSLeay::EVP_get_digestbyname("sha1")
- or die "SHA1 not available";
+ Net::SSLeay::EVP_get_digestbyname($digest_name)
+ or die "Digest algorithm $digest_name is not available";
};
Net::SSLeay::ASN1_INTEGER_set(
@@ -208,18 +209,16 @@
my $key = delete $args{key} || KEY_create_rsa();
Net::SSLeay::X509_set_pubkey($cert,$key);
- my $issuer_cert = delete $args{issuer_cert};
- my $issuer_key = delete $args{issuer_key};
+ my $issuer_cert = delete $args{issuer_cert} || $cert;
+ my $issuer_key = delete $args{issuer_key} || $key;
if ( delete $args{CA} ) {
- $issuer_cert ||= $cert;
- $issuer_key ||= $key;
- push @ext, &Net::SSLeay::NID_basic_constraints => 'CA:TRUE',
-
+ push @ext,
+ &Net::SSLeay::NID_basic_constraints => 'critical,CA:TRUE',
+ &Net::SSLeay::NID_key_usage =>
'critical,digitalSignature,keyCertSign',
+ &Net::SSLeay::NID_netscape_cert_type => 'sslCA,emailCA,objCA';
} else {
- $issuer_cert || croak "no issuer_cert given";
- $issuer_key || croak "no issuer_key given";
push @ext,
- &Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment',
+ &Net::SSLeay::NID_key_usage =>
'critical,digitalSignature,keyEncipherment',
&Net::SSLeay::NID_basic_constraints => 'CA:FALSE',
&Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth',
&Net::SSLeay::NID_netscape_cert_type => 'server';
@@ -228,7 +227,7 @@
Net::SSLeay::P_X509_add_extensions($cert, $issuer_cert, @ext);
Net::SSLeay::X509_set_issuer_name($cert,
Net::SSLeay::X509_get_subject_name($issuer_cert));
- Net::SSLeay::X509_sign($cert,$issuer_key,$sha1_digest);
+ Net::SSLeay::X509_sign($cert,$issuer_key,$digest);
return ($cert,$key);
}
@@ -324,7 +323,7 @@
=item * KEY_create_rsa(bits) -> key
-Creates an RSA key pair, bits defaults to 1024.
+Creates an RSA key pair, bits defaults to 2048.
=item * CERT_asHash(cert) -> hash
@@ -361,6 +360,7 @@
=item * CERT_create(hash) -> (cert,key)
Creates a certificate based on the given hash.
+If the issuer is not specified the certificate will be self-signed.
Additionally to the information described in C<CERT_asHash> the following keys
can be given:
@@ -383,6 +383,10 @@
sign new certificate with given key
+=item digest algorithm
+
+specify the algorithm used to sign the certificate, default SHA-256.
+
=back
If not all necessary information are given some will have usable defaults, e.g.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/lib/IO/Socket/SSL.pm
new/IO-Socket-SSL-1.967/lib/IO/Socket/SSL.pm
--- old/IO-Socket-SSL-1.962/lib/IO/Socket/SSL.pm 2013-11-27
22:06:58.000000000 +0100
+++ new/IO-Socket-SSL-1.967/lib/IO/Socket/SSL.pm 2014-02-06
22:58:10.000000000 +0100
@@ -20,7 +20,7 @@
use Carp;
use strict;
-our $VERSION = '1.962';
+our $VERSION = '1.967';
use constant SSL_VERIFY_NONE => Net::SSLeay::VERIFY_NONE();
use constant SSL_VERIFY_PEER => Net::SSLeay::VERIFY_PEER();
@@ -63,8 +63,8 @@
# older versions of F5 BIG-IP hang when getting SSL client hello >255 bytes
# http://support.f5.com/kb/en-us/solutions/public/13000/000/sol13037.html
# http://guest:[email protected]/Ticket/Display.html?id=2771
- # Debian works around this by disabling TLSv12 on the client side
- # Chrome and IE11 use TLSv12 but use only a few ciphers, so that packet
+ # Debian works around this by disabling TLSv1_2 on the client side
+ # Chrome and IE11 use TLSv1_2 but use only a few ciphers, so that packet
# stays small enough
# The following list is taken from IE11, except that we don't do RC4-MD5,
# RC4-SHA is already bad enough. Also, we have a different sort order
@@ -138,6 +138,15 @@
if $@;
}
+# get constants for SSL_OP_NO_* now, instead calling the releated functions
+# every time we setup a connection
+my %SSL_OP_NO;
+for(qw( SSLv2 SSLv3 TLSv1 TLSv1_1 TLSv11:TLSv1_1 TLSv1_2 TLSv12:TLSv1_2 )) {
+ my ($k,$op) = m{:} ? split(m{:},$_,2) : ($_,$_);
+ my $sub = "Net::SSLeay::OP_NO_$op";
+ $SSL_OP_NO{$k} = eval { no strict 'refs'; &$sub } || 0;
+}
+
our $DEBUG;
use vars qw(@ISA $SSL_ERROR @EXPORT );
@@ -207,7 +216,7 @@
#Make $DEBUG another name for $Net::SSLeay::trace
*DEBUG = \$Net::SSLeay::trace;
- #Compability
+ #Compatibility
*ERROR = \$SSL_ERROR;
# Do Net::SSLeay initialization
@@ -453,7 +462,10 @@
}
$arg_hash->{PeerAddr} || $self->_update_peer;
- my $session = $ctx->session_cache( $arg_hash->{PeerAddr},
$arg_hash->{PeerPort} );
+ my $session = $ctx->session_cache( $arg_hash->{SSL_session_key} ?
+ ( $arg_hash->{SSL_session_key},1 ) :
+ ( $arg_hash->{PeerAddr}, $arg_hash->{PeerPort} )
+ );
Net::SSLeay::set_session($ssl, $session) if ($session);
}
@@ -538,12 +550,15 @@
$self->blocking(1) if defined($timeout); # was blocking before
$ctx ||= ${*$self}{'_SSL_ctx'};
- if ( $ctx->has_session_cache ) {
+ if ( $ctx->has_session_cache
+ and my $session = Net::SSLeay::get1_session($ssl)) {
my $arg_hash = ${*$self}{'_SSL_arguments'};
$arg_hash->{PeerAddr} || $self->_update_peer;
- my ($addr,$port) = ( $arg_hash->{PeerAddr}, $arg_hash->{PeerPort} );
- my $session = $ctx->session_cache( $addr,$port );
- $ctx->session_cache( $addr,$port, Net::SSLeay::get1_session($ssl) ) if
!$session;
+ $ctx->session_cache( $arg_hash->{SSL_session_key} ?
+ ( $arg_hash->{SSL_session_key},1 ) :
+ ( $arg_hash->{PeerAddr},$arg_hash->{PeerPort} ),
+ $session
+ );
}
tie *{$self}, "IO::Socket::SSL::SSL_HANDLE", $self;
@@ -938,46 +953,31 @@
$stop_args->{SSL_no_shutdown} = 1 if ! ${*$self}{_SSL_opened};
if (my $ssl = ${*$self}{'_SSL_object'}) {
- my $shutdown_done;
- if ( $stop_args->{SSL_no_shutdown} ) {
- $shutdown_done = 1;
- } else {
- my $fast = $stop_args->{SSL_fast_shutdown};
+ if ( ! $stop_args->{SSL_no_shutdown} ) {
my $status = Net::SSLeay::get_shutdown($ssl);
- if ( $fast && $status != 0) {
- # shutdown done, either status has
- # SSL_SENT_SHUTDOWN or SSL_RECEIVED_SHUTDOWN or both,
- # so the handshake is at least in process
- $shutdown_done = 1;
- } elsif ( ( $status & SSL_SENT_SHUTDOWN ) == 0 ) {
- # need to initiate/continue shutdown
+ while (1) {
+ if ( $status & SSL_SENT_SHUTDOWN and
+ # don't care for received if fast shutdown
+ $status & SSL_RECEIVED_SHUTDOWN
+ || $stop_args->{SSL_fast_shutdown}) {
+ # shutdown complete
+ last;
+ }
+
+ # initiate or complete shutdown
local $SIG{PIPE} = 'IGNORE';
- for my $try (1,2 ) {
- my $rv = Net::SSLeay::shutdown($ssl);
- if ( $rv < 0 ) {
- # non-blocking socket?
- $self->_set_rw_error( $ssl,$rv );
- # need to try again
- return;
- } elsif ( $rv
- || ( $rv == 0 && $fast )) {
- # shutdown finished
- $shutdown_done = 1;
- last;
- } else {
- # shutdown partly initiated (e.g. one direction)
- # call again
- }
+ my $rv = Net::SSLeay::shutdown($ssl);
+ if ( $rv < 0 ) {
+ # non-blocking socket?
+ $self->_set_rw_error( $ssl,$rv );
+ # need to try again
+ return;
}
- } elsif ( $status & SSL_RECEIVED_SHUTDOWN ) {
- # SSL_SENT_SHUTDOWN is done already (previous if-case)
- # and because SSL_RECEIVED_SHUTDOWN is done also we
- # consider the shutdown done
- $shutdown_done = 1;
+
+ $status |= SSL_SENT_SHUTDOWN;
+ $status |= SSL_RECEIVED_SHUTDOWN if $rv>0;
}
}
-
- return if ! $shutdown_done;
Net::SSLeay::free($ssl);
delete ${*$self}{_SSL_object};
}
@@ -1066,12 +1066,22 @@
if ( ! defined($start_handshake) || $start_handshake ) {
# if we have no callback force blocking mode
$DEBUG>=2 && DEBUG( "start handshake" );
- my $blocking = $socket->blocking(1);
+ my $was_blocking = $socket->blocking(1);
my $result = ${*$socket}{'_SSL_arguments'}{SSL_server}
? $socket->accept_SSL(%to)
: $socket->connect_SSL(%to);
- $socket->blocking(0) if !$blocking;
- return $result ? $socket : (bless($socket, $original_class) && ());
+ if ( $result ) {
+ $socket->blocking(0) if ! $was_blocking;
+ return $socket;
+ } else {
+ # upgrade to SSL failed, downgrade socket to original class
+ if ( $original_class ) {
+ bless($socket,$original_class);
+ $socket->blocking(0) if ! $was_blocking
+ && $socket->can('blocking');
+ }
+ return;
+ }
} else {
$DEBUG>=2 && DEBUG( "dont start handshake: $socket" );
return $socket; # just return upgraded socket
@@ -1140,11 +1150,18 @@
# - wildcards_in_alt (0, 'leftmost', 'anywhere')
# - wildcards_in_cn (0, 'leftmost', 'anywhere')
# - check_cn (0, 'always', 'when_only')
- # unfortunatly there are a lot of different schemes used, see RFC 6125 for
a
+ # unfortunately there are a lot of different schemes used, see RFC 6125
for a
# summary, which references all of the following except RFC4217/ftp
my %scheme = (
none => {}, # do not check
+ # default set is a superset of all the others and thus worse than a more
+ # specific set, but much better than not verifying name at all
+ default => {
+ wildcards_in_cn => 'anywhere',
+ wildcards_in_alt => 'anywhere',
+ check_cn => 'always',
+ },
);
for(qw(
@@ -1213,7 +1230,7 @@
sub verify_hostname_of_cert {
my $identity = shift;
my $cert = shift;
- my $scheme = shift || 'none';
+ my $scheme = shift || 'default';
if ( ! ref($scheme) ) {
$DEBUG>=3 && DEBUG( "scheme=$scheme cert=$cert" );
$scheme = $scheme{$scheme} or croak "scheme $scheme not defined";
@@ -1318,11 +1335,42 @@
};
}
+sub get_fingerprint_bin {
+ my $cert = shift()->peer_certificate;
+ return Net::SSLeay::X509_get_fingerprint($cert,shift() || 'sha256');
+}
+
+sub get_fingerprint {
+ my ($self,$algo) = @_;
+ $algo ||= 'sha256';
+ my $fp = get_fingerprint_bin($self,$algo) or return;
+ return $algo.'$'.unpack('H*',$fp);
+}
+
sub get_cipher {
my $ssl = shift()->_get_ssl_object || return;
return Net::SSLeay::get_cipher($ssl);
}
+sub get_sslversion {
+ my $ssl = shift()->_get_ssl_object || return;
+ my $version = Net::SSLeay::version($ssl) or return;
+ return
+ $version == 0x0303 ? 'TLSv1_2' :
+ $version == 0x0302 ? 'TLSv1_1' :
+ $version == 0x0301 ? 'TLSv1' :
+ $version == 0x0300 ? 'SSLv3' :
+ $version == 0x0002 ? 'SSLv2' :
+ $version == 0xfeff ? 'DTLS1' :
+ undef;
+}
+
+sub get_sslversion_int {
+ my $ssl = shift()->_get_ssl_object || return;
+ return Net::SSLeay::version($ssl);
+}
+
+
sub errstr {
my $self = shift;
return (ref($self) ? ${*$self}{'_SSL_last_err'} : $SSL_ERROR) || '';
@@ -1559,7 +1607,9 @@
# or no defaults
{
my $use_default = 1;
- for (qw( SSL_cert SSL_cert_file SSL_key SSL_key_file SSL_ca_file
SSL_ca_path )) {
+ for (qw( SSL_cert SSL_cert_file SSL_key SSL_key_file
+ SSL_ca_file SSL_ca_path
+ SSL_fingerprint )) {
next if ! defined $arg_hash->{$_};
# some apps set keys '' to signal that it is not set, replace with
undef
if ( $arg_hash->{$_} eq '' ) {
@@ -1606,24 +1656,24 @@
defined( my $file = $arg_hash->{$_} ) or next;
for my $f (ref($file) eq 'HASH' ? values(%$file):$file ) {
die "$_ $f does not exist" if ! -f $f;
- die "$_ $f is not accessable" if ! -r _;
+ die "$_ $f is not accessible" if ! -r _;
}
}
if ( defined( my $f = $arg_hash->{SSL_ca_file} )) {
die "SSL_ca_file $f does not exist" if ! -f $f;
- die "SSL_ca_file $f is not accessable" if ! -r _;
+ die "SSL_ca_file $f is not accessible" if ! -r _;
}
if ( defined( my $d = $arg_hash->{SSL_ca_path} )) {
die "only SSL_ca_path or SSL_ca_file should be given"
if defined $arg_hash->{SSL_ca_file};
die "SSL_ca_path $d does not exist" if ! -d $d;
- die "SSL_ca_path $d is not accessable" if ! -r _;
+ die "SSL_ca_path $d is not accessible" if ! -r _;
}
}
}
my $vcn_scheme = delete $arg_hash->{SSL_verifycn_scheme};
- if ( $vcn_scheme && $vcn_scheme ne 'none' ) {
+ if ( ! $vcn_scheme or $vcn_scheme ne 'none' ) {
# don't access ${*self} inside callback - this seems to create
# circular references from the ssl object to the context and back
@@ -1635,55 +1685,72 @@
}
}
$host ||= ref($vcn_scheme) && $vcn_scheme->{callback} && 'unknown';
- $host or return IO::Socket::SSL->error(
- "Cannot determine peer hostname for verification" );
+ if ( ! $host ) {
+ return IO::Socket::SSL->error(
+ "Cannot determine peer hostname for verification" )
+ if $vcn_scheme;
+ } elsif ( ! $vcn_scheme && $host =~m{^[\d.]+$|:} ) {
+ # don't try to verify IP by default
+ } else {
+ my $vcb = $arg_hash->{SSL_verify_callback};
+ $arg_hash->{SSL_verify_callback} = sub {
+ my ($ok,$ctx_store,$certname,$error,$cert) = @_;
+ $ok = $vcb->($ok,$ctx_store,$certname,$error,$cert) if $vcb;
+ $ok or return 0;
+ return $ok if
+ Net::SSLeay::X509_STORE_CTX_get_error_depth($ctx_store) !=0;
+
+ # verify name
+ my $rv = IO::Socket::SSL::verify_hostname_of_cert(
+ $host,$cert,$vcn_scheme );
+ if ( ! $rv && ! $vcn_scheme ) {
+ # For now we use the default hostname verification if none
+ # was specified and complain loudly but return ok if it does
+ # not match. In the future we will enforce checks and users
+ # should better specify and explicite verification scheme.
+ warn <<WARN;
+
+The verification of cert '$certname'
+failed against the host '$host' with the default verification scheme.
- my $vcb = $arg_hash->{SSL_verify_callback};
- $arg_hash->{SSL_verify_callback} = sub {
- my ($ok,$ctx_store,$certname,$error,$cert) = @_;
- $ok = $vcb->($ok,$ctx_store,$certname,$error,$cert) if $vcb;
- $ok or return 0;
- my $depth = Net::SSLeay::X509_STORE_CTX_get_error_depth($ctx_store);
- return $ok if $depth != 0;
-
- # verify name
- my $rv = IO::Socket::SSL::verify_hostname_of_cert(
$host,$cert,$vcn_scheme );
- # just do some code here against optimization because x509 has no
- # increased reference and CRYPTO_add is not available from
Net::SSLeay
- return $rv;
- };
+ THIS MIGHT BE A MAN-IN-THE-MIDDLE ATTACK !!!!
+
+To stop this warning you might need to set SSL_verifycn_name to
+the name of the host you expect in the certificate.
+
+WARN
+ return 1;
+ }
+ return $rv;
+ };
+ }
}
my $ssl_op = Net::SSLeay::OP_ALL();
my $ver;
for (split(/\s*:\s*/,$arg_hash->{SSL_version})) {
- m{^(!?)(?:(SSL(?:v2|v3|v23|v2/3))|(TLSv1[12]?))$}i
+ m{^(!?)(?:(SSL(?:v2|v3|v23|v2/3))|(TLSv1(?:_?[12])?))$}i
or croak("invalid SSL_version specified");
my $not = $1;
( my $v = lc($2||$3) ) =~s{^(...)}{\U$1};
- $v =~s{/}{}; # interpret SSLv2/3 as SSLv23
if ( $not ) {
- $ssl_op |=
- $v eq 'SSLv2' ? 0x01000000 : # SSL_OP_NO_SSLv2
- $v eq 'SSLv3' ? 0x02000000 : # SSL_OP_NO_SSLv3
- $v eq 'TLSv1' ? 0x04000000 : # SSL_OP_NO_TLSv1
- $v eq 'TLSv11' ? 0x00000400 : # SSL_OP_NO_TLSv1_1
- $v eq 'TLSv12' ? 0x08000000 : # SSL_OP_NO_TLSv1_2
- croak("cannot disable version $_");
+ $ssl_op |= $SSL_OP_NO{$v};
} else {
croak("cannot set multiple SSL protocols in SSL_version")
if $ver && $v ne $ver;
$ver = $v;
+ $ver =~s{/}{}; # interpret SSLv2/3 as SSLv23
+ $ver =~s{(TLSv1)(\d)}{$1\_$2}; # TLSv1_1
}
}
my $ctx_new_sub = UNIVERSAL::can( 'Net::SSLeay',
- $ver eq 'SSLv2' ? 'CTX_v2_new' :
- $ver eq 'SSLv3' ? 'CTX_v3_new' :
- $ver eq 'TLSv1' ? 'CTX_tlsv1_new' :
- $ver eq 'TLSv11' ? 'CTX_tlsv1_1_new' :
- $ver eq 'TLSv12' ? 'CTX_tlsv1_2_new' :
+ $ver eq 'SSLv2' ? 'CTX_v2_new' :
+ $ver eq 'SSLv3' ? 'CTX_v3_new' :
+ $ver eq 'TLSv1' ? 'CTX_tlsv1_new' :
+ $ver eq 'TLSv1_1' ? 'CTX_tlsv1_1_new' :
+ $ver eq 'TLSv1_2' ? 'CTX_tlsv1_2_new' :
'CTX_new'
) or return IO::Socket::SSL->error("SSL Version $ver not supported");
my $ctx = $ctx_new_sub->() or return
@@ -1860,7 +1927,18 @@
}
my $verify_cb = $arg_hash->{SSL_verify_callback};
- my $verify_callback = $verify_cb && sub {
+ my @accept_fp;
+ if ( my $fp = $arg_hash->{SSL_fingerprint} ) {
+ for( ref($fp) ? @$fp : $fp) {
+ my ($algo,$digest) = m{^([\w-]+)\$([a-f\d:]+)$}i;
+ return IO::Socket::SSL->error("invalid fingerprint '$_'")
+ if ! $algo;
+ $algo = lc($algo);
+ ( $digest = lc($digest) ) =~s{:}{}g;
+ push @accept_fp,[ $algo, pack('H*',$digest) ]
+ }
+ }
+ my $verify_callback = ( $verify_cb || @accept_fp) && sub {
my ($ok, $ctx_store) = @_;
my ($certname,$cert,$error);
if ($ctx_store) {
@@ -1871,6 +1949,15 @@
$error &&= Net::SSLeay::ERR_error_string($error);
}
$DEBUG>=3 && DEBUG( "ok=$ok cert=$cert" );
+ if ( $cert && @accept_fp ) {
+ my %fp;
+ for(@accept_fp) {
+ my $fp = $fp{$_->[0]} ||=
+ Net::SSLeay::X509_get_fingerprint($cert,$_->[0]);
+ return 1 if $fp eq $_->[1];
+ }
+ }
+ return $ok if ! $verify_cb;
return $verify_cb->($ok,$ctx_store,$certname,$error,$cert);
};
@@ -1963,7 +2050,15 @@
my ($self, $key, $val) = @_;
return if ($key eq '_maxsize' or $key eq '_head');
- if ((keys %$self) > $self->{'_maxsize'} + 1) {
+ if ( my $have = $self->{$key} ) {
+ Net::SSLeay::SESSION_free( $have->{session} );
+ $have->{session} = $val;
+ return get_session($self,$key); # will put key on front
+ }
+
+ my $session = $self->{$key} = { session => $val, key => $key };
+
+ if ( keys(%$self) > $self->{_maxsize}+2) {
my $last = $self->{'_head'}->{prev};
Net::SSLeay::SESSION_free($last->{session});
delete($self->{$last->{key}});
@@ -1971,8 +2066,6 @@
delete($self->{'_head'}) if ($self->{'_maxsize'} == 1);
}
- my $session = $self->{$key} = { session => $val, key => $key };
-
if ($self->{'_head'}) {
$session->{next} = $self->{'_head'};
$session->{prev} = $self->{'_head'}->{prev};
@@ -2008,7 +2101,7 @@
use IO::Socket::SSL;
# simple HTTP client -----------------------------------------------
- my $sock = IO::Socket::SSL->new(
+ my $client = IO::Socket::SSL->new(
# where to connect
PeerHost => "www.example.com",
PeerPort => "https",
@@ -2119,15 +2212,48 @@
selection, certificate verification, Server Name Indication (SNI), Next
Protocol Negotiation (NPN), SSL version selection and more.
-If you have never used SSL before, you should read the appendix labelled
'Using SSL'
+If you have never used SSL before, you should read the section 'Using SSL'
before attempting to use this module.
+If you used IO::Socket before you should read the following section
+'Differences to IO::Socket'.
+
If you want to use SSL with non-blocking sockets and/or within an event loop
please read very carefully the sections about non-blocking I/O and polling of
SSL
sockets.
If you are trying to use it with threads see the BUGS section.
+=head2 Differences to IO::Socket
+
+Although L<IO::Socket::SSL> tries to behave similar to L<IO::Socket> there are
+some important differences due to the way SSL works:
+
+=over 4
+
+=item * buffered input
+
+Data are transmitted inside the SSL protocol using encrypted frames, which can
+only be decrypted once the full frame is received. So if you use C<read> or
+C<sysread> to receive less data than the SSL frame contains, it will read the
+whole frame, return part of it and buffer the rest for later reads.
+This does not make a difference for simple programs, but if you use
+select-loops or polling or non-blocking I/O please read the related sections.
+
+=item * SSL handshakes
+
+Before any encryption can be done the peers have to agree to common algorithms,
+verify certificates etc. So a handshake needs to be done before any payload is
+send or received and might additionally happen later in the connection again.
+
+This has important implications when doing non-blocking or event-based I/O
+(please read the related sections), but means also, that connect and accept
+calls include the SSL handshake and thus might block or fail, if the peer does
+not behave like expected. For instance accept will wait infinitly if a TCP
+client connects to the socket but does not initiate an SSL handshake.
+
+=back
+
=head1 METHODS
IO::Socket::SSL inherits from another IO::Socket module.
@@ -2172,7 +2298,10 @@
=item B<new(...)>
Creates a new IO::Socket::SSL object. You may use all the friendly options
-that came bundled with IO::Socket::INET, plus (optionally) the ones that
follow:
+that came bundled with the super class (e.g. IO::Socket::IP,
+IO::Socket::INET, ...) plus (optionally) the ones described below.
+If you don't specify any SSL related options it will do it's best in using
+secure defaults, e.g. chosing good ciphers, enabling proper verification etc.
=over 2
@@ -2192,23 +2321,25 @@
=item SSL_version
-Sets the version of the SSL protocol used to transmit data. 'SSLv23'
auto-negotiates
-between SSLv2 and SSLv3, while 'SSLv2', 'SSLv3', 'TLSv1', 'TLSv11' or 'TLSv12'
-restrict the protocol to the specified version. All values are
case-insensitive.
-Support for 'TLSv11' and 'TLSv12' requires recent versions of Net::SSLeay
-and openssl.
+Sets the version of the SSL protocol used to transmit data.
+'SSLv23' auto-negotiates between SSLv2 and SSLv3, while 'SSLv2', 'SSLv3',
+'TLSv1', 'TLSv1_1' or 'TLSv1_2' restrict the protocol to the specified version.
+All values are case-insensitive. Instead of 'TLSv1_1' and 'TLSv1_2' one can
+also use 'TLSv11' and 'TLSv12'. Support for 'TLSv1_1' and 'TLSv1_2' requires
+recent versions of Net::SSLeay and openssl.
You can limit to set of supported protocols by adding !version separated by
':'.
-The default SSL_version is 'SSLv23:!SSLv2' which means, that SSLv2, SSLv3 and
TLSv1
-are supported for initial protocol handshakes, but SSLv2 will not be accepted,
leaving
-only SSLv3 and TLSv1. You can also use !TLSv11 and !TLSv12 to disable TLS
versions
-1.1 and 1.2 while allowing TLS version 1.0.
-
-Setting the version instead to 'TLSv1' will probably break interaction with
lots of
-clients which start with SSLv2 and then upgrade to TLSv1. On the other side
some
-clients just close the connection when they receive a TLS version 1.1 request.
In this
-case setting the version to 'SSLv23:!SSLv2:!TLSv11:!TLSv12' might help.
+The default SSL_version is 'SSLv23:!SSLv2' which means, that SSLv2, SSLv3 and
+TLSv1 are supported for initial protocol handshakes, but SSLv2 will not be
+accepted, leaving only SSLv3 and TLSv1. You can also use !TLSv1_1 and !TLSv1_2
+to disable TLS versions 1.1 and 1.2 while allowing TLS version 1.0.
+
+Setting the version instead to 'TLSv1' will probably break interaction with
+lots of clients which start with SSLv2 and then upgrade to TLSv1. On the other
+side some clients just close the connection when they receive a TLS version 1.1
+request. In this case setting the version to 'SSLv23:!SSLv2:!TLSv1_1:!TLSv1_2'
+might help.
=item SSL_cipher_list
@@ -2323,11 +2454,27 @@
trusted certificate authority. In this case you should use this option to
specify the file (SSL_ca_file) or directory (SSL_ca_path) containing the
certificateZ<>(s) of the trusted certificate authorities.
-If both SSL_ca_file and SSL_ca_path are undefined and not builtin defaults (see
-"Defaults for Cert, Key and CA".) can be used, it will try to use the system
-defaults used built into the OpenSSL library.
+If both SSL_ca_file and SSL_ca_path are undefined and builtin defaults (see
+"Defaults for Cert, Key and CA".) can not be used, the system
+defaults built into the OpenSSL library will be tried.
If you really don't want to set a CA set this key to C<''>.
+=item SSL_fingerprint
+
+Sometimes you have a self-signed certificate or a certificate issued by an
+unknown CA and you really want to accept it, but don't want to disable
+verification at all. In this case you can specify the fingerprint of the
+certificate as C<'algo$hex_fingerprint'>. C<algo> is a fingerprint algorithm
+supported by OpenSSL, e.g. 'sha1','sha256'... and C<hex_fingerprint> is the
+hexadecimal representation of the binary fingerprint.
+To get the fingerprint of an established connection you can use
+C<get_fingerprint>.
+
+You can specify a list of fingerprints in case you have several acceptable
+certificates.
+If a fingerprint matches no additional verification of the certificate will be
+done.
+
=item SSL_verify_mode
This option sets the verification mode for the peer certificate.
@@ -2373,13 +2520,26 @@
=item SSL_verifycn_scheme
-Set the scheme used to automatically verify the hostname of the peer.
+The scheme is used to correctly verify the identity inside the certificate
+by using the hostname of the peer.
See the information about the verification schemes in B<verify_hostname>.
-The default is undef, e.g. to not automatically verify the hostname.
-If no verification is done the other B<SSL_verifycn_*> options have
-no effect, but you might still do manual verification by calling
-B<verify_hostname>.
+If you don't specify a scheme it will use 'default', but only complain loudly
if
+the name verification fails instead of letting the whole certificate
+verification fail. THIS WILL CHANGE, e.g. it will let the certificate
+verification fail in the future if the hostname does not match the certificate
!!!!
+To override the name used in verification use B<SSL_verifycn_name>.
+
+The scheme 'default' is a superset of the usual schemes, which will accept the
+hostname in common name and subjectAltName and allow wildcards everywhere.
+While using this scheme is way more secure than no name verification at all you
+better should use the scheme specific to your application protocol, e.g.
'http',
+'ftp'...
+
+If you are really sure, that you don't want to verify the identity using the
+hostname you can use 'none' as a scheme. In this case you'd better have
+alternative forms of verification, like a certificate fingerprint or do a
manual
+verification later by calling B<verify_hostname> yourself.
=item SSL_verifycn_name
@@ -2458,6 +2618,12 @@
Use set_default_session_cache() to set a global cache object.
+=item SSL_session_key
+
+Specifies a key to use for lookups and inserts into client-side session cache.
+Per default ip:port of destination will be used, but sometimes you want to
+share the same session over multiple ports on the same server (like with FTPS).
+
=item SSL_session_id_context
This gives an id for the servers session cache. It's necessary if you want
@@ -2489,6 +2655,23 @@
=back
+=item B<accept>
+
+This behaves similar to the accept function of the underlying socket class, but
+additionally does the initial SSL handshake. But because the underlying socket
+class does return a blocking file handle even when accept is called on a
+non-blocking socket, the SSL handshake on the new file object will be done in a
+blocking way. Please see the section about non-blocking I/O for details.
+If you don't like this behavior you should do accept on the TCP socket and then
+upgrade it with C<start_SSL> later.
+
+=item B<connect(...)>
+
+This behaves similar to the connnect function but also does an SSL handshake.
+Because you cannot give SSL specific arguments to this function, you should
+better either use C<new> to create a connect SSL socket or C<start_SSL> to
+upgrade an established TCP socket to SSL.
+
=item B<close(...)>
There are a number of nasty traps that lie in wait if you are not careful
about using
@@ -2509,12 +2692,16 @@
on the socket in question so that the close operation can complete without
problems
if you have used shutdown() or are working on a copy of a socket.
+Not using a real ssl shutdown on a socket will make session caching unusable.
+
=item SSL_fast_shutdown
If set to true only a unidirectional shutdown will be done, e.g. only the
-close_notify (see SSL_shutdown(3)) will be called. Otherwise a bidirectional
-shutdown will be done. If used within close() it defaults to true, if used
-within stop_SSL() it defaults to false.
+close_notify (see SSL_shutdown(3)) will be sent. Otherwise a bidirectional
+shutdown will be done where it waits for the close_notify of the peer too.
+
+Because a unidirectional shutdown is enough to keep session cache working it
+defaults to fast shutdown inside close.
=item SSL_ctx_free
@@ -2530,7 +2717,7 @@
But in reality it reads not only LEN bytes from the underlying socket, but at
a single SSL frame. It then returns up to LEN bytes it decrypted from this SSL
frame. If the frame contained more data than requested it will return only LEN
-data, buffer the rest and return it on futher read calls.
+data, buffer the rest and return it on further read calls.
This means, that it might be possible to read data, even if the underlying
socket is not readable, so using poll or select might not be sufficient.
@@ -2572,10 +2759,30 @@
underlying socket object. This function is essential if you work with event
loops, please see the section about polling SSL sockets.
+=item B<get_fingerprint([algo])>
+
+This methods returns the fingerprint of the peer certificate in the form
+C<algo$digest_hex>, where C<algo> is the used algorithm, default 'sha256'.
+
+=item B<get_fingerprint_bin([algo])>
+
+This methods returns the binary fingerprint of the peer certificate by using
the
+algorithm C<algo>, default 'sha256'.
+
=item B<get_cipher()>
Returns the string form of the cipher that the IO::Socket::SSL object is using.
+=item B<get_sslversion()>
+
+Returns the string representation of the SSL version of an established
+connection.
+
+=item B<get_sslversion_int()>
+
+Returns the integer representation of the SSL version of an established
+connection.
+
=item B<dump_peer_certificate()>
Returns a parsable string with select fields from the peer SSL certificate.
This
@@ -2742,16 +2949,26 @@
Will return true if it succeeded and undef if failed. This might be the case
for
non-blocking sockets. In this case $! is set to EAGAIN and the ssl error to
SSL_WANT_READ or SSL_WANT_WRITE. In this case the call should be retried again
with
-the same arguments once the socket is ready is until it succeeds.
+the same arguments once the socket is ready.
+
+For calling from C<stop_SSL> C<SSL_fast_shutdown> default to false, e.g. it
+waits for the close_notify of the peer. This is necesarry in case you want to
+downgrade the socket and continue to use it as a plain socket.
-=item B<< IO::Socket::SSL->new_from_fd($fd, ...) >>
+=item B<< IO::Socket::SSL->new_from_fd($fd, [mode], %sslargs) >>
This will convert a socket identified via a file descriptor into an SSL socket.
Note that the argument list does not include a "MODE" argument; if you supply
one,
-it will be thoughtfully ignored (for compatibility with IO::Socket::INET).
Instead,
+it will be thoughtfully ignored (for compatibility with IO::Socket::INET).
Instead,
a mode of '+<' is assumed, and the file descriptor passed must be able to
handle such
I/O because the initial SSL handshake requires bidirectional communication.
+Internally the given $fd will be upgraded to a socket object using the
+C<new_from_fd> method of the super class (L<IO::Socket::INET> or similar) and
then
+C<start_SSL> will be called using the given C<%sslargs>.
+If C<$fd> is already an IO::Socket object you should better call C<start_SSL>
+directly.
+
=item B<IO::Socket::SSL::set_default_context(...)>
You may use this to make IO::Socket::SSL automatically re-use a given context
(unless
@@ -2843,8 +3060,8 @@
=item SSL_ca_file | SSL_ca_path
-It will set SSL_ca_file to C<certs/my-ca.pem> if it exist.
-Otherwise it will set SSL_ca_path to C<ca/> if it exist.
+SSL_ca_file will be set to C<certs/my-ca.pem> if it exists.
+Otherwise SSL_ca_path will be set to C<ca/> if it exists.
=back
@@ -2908,6 +3125,15 @@
instead of blocking, even if the line is not complete. If an unrecoverable
error
occurs it will return nothing, even if it already received some data.
+Also, I would advise against using C<accept> with a non-blocking SSL object,
+because it might block and this is not what most would expect. The reason for
+this is that accept on a non-blocking TCP socket (e.g. IO::Socket::IP,
+IO::Socket::INET..) results in a new TCP socket, which does not inherit the
+non-blocking behavior of the master socket. And thus the initial SSL handshake
+on the new socket inside C<IO::Socket::SSL::accept> will be done in a blocking
+way. To work around it you should better do an TCP accept and later upgrade the
+TCP socket in a non-blocking way with C<start_SSL> and C<accept_SSL>.
+
=head1 SNI Support
Newer extensions to SSL can distinguish between multiple hostnames on the same
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/t/cert_no_file.t
new/IO-Socket-SSL-1.967/t/cert_no_file.t
--- old/IO-Socket-SSL-1.962/t/cert_no_file.t 2013-11-11 09:26:36.000000000
+0100
+++ new/IO-Socket-SSL-1.967/t/cert_no_file.t 2014-02-05 20:30:16.000000000
+0100
@@ -78,7 +78,7 @@
SSL_verify_mode => 0x00,
);
if ( $test == 3 ) {
- notok( "$spec: connect suceeded" ) if $to_server;
+ notok( "$spec: connect succeeded" ) if $to_server;
ok( "$spec: connect failed" );
exit;
} elsif ( ! $to_server ) {
@@ -92,7 +92,7 @@
my $to_client = $server->accept;
if ( $test == 3 ) {
- notok( "$spec: accept suceeded" ) if $to_client;
+ notok( "$spec: accept succeeded" ) if $to_client;
ok( "$spec: accept failed" );
} elsif ( ! $to_client ) {
notok( "$spec: accept failed: $!" );
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/t/core.t
new/IO-Socket-SSL-1.967/t/core.t
--- old/IO-Socket-SSL-1.962/t/core.t 2013-11-12 16:36:27.000000000 +0100
+++ new/IO-Socket-SSL-1.967/t/core.t 2014-02-05 20:30:16.000000000 +0100
@@ -24,8 +24,22 @@
$numtests+=5 if $CAN_NONBLOCK;
$numtests+=3 if $CAN_PEEK;
+my $expected_peer = do {
+ my $us = IO::Socket::INET->new( LocalAddr => '127.0.0.1', Proto => 'udp' );
+ my $uc = IO::Socket::INET->new(
+ PeerAddr => $us->sockhost,
+ PeerPort => $us->sockport,
+ Proto => 'udp'
+ ) or do {
+ print "1..0 # Skipped: cannot determine default peer IP\n";
+ exit
+ };
+ $uc->sockhost,
+};
+
print "1..$numtests\n";
+
my $error_trapped = 0;
my $server = IO::Socket::SSL->new(
LocalAddr => '127.0.0.1',
@@ -289,7 +303,7 @@
($client, $peer) = $server->accept;
&bail unless $client;
-print "not " unless (inet_ntoa((unpack_sockaddr_in($peer))[1]) eq "127.0.0.1");
+print "not " unless (inet_ntoa((unpack_sockaddr_in($peer))[1]) eq
$expected_peer);
&ok("Peer address check");
if ($CAN_NONBLOCK) {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/t/io-socket-inet6.t
new/IO-Socket-SSL-1.967/t/io-socket-inet6.t
--- old/IO-Socket-SSL-1.962/t/io-socket-inet6.t 2013-11-11 09:26:36.000000000
+0100
+++ new/IO-Socket-SSL-1.967/t/io-socket-inet6.t 2014-02-05 20:30:16.000000000
+0100
@@ -1,7 +1,13 @@
#!perl
# make sure IO::Socket::IP will not be used
-BEGIN { $INC{'IO/Socket/IP.pm'} = undef }
+BEGIN {
+ if ( eval { require Acme::Override::INET }) {
+ print "1..0 # Skipped: will not work with Acme::Override::INET
installed\n";
+ exit
+ }
+ $INC{'IO/Socket/IP.pm'} = undef
+}
use strict;
use warnings;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/t/nonblock.t
new/IO-Socket-SSL-1.967/t/nonblock.t
--- old/IO-Socket-SSL-1.962/t/nonblock.t 2013-11-11 09:26:36.000000000
+0100
+++ new/IO-Socket-SSL-1.967/t/nonblock.t 2014-02-05 20:30:16.000000000
+0100
@@ -55,7 +55,7 @@
close($server);
$ID = 'client';
- # fast: try connect_SSL immediatly after sending plain text
+ # fast: try connect_SSL immediately after sending plain text
# connect_SSL should fail on the first attempt because server
# is not ready yet
# slow: wait before calling connect_SSL
@@ -175,7 +175,7 @@
$attempts = 0;
my $bytes_send = 0;
- # set send buffer to 8192 so it will definitly fail writing all 500000
bytes in it
+ # set send buffer to 8192 so it will definitely fail writing all 500000
bytes in it
# beware that linux allocates twice as much (see tcp(7))
# AIX seems to get very slow if you set the sndbuf on localhost, so
don't to it
# https://rt.cpan.org/Public/Bug/Display.html?id=72305
@@ -245,9 +245,9 @@
ok( "syswrite" );
if ( ! $attempts && $test_might_fail ) {
- ok( " write attempts failed, but OK nevertheless because
setsockopt failed" );
+ ok( " write attempts failed, but OK nevertheless because setsockopt
failed" );
} else {
- print "not " if !$attempts;
+ print "not " if !$attempts;
ok( "multiple write attempts" );
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/t/sessions.t
new/IO-Socket-SSL-1.967/t/sessions.t
--- old/IO-Socket-SSL-1.962/t/sessions.t 2013-11-11 19:13:24.000000000
+0100
+++ new/IO-Socket-SSL-1.967/t/sessions.t 2014-02-05 20:30:16.000000000
+0100
@@ -123,6 +123,7 @@
# Make sure that first 'bogus' entry has been removed
if (keys(%$cache) != 6) {
+ warn Dumper($cache); use Data::Dumper;
print "not ";
}
&ok("Cache Keys Check 3");
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Socket-SSL-1.962/t/verify_fingerprint.t
new/IO-Socket-SSL-1.967/t/verify_fingerprint.t
--- old/IO-Socket-SSL-1.962/t/verify_fingerprint.t 1970-01-01
01:00:00.000000000 +0100
+++ new/IO-Socket-SSL-1.967/t/verify_fingerprint.t 2014-02-06
22:53:31.000000000 +0100
@@ -0,0 +1,58 @@
+use strict;
+use warnings;
+use Test::More;
+use IO::Socket::SSL;
+use IO::Socket::SSL::Utils;
+
+plan tests => 6;
+plan skip_all => "fork not implemented on this platform"
+ if $^O =~m{MacOS|VOS|vmesa|riscos|amigaos};
+
+my ($cert1,$key1) = CERT_create( subject => { CN => 'cert1' });
+my ($cert2,$key2) = CERT_create( subject => { CN => 'cert2' });
+
+my ($saddr1,$fp1) = _server($cert1,$key1);
+my ($saddr2,$fp2) = _server($cert2,$key2);
+
+for my $test (
+ [ $saddr1, $fp1, "accept fp1 for saddr1", 1 ],
+ [ $saddr2, $fp2, "accept fp2 for saddr2", 1 ],
+ [ $saddr1, $fp2, "reject fp2 for saddr1", 0 ],
+ [ $saddr2, $fp1, "reject fp1 for saddr2", 0 ],
+ [ $saddr1, [$fp1,$fp2], "accept fp1|fp2 for saddr1", 1 ],
+ [ $saddr2, [$fp1,$fp2], "accept fp1|fp2 for saddr2", 1 ],
+) {
+ my ($saddr,$fp,$what,$expect) = @$test;
+ my $cl = IO::Socket::INET->new( $saddr ) or die $!;
+ my $ok = IO::Socket::SSL->start_SSL($cl,
+ SSL_verify_mode => 1,
+ SSL_fingerprint => $fp
+ );
+ ok( ($ok?1:0) == ($expect?1:0),$what);
+}
+
+
+my @child;
+END { kill 9,@child }
+sub _server {
+ my ($cert,$key) = @_;
+ my $sock = IO::Socket::INET->new( LocalAddr => '0.0.0.0', Listen => 10 )
+ or die $!;
+ defined( my $pid = fork()) or die $!;
+ if ( $pid ) {
+ push @child,$pid;
+ return (
+ '127.0.0.1:'.$sock->sockport,
+ 'sha1$'.unpack('H*',Net::SSLeay::X509_get_fingerprint($cert,'sha1'))
+ );
+ }
+
+ while (1) {
+ my $cl = $sock->accept or next;
+ IO::Socket::SSL->start_SSL($cl,
+ SSL_server => 1,
+ SSL_cert => $cert,
+ SSL_key => $key
+ );
+ }
+}
--
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
