[meego-commits] 13445: Changes to MeeGo:1.1:Core:Update:Testing/perl-IO-Socket-SSL
Wang Quanxian
no_reply at build.meego.com
Wed Feb 9 02:18:15 UTC 2011
Hi,
I have made the following changes to perl-IO-Socket-SSL in project MeeGo:1.1:Core:Update:Testing. Please review and accept ASAP.
Thank You,
Wang Quanxian
[This message was auto-generated]
---
Request #13445:
submit: home:quanxianwang:branches:MeeGo:1.1:Core:Update:Testing/perl-IO-Socket-SSL(r3)(cleanup) -> MeeGo:1.1:Core:Update:Testing/perl-IO-Socket-SSL
Message:
upgrade to 1.35:verifying a ca_file/ca_path allows remote attackers to bypass intended certificate restrictions (BMC #11152)
State: new 2011-02-08T13:17:54 quanxianwang
Comment: None
changes files:
--------------
--- perl-IO-Socket-SSL.changes
+++ perl-IO-Socket-SSL.changes
@@ -0,0 +1,3 @@
+* Wed Feb 9 2011 Quanxian Wang <quanxian.wang at intel.com> - 1.35
+- update to 1.35
+
old:
----
IO-Socket-SSL-1.31.tar.gz
new:
----
IO-Socket-SSL-1.35.tar.gz
spec files:
-----------
--- perl-IO-Socket-SSL.spec
+++ perl-IO-Socket-SSL.spec
@@ -4,7 +4,7 @@
#
Name: perl-IO-Socket-SSL
-Version: 1.31
+Version: 1.35
Release: 1
Summary: Perl library for transparent SSL
Group: Development/Libraries
other changes:
--------------
++++++ IO-Socket-SSL-1.31.tar.gz -> IO-Socket-SSL-1.35.tar.gz
--- Changes
+++ Changes
@@ -1,4 +1,28 @@
+v1.35 2010.12.06
+- if verify_mode is not VERIFY_NONE and the ca_file/ca_path cannot be
+ verified as valid it will no longer fall back to VERIFY_NONE but throw
+ an error. Thanks to Salvatore Bonaccorso and Daniel Kahn Gillmor for
+ pointing out the problem, see also
+ http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=606058
+v1.34 2010.11.01
+- schema http for certificate verification changed to
+ wildcards_in_cn=1, because according to rfc2818 this is valid and
+ also seen in the wild
+- if upgrading socket from inet to ssl fails due to handshake problems
+ the socket gets downgraded, but is still open.
+ See https://rt.cpan.org/Ticket/Display.html?id=61466
+- depreceate kill_socket, just use close()
+v1.33 2010.03.17
+- attempt to make t/memleak_bad_handshake.t more stable, it fails
+ for unknown reason on various systems
+- fix hostname checking: an IP should only be checked against
+ subjectAltName GEN_IPADD, never against GEN_DNS or CN.
+ Thanks to rusch[AT]genua[DOT]de for bug report
+v1.32 2010.02.22
+- Makefile.PL: die if Scalar::Util has no dualvar support instead of
+ only complaining. Thanks to w[DOT]phillip[DOT]moore[AT]gmail[DOT]com
+ for reporting.
v1.31 2009.09.25
- add and export constants for SSL_VERIFY_*
- set SSL_use_cert if cert is given and not SSL_server
--- MANIFEST
+++ MANIFEST
@@ -34,6 +34,7 @@
t/dhe.t
t/readline.t
t/start-stopssl.t
+t/startssl-failed.t
t/acceptSSL-timeout.t
t/connectSSL-timeout.t
t/verify_hostname.t
--- META.yml
+++ META.yml
@@ -1,15 +1,23 @@
--- #YAML:1.0
-name: IO-Socket-SSL
-version: 1.31
-abstract: Nearly transparent SSL encapsulation for IO::Socket::INET.
-license: ~
-author:
+name: IO-Socket-SSL
+version: 1.35
+abstract: Nearly transparent SSL encapsulation for IO::Socket::INET.
+author:
- Steffen Ullrich & Peter Behroozi & Marko Asplund
-generated_by: ExtUtils::MakeMaker version 6.44
-distribution_type: module
-requires:
- Net::SSLeay: 1.21
- Scalar::Util: 0
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Net::SSLeay: 1.21
+ Scalar::Util: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
--- Makefile.PL
+++ Makefile.PL
@@ -53,10 +53,7 @@
# make sure that we have dualvar from the XS Version of Scalar::Util
if ( eval { require Scalar::Util } ) {
eval { Scalar::Util::dualvar( 0,'' ) };
- if ($@) {
- warn "You need the XS Version of Scalar::Util for dualvar() support";
- exit(0);
- }
+ die "You need the XS Version of Scalar::Util for dualvar() support" if ($@);
}
# check if we have something which handles IDN
--- SSL.pm
+++ SSL.pm
@@ -1,13 +1,13 @@
#!/usr/bin/perl -w
#
-# IO::Socket::SSL:
+# IO::Socket::SSL:
# a drop-in replacement for IO::Socket::INET that encapsulates
# data passed over a network with SSL.
#
# Current Code Shepherd: Steffen Ullrich <steffen at genua.de>
# Code Shepherd before: Peter Behroozi, <behrooz at fas.harvard.edu>
#
-# The original version of this module was written by
+# The original version of this module was written by
# Marko Asplund, <marko.asplund at kronodoc.fi>, who drew from
# Crypt::SSLeay (Net::SSL) by Gisle Aas.
#
@@ -31,19 +31,19 @@
SSL_RECEIVED_SHUTDOWN => 2,
};
-
+
# non-XS Versions of Scalar::Util will fail
BEGIN{
eval { use Scalar::Util 'dualvar'; dualvar(0,'') };
- die "You need the XS Version of Scalar::Util for dualvar() support"
+ die "You need the XS Version of Scalar::Util for dualvar() support"
if $@;
}
use vars qw(@ISA $VERSION $DEBUG $SSL_ERROR $GLOBAL_CONTEXT_ARGS @EXPORT );
{
- # These constants will be used in $! at return from SSL_connect,
+ # These constants will be used in $! at return from SSL_connect,
# SSL_accept, generic_read and write, thus notifying the caller
# the usual way of problems. Like with EAGAIN, EINPROGRESS..
# these are especially important for non-blocking sockets
@@ -53,10 +53,10 @@
my $y = Net::SSLeay::ERROR_WANT_WRITE();
use constant SSL_WANT_WRITE => dualvar( \$y, 'SSL wants a write first' );
- @EXPORT = qw(
- SSL_WANT_READ SSL_WANT_WRITE SSL_VERIFY_NONE SSL_VERIFY_PEER
+ @EXPORT = qw(
+ SSL_WANT_READ SSL_WANT_WRITE SSL_VERIFY_NONE SSL_VERIFY_PEER
SSL_VERIFY_FAIL_IF_NO_PEER_CERT SSL_VERIFY_CLIENT_ONCE
- $SSL_ERROR GEN_DNS GEN_IPADD
+ $SSL_ERROR GEN_DNS GEN_IPADD
);
}
@@ -65,7 +65,7 @@
BEGIN {
# Declare @ISA, $VERSION, $GLOBAL_CONTEXT_ARGS
-
+
# if we have IO::Socket::INET6 we will use this not IO::Socket::INET, because
# it can handle both IPv4 and IPv6. If we don't have INET6 available fall back
# to INET
@@ -78,7 +78,7 @@
}) {
@ISA = qw(IO::Socket::INET);
}
- $VERSION = '1.31';
+ $VERSION = '1.35';
$GLOBAL_CONTEXT_ARGS = {};
#Make $DEBUG another name for $Net::SSLeay::trace
@@ -134,11 +134,11 @@
# Export some stuff
# inet4|inet6|debug will be handeled by myself, everything
# else will be handeld the Exporter way
-sub import {
+sub import {
my $class = shift;
my @export;
- foreach (@_) {
+ foreach (@_) {
if ( /^inet4$/i ) {
# explicitly fall back to inet4
@ISA = 'IO::Socket::INET';
@@ -180,7 +180,7 @@
# work around Bug in IO::Socket::INET6 where it doesn't use the
# right family for the socket on BSD systems:
# http://rt.cpan.org/Ticket/Display.html?id=39550
- if ( $can_ipv6 && ! $arg_hash->{Domain} &&
+ if ( $can_ipv6 && ! $arg_hash->{Domain} &&
! ( $arg_hash->{LocalAddr} || $arg_hash->{LocalHost} ) &&
(my $peer = $arg_hash->{PeerAddr} || $arg_hash->{PeerHost})) {
# set Domain to AF_INET/AF_INET6 if there is only one choice
@@ -192,7 +192,7 @@
}
}
- # force initial blocking
+ # force initial blocking
# otherwise IO::Socket::SSL->new might return undef if the
# socket is nonblocking and it fails to connect immediatly
# for real nonblocking behavior one should create a nonblocking
@@ -201,7 +201,7 @@
# because Net::HTTPS simple redefines blocking() to {} (e.g
# return undef) and IO::Socket::INET does not like this we
-
+
# set Blocking only explicitly if it was set
$arg_hash->{Blocking} = 1 if defined ($blocking);
@@ -232,24 +232,24 @@
);
# common problem forgetting SSL_use_cert
- # if client cert is given but SSL_use_cert undef assume that it
+ # if client cert is given but SSL_use_cert undef assume that it
# should be set
- if ( ! $is_server && ! defined $arg_hash->{SSL_use_cert}
- && ( grep { $arg_hash->{$_} } qw(SSL_cert SSL_cert_file))
+ if ( ! $is_server && ! defined $arg_hash->{SSL_use_cert}
+ && ( grep { $arg_hash->{$_} } qw(SSL_cert SSL_cert_file))
&& ( grep { $arg_hash->{$_} } qw(SSL_key SSL_key_file)) ) {
- $arg_hash->{SSL_use_cert} = 1
+ $arg_hash->{SSL_use_cert} = 1
}
- # SSL_key_file and SSL_cert_file will only be set in defaults if
+ # SSL_key_file and SSL_cert_file will only be set in defaults if
# SSL_key|SSL_key_file resp SSL_cert|SSL_cert_file are not set in
# $args_hash
foreach my $k (qw( key cert )) {
next if exists $arg_hash->{ "SSL_${k}" };
next if exists $arg_hash->{ "SSL_${k}_file" };
- $default_args{ "SSL_${k}_file" } = $is_server
- ? "certs/server-${k}.pem"
+ $default_args{ "SSL_${k}_file" } = $is_server
+ ? "certs/server-${k}.pem"
: "certs/client-${k}.pem";
- }
+ }
# add only SSL_ca_* if not in args
if ( ! exists $arg_hash->{SSL_ca_file} && ! exists $arg_hash->{SSL_ca_path} ) {
@@ -259,7 +259,7 @@
$default_args{SSL_ca_path} = 'ca/'
}
}
-
+
#Replace nonexistent entries with defaults
%$arg_hash = ( %default_args, %$GLOBAL_CONTEXT_ARGS, %$arg_hash );
@@ -308,7 +308,7 @@
sub _set_rw_error {
my ($self,$ssl,$rv) = @_;
my $err = Net::SSLeay::get_error($ssl,$rv);
- $SSL_ERROR =
+ $SSL_ERROR =
$err == Net::SSLeay::ERROR_WANT_READ() ? SSL_WANT_READ :
$err == Net::SSLeay::ERROR_WANT_WRITE() ? SSL_WANT_WRITE :
return;
@@ -371,8 +371,8 @@
$ssl ||= ${*$self}{'_SSL_object'};
$SSL_ERROR = undef;
- my $timeout = exists $args->{Timeout}
- ? $args->{Timeout}
+ my $timeout = exists $args->{Timeout}
+ ? $args->{Timeout}
: ${*$self}{io_socket_timeout}; # from IO::Socket
if ( defined($timeout) && $timeout>0 && $self->blocking(0) ) {
DEBUG(2, "set socket to non-blocking to enforce timeout=$timeout" );
@@ -380,7 +380,7 @@
# enforce timeout with now non-blocking socket
} else {
# timeout does not apply because invalid or socket non-blocking
- $timeout = undef;
+ $timeout = undef;
}
my $start = defined($timeout) && time();
@@ -408,7 +408,7 @@
my $vec = '';
vec($vec,$self->fileno,1) = 1;
DEBUG(2, "waiting for fd to become ready: $SSL_ERROR" );
- $rv =
+ $rv =
$SSL_ERROR == SSL_WANT_READ ? select( $vec,undef,undef,$timeout) :
$SSL_ERROR == SSL_WANT_WRITE ? select( undef,$vec,undef,$timeout) :
undef;
@@ -423,7 +423,7 @@
delete ${*$self}{'_SSL_opening'};
${*$self}{'_SSL_opened'} = -1;
$self->blocking(1); # was blocking before
- return
+ return
}
# socket is ready, try non-blocking connect again after recomputing timeout
@@ -528,15 +528,15 @@
$SSL_ERROR = undef;
#DEBUG(2,'calling ssleay::accept' );
- my $timeout = exists $args->{Timeout}
- ? $args->{Timeout}
+ my $timeout = exists $args->{Timeout}
+ ? $args->{Timeout}
: ${*$self}{io_socket_timeout}; # from IO::Socket
if ( defined($timeout) && $timeout>0 && $socket->blocking(0) ) {
# timeout was given and socket was blocking
# enforce timeout with now non-blocking socket
} else {
# timeout does not apply because invalid or socket non-blocking
- $timeout = undef;
+ $timeout = undef;
}
my $start = defined($timeout) && time();
@@ -560,7 +560,7 @@
if ( $timeout>0 ) {
my $vec = '';
vec($vec,$socket->fileno,1) = 1;
- $rv =
+ $rv =
$SSL_ERROR == SSL_WANT_READ ? select( $vec,undef,undef,$timeout) :
$SSL_ERROR == SSL_WANT_WRITE ? select( undef,$vec,undef,$timeout) :
undef;
@@ -573,7 +573,7 @@
delete ${*$self}{'_SSL_opening'};
${*$socket}{'_SSL_opened'} = -1;
$socket->blocking(1); # was blocking before
- return
+ return
}
# socket is ready, try non-blocking accept again after recomputing timeout
@@ -608,14 +608,14 @@
my ($self, $read_func, undef, $length, $offset) = @_;
my $ssl = $self->_get_ssl_object || return;
my $buffer=\$_[2];
-
+
$SSL_ERROR = undef;
my $data = $read_func->($ssl, $length);
if ( !defined($data)) {
$self->_set_rw_error( $ssl,-1 ) || $self->error("SSL read error");
return;
}
-
+
$length = length($data);
$$buffer = '' if !defined $$buffer;
$offset ||= 0;
@@ -629,9 +629,9 @@
sub read {
my $self = shift;
- return $self->generic_read(
- $self->blocking ? \&Net::SSLeay::ssl_read_all : \&Net::SSLeay::read,
- @_
+ return $self->generic_read(
+ $self->blocking ? \&Net::SSLeay::ssl_read_all : \&Net::SSLeay::read,
+ @_
);
}
@@ -757,7 +757,7 @@
# find first occurence of \n\n
my $buf = '';
my $eon = 0;
- while (1) {
+ while (1) {
defined( Net::SSLeay::peek($ssl,1)) || last; # peek more, can block
my $pending = Net::SSLeay::pending($ssl);
$buf .= Net::SSLeay::peek( $ssl,$pending ); # will not block
@@ -809,8 +809,7 @@
sub stop_SSL {
my $self = shift || return _invalid_object();
my $stop_args = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};
- return $self->error("SSL object not open")
- if ! ${*$self}{'_SSL_opened'};
+ $stop_args->{SSL_no_shutdown} = 1 if ! ${*$self}{_SSL_opened};
if (my $ssl = ${*$self}{'_SSL_object'}) {
my $shutdown_done;
@@ -819,7 +818,7 @@
} else {
my $fast = $stop_args->{SSL_fast_shutdown};
my $status = Net::SSLeay::get_shutdown($ssl);
- if ( $status == SSL_RECEIVED_SHUTDOWN
+ if ( $status == SSL_RECEIVED_SHUTDOWN
|| ( $status != 0 && $fast )) {
# shutdown done
$shutdown_done = 1;
@@ -881,14 +880,6 @@
}
-sub kill_socket {
- my $self = shift;
- shutdown($self, 2);
- $self->close(SSL_no_shutdown => 1) if ${*$self}{'_SSL_opened'};
- delete(${*$self}{'_SSL_ctx'});
- return;
-}
-
sub fileno {
my $self = shift;
my $fn = ${*$self}{'_SSL_fileno'};
@@ -944,7 +935,7 @@
return $result ? $socket : (bless($socket, $original_class) && ());
} else {
DEBUG(2, "dont start handshake: $socket" );
- return $socket; # just return upgraded socket
+ return $socket; # just return upgraded socket
}
}
@@ -978,14 +969,14 @@
);
if ( $Net::SSLeay::VERSION >= 1.30 ) {
# I think X509_NAME_get_text_by_NID got added in 1.30
- $dispatcher{commonName} = sub {
+ $dispatcher{commonName} = sub {
my $cn = Net::SSLeay::X509_NAME_get_text_by_NID(
Net::SSLeay::X509_get_subject_name( shift ), NID_CommonName);
$cn =~s{\0$}{}; # work around Bug in Net::SSLeay <1.33
$cn;
}
} else {
- $dispatcher{commonName} = sub {
+ $dispatcher{commonName} = sub {
croak "you need at least Net::SSLeay version 1.30 for getting commonName"
}
}
@@ -1008,12 +999,12 @@
my ($self, $field) = @_;
my $ssl = $self->_get_ssl_object or return;
- my $cert = ${*$self}{_SSL_certificate}
- ||= Net::SSLeay::get_peer_certificate($ssl)
+ my $cert = ${*$self}{_SSL_certificate}
+ ||= Net::SSLeay::get_peer_certificate($ssl)
or return $self->error("Could not retrieve peer certificate");
if ($field) {
- my $sub = $dispatcher{$field} or croak
+ my $sub = $dispatcher{$field} or croak
"invalid argument for peer_certificate, valid are: ".join( " ",keys %dispatcher ).
"\nMaybe you need to upgrade your Net::SSLeay";
return $sub->($cert);
@@ -1036,7 +1027,7 @@
},
# rfc 2818
http => {
- wildcards_in_cn => 0,
+ wildcards_in_cn => 1,
wildcards_in_alt => 'anywhere',
check_cn => 'when_only',
},
@@ -1045,7 +1036,7 @@
# RFC3207 itself just says, that the client should expect the
# domain name of the server in the certificate. It doesn't say
# anything about wildcards, so I forbid them. It doesn't say
- # anything about alt names, but other documents show, that alt
+ # anything about alt names, but other documents show, that alt
# names should be possible. The check_cn value again is a guess.
# Fix the spec!
smtp => {
@@ -1091,16 +1082,16 @@
# is the given hostname an IP address? Then we have to convert to network byte order [RFC791][RFC2460]
- my ($ip4,$ip6);
+ my $ipn;
if ( $identity =~m{:} ) {
# no IPv4 or hostname have ':' in it, try IPv6.
# make sure that Socket6 was loaded properly
UNIVERSAL::can( __PACKAGE__, 'inet_pton' ) or croak
q[Looks like IPv6 address, make sure that Socket6 is loaded or make "use IO::Socket::SSL 'inet6'];
- $ip6 = inet_pton( $identity ) or croak "'$identity' is not IPv6, but neither IPv4 nor hostname";
+ $ipn = inet_pton( $identity ) or croak "'$identity' is not IPv6, but neither IPv4 nor hostname";
} elsif ( $identity =~m{^\d+\.\d+\.\d+\.\d+$} ) {
# definitly no hostname, try IPv4
- $ip4 = inet_aton( $identity ) or croak "'$identity' is not IPv4, but neither IPv6 nor hostname";
+ $ipn = inet_aton( $identity ) or croak "'$identity' is not IPv4, but neither IPv6 nor hostname";
} else {
# assume hostname, check for umlauts etc
if ( $identity =~m{[^a-zA-Z0-9_.\-]} ) {
@@ -1134,15 +1125,12 @@
my $alt_dnsNames = 0;
while (@altNames) {
my ($type, $name) = splice (@altNames, 0, 2);
- if ( $type == GEN_IPADD ) {
+ if ( $ipn and $type == GEN_IPADD ) {
# exakt match needed for IP
# $name is already packed format (inet_xton)
- return 1 if
- $ip6 ? $ip6 eq $name :
- $ip4 ? $ip4 eq $name :
- 0;
+ return 1 if $ipn eq $name;
- } elsif ( $type == GEN_DNS ) {
+ } elsif ( ! $ipn and $type == GEN_DNS ) {
$name =~s/\s+$//; $name =~s/^\s+//;
$alt_dnsNames++;
$check_name->($name,$identity,$scheme->{wildcards_in_alt})
@@ -1150,8 +1138,9 @@
}
}
- if ( $scheme->{check_cn} eq 'always' or
- $scheme->{check_cn} eq 'when_only' and !$alt_dnsNames) {
+ if ( ! $ipn and (
+ $scheme->{check_cn} eq 'always' or
+ $scheme->{check_cn} eq 'when_only' and !$alt_dnsNames)) {
$check_name->($commonName,$identity,$scheme->{wildcards_in_cn})
and return 1;
}
@@ -1184,8 +1173,12 @@
$@ = $self->errstr;
if (defined $error_trap and ref($error_trap) eq 'CODE') {
$error_trap->($self, $self->errstr()."\n".$self->get_ssleay_error());
- } else {
- $self->kill_socket;
+ } elsif ( ${*$self}{'_SSL_ioclass_upgraded'} ) {
+ # downgrade only
+ $self->stop_SSL;
+ } else {
+ # kill socket
+ $self->close
}
return;
}
@@ -1209,7 +1202,7 @@
sub DESTROY {
my $self = shift || return;
- $self->close(_SSL_in_DESTROY => 1, SSL_no_shutdown => 1)
+ $self->close(_SSL_in_DESTROY => 1, SSL_no_shutdown => 1)
if ${*$self}{'_SSL_opened'};
delete(${*$self}{'_SSL_ctx'});
}
@@ -1218,6 +1211,7 @@
#######Extra Backwards Compatibility Functionality#######
sub socket_to_SSL { IO::Socket::SSL->start_SSL(@_); }
sub socketToSSL { IO::Socket::SSL->start_SSL(@_); }
+sub kill_socket { shift->close }
sub issuer_name { return(shift()->peer_certificate("issuer")) }
sub subject_name { return(shift()->peer_certificate("subject")) }
@@ -1260,7 +1254,7 @@
#Redundant IO::Handle functionality
sub getline { return(scalar shift->readline()) }
-sub getlines {
+sub getlines {
return(shift->readline()) if wantarray();
croak("Use of getlines() not allowed in scalar context");
}
@@ -1364,37 +1358,32 @@
# buffer was written and not block for the rest
# SSL_MODE_ENABLE_PARTIAL_WRITE can be necessary for non-blocking because we
# cannot guarantee, that the location of the buffer stays constant
- Net::SSLeay::CTX_set_mode( $ctx,
+ Net::SSLeay::CTX_set_mode( $ctx,
SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER|SSL_MODE_ENABLE_PARTIAL_WRITE);
my $verify_mode = $arg_hash->{SSL_verify_mode};
- if ( $verify_mode != Net::SSLeay::VERIFY_NONE() and
- ! Net::SSLeay::CTX_load_verify_locations(
+ if ( $verify_mode != Net::SSLeay::VERIFY_NONE() and
+ ! Net::SSLeay::CTX_load_verify_locations(
$ctx, $arg_hash->{SSL_ca_file} || '',$arg_hash->{SSL_ca_path} || '') ) {
- if ( ! $arg_hash->{SSL_ca_file} && ! $arg_hash->{SSL_ca_path} ) {
- carp("No certificate verification because neither SSL_ca_file nor SSL_ca_path known");
- $verify_mode = Net::SSLeay::VERIFY_NONE();
- } else {
- return IO::Socket::SSL->error("Invalid certificate authority locations");
- }
+ return IO::Socket::SSL->error("Invalid certificate authority locations");
}
if ($arg_hash->{'SSL_check_crl'}) {
if (Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x0090702f) {
- Net::SSLeay::X509_STORE_set_flags(
- Net::SSLeay::CTX_get_cert_store($ctx),
- Net::SSLeay::X509_V_FLAG_CRL_CHECK()
- );
- if ($arg_hash->{'SSL_crl_file'}) {
- my $bio = Net::SSLeay::BIO_new_file($arg_hash->{'SSL_crl_file'}, 'r');
- my $crl = Net::SSLeay::PEM_read_bio_X509_CRL($bio);
- if ( $crl ) {
- Net::SSLeay::X509_STORE_add_crl(Net::SSLeay::CTX_get_cert_store($ctx), $crl);
- } else {
- return IO::Socket::SSL->error("Invalid certificate revocation list");
- }
- }
+ Net::SSLeay::X509_STORE_set_flags(
+ Net::SSLeay::CTX_get_cert_store($ctx),
+ Net::SSLeay::X509_V_FLAG_CRL_CHECK()
+ );
+ if ($arg_hash->{'SSL_crl_file'}) {
+ my $bio = Net::SSLeay::BIO_new_file($arg_hash->{'SSL_crl_file'}, 'r');
+ my $crl = Net::SSLeay::PEM_read_bio_X509_CRL($bio);
+ if ( $crl ) {
+ Net::SSLeay::X509_STORE_add_crl(Net::SSLeay::CTX_get_cert_store($ctx), $crl);
+ } else {
+ return IO::Socket::SSL->error("Invalid certificate revocation list");
+ }
+ }
} else {
return IO::Socket::SSL->error("CRL not supported for OpenSSL < v0.9.7b");
}
@@ -1422,10 +1411,10 @@
# a chain of certificates
my @x509 = ref($x509) eq 'ARRAY' ? @$x509: ($x509);
my $cert = shift @x509;
- Net::SSLeay::CTX_use_certificate( $ctx,$cert )
+ Net::SSLeay::CTX_use_certificate( $ctx,$cert )
|| return IO::Socket::SSL->error("Failed to use Certificate");
foreach my $ca (@x509) {
- Net::SSLeay::CTX_add_extra_chain_cert( $ctx,$ca )
+ Net::SSLeay::CTX_add_extra_chain_cert( $ctx,$ca )
|| return IO::Socket::SSL->error("Failed to use Certificate");
}
} elsif ( my $f = $arg_hash->{SSL_cert_file} ) {
@@ -1438,7 +1427,7 @@
Net::SSLeay::CTX_set_tmp_dh( $ctx,$dh )
|| return IO::Socket::SSL->error( "Failed to set DH from SSL_dh" );
} elsif ( my $f = $arg_hash->{SSL_dh_file} ) {
- my $bio = Net::SSLeay::BIO_new_file( $f,'r' )
+ my $bio = Net::SSLeay::BIO_new_file( $f,'r' )
|| return IO::Socket::SSL->error( "Failed to open DH file $f" );
my $dh = Net::SSLeay::PEM_read_bio_DHparams($bio);
Net::SSLeay::BIO_free($bio);
@@ -1490,7 +1479,7 @@
my ($addr,$port,$session) = @_;
$port ||= $addr =~s{:(\w+)$}{} && $1; # host:port
my $key = "$addr:$port";
- return defined($session)
+ return defined($session)
? $cache->add_session($key, $session)
: $cache->get_session($key);
}
@@ -1505,7 +1494,7 @@
my $self = shift;
if ( my $ctx = $self->{context} ) {
DEBUG( 3,"free ctx $ctx open=".join( " ",keys %CTX_CREATED_IN_THIS_THREAD ));
- if ( %CTX_CREATED_IN_THIS_THREAD and
+ if ( %CTX_CREATED_IN_THIS_THREAD and
delete $CTX_CREATED_IN_THIS_THREAD{$ctx} ) {
# remove any verify callback for this context
if ( $self->{has_verifycb}) {
@@ -1589,7 +1578,7 @@
use strict;
use IO::Socket::SSL;
- my $client = IO::Socket::SSL->new("www.example.com:https")
+ my $client = IO::Socket::SSL->new("www.example.com:https")
|| warn "I encountered a problem: ".IO::Socket::SSL::errstr();
$client->verify_hostname( 'www.example.com','http' )
|| die "hostname verification failed";
@@ -1644,7 +1633,7 @@
=item SSL_cipher_list
If this option is set the cipher list for the connection will be set to the
-given value, e.g. something like 'ALL:!LOW:!EXP:!ADH'. Look into the OpenSSL
+given value, e.g. something like 'ALL:!LOW:!EXP:!ADH'. Look into the OpenSSL
documentation (L<http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS>)
for more details.
If this option is not used the openssl builtin default is used which is suitable
@@ -1799,7 +1788,7 @@
the new() calls (or use set_default_context()) to make use of the cached sessions.
The session cache size refers to the number of unique host/port pairs that can be
stored at one time; the oldest sessions in the cache will be removed if new ones are
-added.
+added.
=item SSL_session_cache
@@ -1808,7 +1797,7 @@
This option is useful if you want to reuse the cache, but not the rest of
the context.
-A session cache object can be created using
+A session cache object can be created using
C<< IO::Socket::SSL::Session_Cache->new( cachesize ) >>.
Use set_default_session_cache() to set a global cache object.
@@ -1847,7 +1836,7 @@
=item SSL_fast_shutdown
-If set to true only a unidirectional shutdown will be done, e.g. only the
+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 bidrectional
shutdown will be done. If used within close() it defaults to true, if used
within stop_SSL() it defaults to false.
@@ -1885,7 +1874,7 @@
=item B<peer_certificate($field)>
-If a peer certificate exists, this function can retrieve values from it.
+If a peer certificate exists, this function can retrieve values from it.
If no field is given the internal representation of certificate from Net::SSLeay is
returned.
The following fields can be queried:
@@ -1910,7 +1899,7 @@
server, like example.org, example.com, *.example.com.
It returns a list of (typ,value) with typ GEN_DNS, GEN_IPADD etc (these
-constants are exported from IO::Socket::SSL).
+constants are exported from IO::Socket::SSL).
See Net::SSLeay::X509_get_subjectAltNames.
=back
@@ -1947,23 +1936,23 @@
=back
-The scheme can be given either by specifying the name for one of the above predefined
-schemes, by using a callback (see below) or by using a hash which can have the
+The scheme can be given either by specifying the name for one of the above predefined
+schemes, by using a callback (see below) or by using a hash which can have the
following keys and values:
=over 8
=item check_cn: 0|'always'|'when_only'
-Determines if the common name gets checked. If 'always' it will always be checked
+Determines if the common name gets checked. If 'always' it will always be checked
(like in ldap), if 'when_only' it will only be checked if no names are given in
subjectAltNames (like in http), for any other values the common name will not be checked.
=item wildcards_in_alt: 0|'leftmost'|'anywhere'
Determines if and where wildcards in subjectAltNames are possible. If 'leftmost'
-only cases like *.example.org will be possible (like in ldap), for 'anywhere'
-www*.example.org is possible too (like http), dangerous things like but www.*.org
+only cases like *.example.org will be possible (like in ldap), for 'anywhere'
+www*.example.org is possible too (like http), dangerous things like but www.*.org
or even '*' will not be allowed.
=item wildcards_in_cn: 0|'leftmost'|'anywhere'
@@ -1986,7 +1975,7 @@
For read and write errors on non-blocking sockets, this method may include the string
C<SSL wants a read first!> or C<SSL wants a write first!> meaning that the other side
is expecting to read from or write to the socket and wants to be satisfied before you
-get to do anything. But with version 0.98 you are better comparing the global exported
+get to do anything. But with version 0.98 you are better comparing the global exported
variable $SSL_ERROR against the exported symbols SSL_WANT_READ and SSL_WANT_WRITE.
=item B<opened()>
@@ -2004,8 +1993,8 @@
If you have a class that inherits from IO::Socket::SSL and you want the $socket to be blessed
into your own class instead, use MyClass->start_SSL($socket) to achieve the desired effect.
-Note that if start_SSL() fails in SSL negotiation, $socket will remain blessed in its
-original class. For non-blocking sockets you better just upgrade the socket to
+Note that if start_SSL() fails in SSL negotiation, $socket will remain blessed in its
+original class. For non-blocking sockets you better just upgrade the socket to
IO::Socket::SSL and call accept_SSL or connect_SSL and the upgraded object. To
just upgrade the socket set B<SSL_startHandshake> explicitly to 0. If you call start_SSL
w/o this parameter it will revert to blocking behavior for accept_SSL and connect_SSL.
@@ -2022,7 +2011,7 @@
Will return true if it suceeded 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
+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.
=item B<< IO::Socket::SSL->new_from_fd($fd, ...) >>
@@ -2100,12 +2089,12 @@
=head1 IPv6
Support for IPv6 with IO::Socket::SSL is expected to work and basic testing is done.
-If IO::Socket::INET6 is available it will automatically use it instead of
-IO::Socket::INET4.
+If IO::Socket::INET6 is available it will automatically use it instead of
+IO::Socket::INET4.
Please be aware of the associated problems: If you give a name as a host and the
host resolves to both IPv6 and IPv4 it will try IPv6 first and if there is no IPv6
-connectivity it will fail.
+connectivity it will fail.
To avoid these problems you can either force IPv4 by specifying and AF_INET as the
Domain (this is per socket) or load IO::Socket::SSL with the option 'inet4'
@@ -2127,7 +2116,7 @@
If you are having problems using IO::Socket::SSL despite the fact that can recite backwards
the section of this documentation labelled 'Using SSL', you should try enabling debugging. To
specify the debug level, pass 'debug#' (where # is a number from 0 to 3) to IO::Socket::SSL
-when calling it.
+when calling it.
The debug level will also be propagated to Net::SSLeay::trace, see also L<Net::SSLeay>:
=over 4
@@ -2158,7 +2147,7 @@
=head1 BUGS
IO::Socket::SSL is not threadsafe.
-This is because IO::Socket::SSL is based on Net::SSLeay which
+This is because IO::Socket::SSL is based on Net::SSLeay which
uses a global object to access some of the API of openssl
and is therefore not threadsafe.
It might probably work if you don't use SSL_verify_callback and
@@ -2198,6 +2187,9 @@
use IO::Socket::SSL->start_SSL() instead
+=item kill_socket()
+
+use close() instead
=item get_peer_certificate()
--- t/core.t
+++ t/core.t
@@ -236,7 +236,7 @@
my $self = shift;
print $self "This server is SSL only";
$error_trapped = 1;
- $self->kill_socket;
+ $self->close;
}
$error_trapped or print "not ";
--- t/memleak_bad_handshake.t
+++ t/memleak_bad_handshake.t
@@ -61,9 +61,18 @@
}
my $size200 = getsize($pid);
+for(200..300) {
+ IO::Socket::INET->new( $addr ) or next;
+}
+my $size300 = getsize($pid);
+if ($size100>$size200 or $size200<$size300) {;
+ print "1..0 # skipped - do we measure the right thing?\n";
+ exit;
+}
+
print "1..1\n";
-print "not " if $size100 != $size200;
-print "ok # check memleak failed handshake ($size100,$size200)\n";
+print "not " if $size100 < $size200 and $size200 < $size300;
+print "ok # check memleak failed handshake ($size100,$size200,$size300)\n";
kill(9,$pid);
wait;
--- t/startssl-failed.t
+++ t/startssl-failed.t
+#!perl -w
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/nonblock.t'
+
+
+use Net::SSLeay;
+use Socket;
+use IO::Socket::SSL;
+use IO::Select;
+use Errno qw(EAGAIN EINPROGRESS );
+use strict;
+
+use vars qw( $SSL_SERVER_ADDR );
+do "t/ssl_settings.req" || do "ssl_settings.req";
+
+if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
+ print "1..0 # Skipped: fork not implemented on this platform\n";
+ exit
+}
+
+$|=1;
+print "1..9\n";
+
+
+my $server = IO::Socket::INET->new(
+ LocalAddr => $SSL_SERVER_ADDR,
+ Listen => 2,
+ ReuseAddr => 1,
+);
+print("not ok\n"),exit if !$server;
+ok("Server Initialization");
+my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname );
+
+
+defined( my $pid = fork() ) || die $!;
+if ( $pid == 0 ) {
+ client();
+} else {
+ server();
+ #kill(9,$pid);
+ wait;
+}
+
+
+sub client {
+ close($server);
+ my $client = IO::Socket::INET->new( "$SSL_SERVER_ADDR:$SSL_SERVER_PORT" )
+ or return fail("client tcp connect");
+ ok("client tcp connect");
+
+ IO::Socket::SSL->start_SSL($client) and
+ return fail('start ssl should fail');
+ ok("startssl client failed: $SSL_ERROR");
+
+ UNIVERSAL::isa($client,'IO::Socket::INET') or
+ return fail('downgrade socket after error');
+ ok('downgrade socket after error');
+
+ print $client "foo\n" or return fail("send to server: $!");
+ ok("send to server");
+ my $l;
+ while (defined($l = <$client>)) {
+ if ( $l =~m{bar\n} ) {
+ return ok('client receive non-ssl data');
+ }
+ #warn "XXXXXXXX $l";
+ }
+ fail("receive non-ssl data");
+}
+
+sub server {
+ my $csock = $server->accept or return fail('tcp accept');
+ ok('tcp accept');
+ print $csock "This is no SSL handshake\n";
+ ok('send non-ssl data');
+
+ alarm(10);
+ my $l;
+ while (defined( $l = <$csock>)) {
+ if ($l =~m{foo\n} ) {
+ print $csock "bar\n";
+ return ok("received non-ssl data");
+ }
+ #warn "XXXXXXXXX $l";
+ }
+ fail('no data from client'.$!);
+}
+
+
+sub ok { print "ok #$_[0]\n"; return 1 }
+sub fail { print "not ok #$_[0]\n"; return }
+
More information about the MeeGo-commits
mailing list