Hi On Wed, Dec 08, 2010 at 09:52:13PM +0100, Moritz Muehlenhoff wrote: > Package: release.debian.org > Severity: normal > User: release.debian.org@packages.debian.org > Usertags: unblock > > Please unblock package libio-socket-ssl-perl. It fixes CVE-2010-4334. > > If the diff between 1.33 and 1.35 is to large to unblock, we'll need > a tpu upload with the security fix only, adding Salvatore to CC. > > unblock libio-socket-ssl-perl/1.35-1 Thanks Moritz, for filling this as bug too. I asked already for comment from release team [1], but did it not as bugreport against release.debian.org. Agree, if changes from 1.33 to 1.35 are to large to unblock, I can prepare an upload to t-p-u only containing the fix from 1.34 to 1.35. In any case I attach here the debdiff between 1.33-1 and 1.35-1 too. [1] http://lists.debian.org/debian-release/2010/12/msg00209.html Bests and thanks! Salvatore
diff -Nru libio-socket-ssl-perl-1.33/Changes libio-socket-ssl-perl-1.35/Changes
--- libio-socket-ssl-perl-1.33/Changes 2010-03-17 13:48:59.000000000 +0100
+++ libio-socket-ssl-perl-1.35/Changes 2010-12-06 08:57:39.000000000 +0100
@@ -1,4 +1,18 @@
+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
diff -Nru libio-socket-ssl-perl-1.33/debian/changelog libio-socket-ssl-perl-1.35/debian/changelog
--- libio-socket-ssl-perl-1.33/debian/changelog 2010-12-08 22:16:05.000000000 +0100
+++ libio-socket-ssl-perl-1.35/debian/changelog 2010-12-06 10:48:08.000000000 +0100
@@ -1,3 +1,27 @@
+libio-socket-ssl-perl (1.35-1) unstable; urgency=low
+
+ * New upstream release (Closes: #606058).
+ * Refresh debian/copyright: Update copyright information for debian/*
+ packaging stanza.
+
+ -- Salvatore Bonaccorso <carnil@debian.org> Mon, 06 Dec 2010 10:48:05 +0100
+
+libio-socket-ssl-perl (1.34-1) unstable; urgency=low
+
+ [ Salvatore Bonaccorso ]
+ * Update my email address.
+
+ [ Ansgar Burchardt ]
+ * Update my email address.
+ * Use source format 3.0 (quilt).
+ * Bump Standards-Version to 3.9.1.
+
+ [ Angel Abad ]
+ * New upstream release
+ * debian/copyirght: Update license information
+
+ -- Angel Abad <angelabad@gmail.com> Tue, 02 Nov 2010 15:20:49 +0100
+
libio-socket-ssl-perl (1.33-1) unstable; urgency=low
* New upstream release
diff -Nru libio-socket-ssl-perl-1.33/debian/control libio-socket-ssl-perl-1.35/debian/control
--- libio-socket-ssl-perl-1.33/debian/control 2010-12-08 22:16:05.000000000 +0100
+++ libio-socket-ssl-perl-1.35/debian/control 2010-11-06 21:45:16.000000000 +0100
@@ -3,14 +3,14 @@
Priority: optional
Maintainer: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
Uploaders: gregor herrmann <gregoa@debian.org>,
- Ansgar Burchardt <ansgar@43-1.org>, Rene Mayorga <rmayorga@debian.org>,
+ Ansgar Burchardt <ansgar@debian.org>, Rene Mayorga <rmayorga@debian.org>,
Antonio Radici <antonio@dyne.org>,
- Salvatore Bonaccorso <salvatore.bonaccorso@gmail.com>,
+ Salvatore Bonaccorso <carnil@debian.org>,
Angel Abad <angelabad@gmail.com>
Build-Depends: debhelper (>= 7)
Build-Depends-Indep: libio-socket-inet6-perl, libnet-libidn-perl,
libnet-ssleay-perl (>= 1.35), netbase, perl
-Standards-Version: 3.8.4
+Standards-Version: 3.9.1
Homepage: http://search.cpan.org/dist/IO-Socket-SSL/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libio-socket-ssl-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libio-socket-ssl-perl/
diff -Nru libio-socket-ssl-perl-1.33/debian/copyright libio-socket-ssl-perl-1.35/debian/copyright
--- libio-socket-ssl-perl-1.33/debian/copyright 2010-12-08 22:16:05.000000000 +0100
+++ libio-socket-ssl-perl-1.35/debian/copyright 2010-12-06 10:17:28.000000000 +0100
@@ -14,12 +14,12 @@
Copyright: 2000-2004, Davide Puricelli (evo) <evo@debian.org>
2000, Christian Surchi <csurchi@debian.org>
2005-2007, Florian Ragwitz <rafl@debian.org>
- 2008-2009, Ansgar Burchardt <ansgar@43-1.org>
+ 2008-2009, Ansgar Burchardt <ansgar@debian.org>
2008-2009, gregor herrmann <gregoa@debian.org>
2008, Mark Hymers <mhy@debian.org>
2008, Rene Mayorga <rmayorga@debian.org.sv>
2009, Antonio Radici <antonio@dyne.org>
- 2009, Salvatore Bonaccorso <salvatore.bonaccorso@gmail.com>
+ 2009, 2010, Salvatore Bonaccorso <carnil@debian.org>
2010, Angel Abad <angelabad@gmail.com>
License: Artistic or GPL-1+
@@ -27,8 +27,8 @@
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License, which comes with Perl.
.
- On Debian GNU/Linux systems, the complete text of the Artistic License
- can be found in `/usr/share/common-licenses/Artistic'
+ On Debian systems, the complete text of the Artistic License can be
+ found in `/usr/share/common-licenses/Artistic'.
License: GPL-1+
This program is free software; you can redistribute it and/or modify
@@ -36,5 +36,5 @@
the Free Software Foundation; either version 1, or (at your option)
any later version.
.
- On Debian GNU/Linux systems, the complete text of the GNU General
- Public License can be found in `/usr/share/common-licenses/GPL'
+ On Debian systems, the complete text of version 1 of the General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.
diff -Nru libio-socket-ssl-perl-1.33/debian/source/format libio-socket-ssl-perl-1.35/debian/source/format
--- libio-socket-ssl-perl-1.33/debian/source/format 1970-01-01 01:00:00.000000000 +0100
+++ libio-socket-ssl-perl-1.35/debian/source/format 2010-12-08 22:16:05.860119412 +0100
@@ -0,0 +1 @@
+3.0 (quilt)
diff -Nru libio-socket-ssl-perl-1.33/MANIFEST libio-socket-ssl-perl-1.35/MANIFEST
--- libio-socket-ssl-perl-1.33/MANIFEST 2010-03-17 13:51:54.000000000 +0100
+++ libio-socket-ssl-perl-1.35/MANIFEST 2010-12-06 08:59:17.000000000 +0100
@@ -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
diff -Nru libio-socket-ssl-perl-1.33/META.yml libio-socket-ssl-perl-1.35/META.yml
--- libio-socket-ssl-perl-1.33/META.yml 2010-03-17 13:51:54.000000000 +0100
+++ libio-socket-ssl-perl-1.35/META.yml 2010-12-06 08:59:17.000000000 +0100
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: IO-Socket-SSL
-version: 1.33
+version: 1.35
abstract: Nearly transparent SSL encapsulation for IO::Socket::INET.
author:
- Steffen Ullrich & Peter Behroozi & Marko Asplund
@@ -8,6 +8,8 @@
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
requires:
Net::SSLeay: 1.21
Scalar::Util: 0
@@ -15,7 +17,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.48
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
diff -Nru libio-socket-ssl-perl-1.33/SSL.pm libio-socket-ssl-perl-1.35/SSL.pm
--- libio-socket-ssl-perl-1.33/SSL.pm 2010-03-17 13:46:00.000000000 +0100
+++ libio-socket-ssl-perl-1.35/SSL.pm 2010-12-06 08:58:28.000000000 +0100
@@ -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.33';
+ $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 => {
@@ -1148,7 +1139,7 @@
}
if ( ! $ipn and (
- $scheme->{check_cn} eq 'always' or
+ $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;
@@ -1182,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;
}
@@ -1207,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'});
}
@@ -1216,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")) }
@@ -1258,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");
}
@@ -1362,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");
}
@@ -1420,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} ) {
@@ -1436,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);
@@ -1488,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);
}
@@ -1503,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}) {
@@ -1587,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";
@@ -1642,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
@@ -1797,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
@@ -1806,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.
@@ -1845,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.
@@ -1883,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:
@@ -1908,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
@@ -1945,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'
@@ -1984,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()>
@@ -2002,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.
@@ -2020,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, ...) >>
@@ -2098,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'
@@ -2125,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
@@ -2156,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
@@ -2196,6 +2187,9 @@
use IO::Socket::SSL->start_SSL() instead
+=item kill_socket()
+
+use close() instead
=item get_peer_certificate()
diff -Nru libio-socket-ssl-perl-1.33/t/core.t libio-socket-ssl-perl-1.35/t/core.t
--- libio-socket-ssl-perl-1.33/t/core.t 2009-04-01 09:47:04.000000000 +0200
+++ libio-socket-ssl-perl-1.35/t/core.t 2010-11-01 09:52:07.000000000 +0100
@@ -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 ";
diff -Nru libio-socket-ssl-perl-1.33/t/startssl-failed.t libio-socket-ssl-perl-1.35/t/startssl-failed.t
--- libio-socket-ssl-perl-1.33/t/startssl-failed.t 1970-01-01 01:00:00.000000000 +0100
+++ libio-socket-ssl-perl-1.35/t/startssl-failed.t 2010-11-01 09:45:43.000000000 +0100
@@ -0,0 +1,92 @@
+#!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 }
+
Attachment:
signature.asc
Description: Digital signature