[libnet-sslglue-perl] 01/01: Imported Upstream version 1.054
dom at earth.li
dom at earth.li
Thu Aug 27 18:59:26 UTC 2015
This is an automated email from the git hooks/post-receive script.
dom pushed a commit to annotated tag upstream/1.054
in repository libnet-sslglue-perl.
commit 9249d8ce1cb66ad62554e5174edf4e18a91402b2
Author: Dominic Hargreaves <dom at earth.li>
Date: Thu Aug 27 19:57:21 2015 +0100
Imported Upstream version 1.054
---
Changes | 9 ++
MANIFEST | 3 +-
META.json | 46 ++++++++
META.yml | 41 ++++----
lib/Net/SSLGlue.pm | 4 +-
lib/Net/SSLGlue/FTP.pm | 221 +++++++++++++++++++-------------------
lib/Net/SSLGlue/LDAP.pm | 24 ++---
lib/Net/SSLGlue/LWP.pm | 274 +++++++++++++++++++++++++++---------------------
lib/Net/SSLGlue/POP3.pm | 190 ++++++++++++++++++---------------
lib/Net/SSLGlue/SMTP.pm | 181 ++++++++++++++++++--------------
t/external/03_lwp.t | 9 +-
t/external/05_ftp.t | 60 +++++------
12 files changed, 598 insertions(+), 464 deletions(-)
diff --git a/Changes b/Changes
index e853530..5a7e8fe 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,12 @@
+1.054 2015/04/28
+- if a version of libnet is detected which already supports TLS (i.e.
+ libnet 3.0+) warn and use this instead.
+
+1.053 2014/05/28
+- if current LWP is detected is use this mostly unpatched
+- fix Net::SSLGlue::FTP to use the same hostname when verifying the
+ certificate of the data connection
+
1.052 2014/01/16
- FTPS: reuse same SSL session for control and data channnel to work
with default configuration of proftpd.
diff --git a/MANIFEST b/MANIFEST
index 2c2acbf..211ae7d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -22,4 +22,5 @@ t/external/02_smtp.t
t/external/03_lwp.t
t/external/04_pop3.t
t/external/05_ftp.t
-META.yml Module meta-data (added by MakeMaker)
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..45287a6
--- /dev/null
+++ b/META.json
@@ -0,0 +1,46 @@
+{
+ "abstract" : "unknown",
+ "author" : [
+ "unknown"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Net-SSLGlue",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "IO::Socket::SSL" : "1.19"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "url" : "https://github.com/noxxi/p5-net-sslglue"
+ }
+ },
+ "version" : "1.054"
+}
diff --git a/META.yml b/META.yml
index 8007d08..f840198 100644
--- a/META.yml
+++ b/META.yml
@@ -1,23 +1,24 @@
---- #YAML:1.0
-name: Net-SSLGlue
-version: 1.052
-abstract: ~
-author: []
-license: unknown
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
+---
+abstract: unknown
+author:
+ - unknown
build_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: 0
+configure_requires:
+ ExtUtils::MakeMaker: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
+license: unknown
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Net-SSLGlue
+no_index:
+ directory:
+ - t
+ - inc
requires:
- IO::Socket::SSL: 1.19
+ IO::Socket::SSL: 1.19
resources:
- repository: https://github.com/noxxi/p5-net-sslglue
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.57_05
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ repository: https://github.com/noxxi/p5-net-sslglue
+version: 1.054
diff --git a/lib/Net/SSLGlue.pm b/lib/Net/SSLGlue.pm
index 8e7ce83..70f1d34 100644
--- a/lib/Net/SSLGlue.pm
+++ b/lib/Net/SSLGlue.pm
@@ -1,5 +1,5 @@
package Net::SSLGlue;
-our $VERSION = '1.052';
+our $VERSION = '1.054';
=head1 NAME
@@ -25,7 +25,7 @@ available:
=item Net::LDAP - add proper certificate checking
-=item LWP - add proper certificate checking
+=item LWP - add proper certificate checking for older LWP versions
=back
diff --git a/lib/Net/SSLGlue/FTP.pm b/lib/Net/SSLGlue/FTP.pm
index 70d020a..ea1ba96 100644
--- a/lib/Net/SSLGlue/FTP.pm
+++ b/lib/Net/SSLGlue/FTP.pm
@@ -8,11 +8,20 @@ use IO::Socket::SSL '$SSL_ERROR';
use Net::SSLGlue::Socket;
use Socket 'AF_INET';
-our $VERSION = 1.001;
+our $VERSION = 1.002;
BEGIN {
+ require Net::FTP;
+ if (defined &Net::FTP::starttls) {
+ warn "using SSL support of Net::FTP $Net::FTP::VERSION instead of SSLGlue";
+ goto DONE;
+ }
+
+ $Net::FTP::VERSION eq '2.77'
+ or warn "Not tested with Net::FTP version $Net::FTP::VERSION";
+
+ require Net::FTP::dataconn;
for my $class (qw(Net::FTP Net::FTP::dataconn)) {
- eval "require $class" or die "failed to load $class";
no strict 'refs';
my $fixed;
for( @{ "${class}::ISA" } ) {
@@ -24,13 +33,9 @@ BEGIN {
die "cannot replace IO::Socket::INET with Net::SSLGlue::Socket in ${class}::ISA"
if ! $fixed;
}
- $Net::FTP::VERSION eq '2.77'
- or warn "Not tested with Net::FTP version $Net::FTP::VERSION";
-}
-# redefine Net::FTP::new so that it understands SSL => 1 and connects directly
-# with SSL to the server
-{
+ # redefine Net::FTP::new so that it understands SSL => 1 and connects directly
+ # with SSL to the server
no warnings 'redefine';
my $onew = Net::FTP->can('new');
*Net::FTP::new = sub {
@@ -53,68 +58,65 @@ BEGIN {
${*$self}{net_ftp_tlsargs} = \%sslargs;
return $self;
};
-}
-# add starttls method to upgrade connection to SSL: AUTH TLS
-sub Net::FTP::starttls {
- my $self = shift;
- $self->is_ssl and croak("called starttls within SSL session");
- $self->_AUTH('TLS') == Net::FTP::CMD_OK or return;
-
- my $host = $self->host;
- # for name verification strip port from domain:port, ipv4:port, [ipv6]:port
- $host =~s{(?<!:):\d+$}{};
-
- my %args = (
- SSL_verify_mode => 1,
- SSL_verifycn_scheme => 'ftp',
- SSL_verifycn_name => $host,
- # reuse SSL session of control connection in data connections
- SSL_session_cache => Net::SSLGlue::FTP::SingleSessionCache->new,
- %{ ${*$self}{net_ftp_tlsargs}},
- @_
- );
+ # add starttls method to upgrade connection to SSL: AUTH TLS
+ *Net::FTP::starttls = sub {
+ my $self = shift;
+ $self->is_ssl and croak("called starttls within SSL session");
+ $self->_AUTH('TLS') == &Net::FTP::CMD_OK or return;
+
+ my $host = $self->host;
+ # for name verification strip port from domain:port, ipv4:port, [ipv6]:port
+ $host =~s{(?<!:):\d+$}{};
+
+ my %args = (
+ SSL_verify_mode => 1,
+ SSL_verifycn_scheme => 'ftp',
+ SSL_verifycn_name => $host,
+ # reuse SSL session of control connection in data connections
+ SSL_session_cache => Net::SSLGlue::FTP::SingleSessionCache->new,
+ %{ ${*$self}{net_ftp_tlsargs}},
+ @_
+ );
- $self->start_SSL(%args) or return;
- ${*$self}{net_ftp_tlsargs} = \%args;
- $self->prot('P');
- return 1;
-}
+ $self->start_SSL(%args) or return;
+ ${*$self}{net_ftp_tlsargs} = \%args;
+ $self->prot('P');
+ return 1;
+ };
-# add prot method to set protection level (PROT C|P)
-sub Net::FTP::prot {
- my ($self,$type) = @_;
- $type eq 'C' or $type eq 'P' or croak("type must by C or P");
- $self->_PBSZ(0) or return;
- $self->_PROT($type) or return;
- ${*$self}{net_ftp_tlstype} = $type;
- return 1;
-}
+ # add prot method to set protection level (PROT C|P)
+ *Net::FTP::prot = sub {
+ my ($self,$type) = @_;
+ $type eq 'C' or $type eq 'P' or croak("type must by C or P");
+ $self->_PBSZ(0) or return;
+ $self->_PROT($type) or return;
+ ${*$self}{net_ftp_tlstype} = $type;
+ return 1;
+ };
-# add stoptls method to downgrade connection from SSL: CCC
-sub Net::FTP::stoptls {
- my $self = shift;
- $self->is_ssl or croak("called stoptls outside SSL session");
- $self->_CCC() or return;
- $self->stop_SSL();
- return 1;
-}
+ # add stoptls method to downgrade connection from SSL: CCC
+ *Net::FTP::stoptls = sub {
+ my $self = shift;
+ $self->is_ssl or croak("called stoptls outside SSL session");
+ $self->_CCC() or return;
+ $self->stop_SSL();
+ return 1;
+ };
-# add EPSV for new style passive mode (incl. IPv6)
-sub Net::FTP::epsv {
- my $self = shift;
- @_ and croak 'usage: $ftp->epsv()';
- delete ${*$self}{net_ftp_intern_port};
+ # add EPSV for new style passive mode (incl. IPv6)
+ *Net::FTP::epsv = sub {
+ my $self = shift;
+ @_ and croak 'usage: $ftp->epsv()';
+ delete ${*$self}{net_ftp_intern_port};
- $self->_EPSV && $self->message =~ m{\(([\x33-\x7e])\1\1(\d+)\1\)}
- ? ${*$self}{'net_ftp_pasv'} = [ $self->peerhost, $2 ]
- : undef;
-}
+ $self->_EPSV && $self->message =~ m{\(([\x33-\x7e])\1\1(\d+)\1\)}
+ ? ${*$self}{'net_ftp_pasv'} = [ $self->peerhost, $2 ]
+ : undef;
+ };
-# redefine PASV so that it uses EPSV on IPv6
-# also net_ftp_pasv contains now the parsed [ip,port]
-{
- no warnings 'redefine';
+ # redefine PASV so that it uses EPSV on IPv6
+ # also net_ftp_pasv contains now the parsed [ip,port]
*Net::FTP::pasv = sub {
my $self = shift;
@_ and croak 'usage: $ftp->port()';
@@ -129,62 +131,56 @@ sub Net::FTP::epsv {
}
return;
};
-}
-# add EPRT for new style passive mode (incl. IPv6)
-sub Net::FTP::eprt {
- @_ == 1 || @_ == 2 or croak 'usage: $self->eprt([PORT])';
- return _eprt('EPRT', at _);
-}
+ # add EPRT for new style passive mode (incl. IPv6)
+ *Net::FTP::eprt = sub {
+ @_ == 1 || @_ == 2 or croak 'usage: $self->eprt([PORT])';
+ return _eprt('EPRT', at _);
+ };
-# redefine PORT to use EPRT for IPv6
-{
- no warnings 'redefine';
+ # redefine PORT to use EPRT for IPv6
*Net::FTP::port = sub {
@_ == 1 || @_ == 2 or croak 'usage: $self->port([PORT])';
return _eprt('PORT', at _);
};
-}
-sub _eprt {
- my ($cmd,$self,$port) = @_;
- delete ${*$self}{net_ftp_intern_port};
- unless ($port) {
- my $listen = ${*$self}{net_ftp_listen} ||= Net::SSLGlue::Socket->new(
- Listen => 1,
- Timeout => $self->timeout,
- LocalAddr => $self->sockhost,
- );
- ${*$self}{net_ftp_intern_port} = 1;
- my $fam = ($listen->sockdomain == AF_INET) ? 1:2;
- if ( $cmd eq 'EPRT' || $fam == 2 ) {
- $port = "|$fam|".$listen->sockhost."|".$listen->sockport."|";
- $cmd = 'EPRT';
- } else {
- my $p = $listen->sockport;
- $port = join(',',split(m{\.},$listen->sockhost),$p >> 8,$p & 0xff);
+ sub _eprt {
+ my ($cmd,$self,$port) = @_;
+ delete ${*$self}{net_ftp_intern_port};
+ unless ($port) {
+ my $listen = ${*$self}{net_ftp_listen} ||= Net::SSLGlue::Socket->new(
+ Listen => 1,
+ Timeout => $self->timeout,
+ LocalAddr => $self->sockhost,
+ );
+ ${*$self}{net_ftp_intern_port} = 1;
+ my $fam = ($listen->sockdomain == AF_INET) ? 1:2;
+ if ( $cmd eq 'EPRT' || $fam == 2 ) {
+ $port = "|$fam|".$listen->sockhost."|".$listen->sockport."|";
+ $cmd = 'EPRT';
+ } else {
+ my $p = $listen->sockport;
+ $port = join(',',split(m{\.},$listen->sockhost),$p >> 8,$p & 0xff);
+ }
}
+ my $ok = $cmd eq 'EPRT' ? $self->_EPRT($port) : $self->_PORT($port);
+ ${*$self}{net_ftp_port} = $port if $ok;
+ return $ok;
}
- my $ok = $cmd eq 'EPRT' ? $self->_EPRT($port) : $self->_PORT($port);
- ${*$self}{net_ftp_port} = $port if $ok;
- return $ok;
-}
-for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) {
- no strict 'refs';
- *{"Net::FTP::_$cmd"} = sub {
- shift->command("$cmd @_")->response() == Net::FTP::CMD_OK
+ for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) {
+ no strict 'refs';
+ *{"Net::FTP::_$cmd"} = sub {
+ shift->command("$cmd @_")->response() == &Net::FTP::CMD_OK
+ }
}
-}
-# redefine _dataconn to
-# - support IPv6
-# - upgrade data connection to SSL if PROT P
-{
- no warnings 'redefine';
+ # redefine _dataconn to
+ # - support IPv6
+ # - upgrade data connection to SSL if PROT P
*Net::FTP::_dataconn = sub {
my $self = shift;
my $pkg = "Net::FTP::" . $self->type;
@@ -205,10 +201,13 @@ for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) {
}
if (( ${*$self}{net_ftp_tlstype} || '') eq 'P'
- && ! $conn->start_SSL( $self->is_ssl
- ? ( SSL_reuse_ctx => $self )
- : ( %{${*$self}{net_ftp_tlsargs}} )
- ) ) {
+ && ! $conn->start_SSL( $self->is_ssl ? (
+ SSL_reuse_ctx => $self,
+ SSL_verifycn_name => ${*$self}{net_ftp_tlsargs}->{SSL_verifycn_name}
+ ):(
+ %{${*$self}{net_ftp_tlsargs}}
+ )
+ )) {
croak("failed to ssl upgrade dataconn: $SSL_ERROR");
return;
}
@@ -220,6 +219,9 @@ for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) {
${*$conn}{net_ftp_blksize} = ${*$self}{net_ftp_blksize};
return $conn;
};
+
+ DONE:
+ 1;
}
{
@@ -288,8 +290,7 @@ of L<IO::Socket::SSL> to C<Net::FTP::new>.
=item starttls
If the connection is not yet SSLified it will issue the "AUTH TLS" command and
-change the object, so that SSL will now be used. The usual C<SSL_*> parameter of
-L<IO::Socket::SSL> will be given.
+change the object, so that SSL will now be used.
=item peer_certificate ...
diff --git a/lib/Net/SSLGlue/LDAP.pm b/lib/Net/SSLGlue/LDAP.pm
index e26f26a..d618341 100644
--- a/lib/Net/SSLGlue/LDAP.pm
+++ b/lib/Net/SSLGlue/LDAP.pm
@@ -12,16 +12,16 @@ our %SSLopts;
# Net::LDAP::_SSL_context_init_args
my $old = defined &Net::LDAP::_SSL_context_init_args
- && \&Net::LDAP::_SSL_context_init_args
- || die "cannot find Net::LDAP::_SSL_context_init_args";
+ && \&Net::LDAP::_SSL_context_init_args
+ || die "cannot find Net::LDAP::_SSL_context_init_args";
no warnings 'redefine';
*Net::LDAP::_SSL_context_init_args = sub {
- my %arg = $old->(@_);
- $arg{SSL_verifycn_scheme} ||= 'ldap' if $arg{SSL_verify_mode};
- while ( my ($k,$v) = each %SSLopts ) {
- $arg{$k} = $v;
- }
- return %arg;
+ my %arg = $old->(@_);
+ $arg{SSL_verifycn_scheme} ||= 'ldap' if $arg{SSL_verify_mode};
+ while ( my ($k,$v) = each %SSLopts ) {
+ $arg{$k} = $v;
+ }
+ return %arg;
};
1;
@@ -32,10 +32,10 @@ Net::SSLGlue::LDAP - proper certificate checking for ldaps in Net::LDAP
=head1 SYNOPSIS
- use Net::SSLGlue::LDAP;
- local %Net::SSLGlue::LDAP = ( SSL_verifycn_name => $hostname_in_cert );
- my $ldap = Net::LDAP->new( $hostname, capath => ... );
- $ldap->start_tls;
+ use Net::SSLGlue::LDAP;
+ local %Net::SSLGlue::LDAP = ( SSL_verifycn_name => $hostname_in_cert );
+ my $ldap = Net::LDAP->new( $hostname, capath => ... );
+ $ldap->start_tls;
=head1 DESCRIPTION
diff --git a/lib/Net/SSLGlue/LWP.pm b/lib/Net/SSLGlue/LWP.pm
index 9eb83b8..43ec259 100644
--- a/lib/Net/SSLGlue/LWP.pm
+++ b/lib/Net/SSLGlue/LWP.pm
@@ -1,132 +1,156 @@
use strict;
use warnings;
package Net::SSLGlue::LWP;
-our $VERSION = 0.4;
+our $VERSION = 0.5;
use LWP::UserAgent '5.822';
use IO::Socket::SSL 1.19;
use URI;
# force Net::SSLGlue::LWP::Socket as superclass of Net::HTTPS, because
# only it can verify certificates
+my $use_existent;
BEGIN {
+ require LWP::Protocol::https;
+ $use_existent = $LWP::Protocol::https::VERSION >= 6.06
+ && $LWP::UserAgent::VERSION >= 6.06;
+ if ($use_existent) {
+ my $oc = $Net::HTTPS::SSL_SOCKET_CLASS ||
+ $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS};
+ $use_existent = 0 if $oc && $oc ne 'IO::Socket::SSL';
+ }
+ if ($use_existent) {
+ warn "Your LWP::UserAgent/LWP::Protocol::https looks fine.\n".
+ "Will use it instead of Net::SSLGLue::LWP\n";
+ } else {
my $oc = $Net::HTTPS::SSL_SOCKET_CLASS;
$Net::HTTPS::SSL_SOCKET_CLASS = my $need = 'Net::SSLGlue::LWP::Socket';
require Net::HTTPS;
- require LWP::Protocol::https;
+
if ( ( my $oc = $Net::HTTPS::SSL_SOCKET_CLASS ) ne $need ) {
- # was probably loaded before, change ISA
- grep { s{^\Q$oc\E$}{$need} } @Net::HTTPS::ISA
+ # was probably loaded before, change ISA
+ grep { s{^\Q$oc\E$}{$need} } @Net::HTTPS::ISA
}
die "cannot force $need into Net::HTTPS"
- if $Net::HTTPS::SSL_SOCKET_CLASS ne $need;
+ if $Net::HTTPS::SSL_SOCKET_CLASS ne $need;
+ }
}
+
our %SSLopts; # set by local and import
sub import {
- shift;
- %SSLopts = @_;
+ shift;
+ %SSLopts = @_;
}
-{
- # add SSL options
- my $old_eso = UNIVERSAL::can( 'LWP::Protocol::https','_extra_sock_opts' );
- no warnings 'redefine';
- *LWP::Protocol::https::_extra_sock_opts = sub {
- return (
- $old_eso ? ( $old_eso->(@_) ):(),
- SSL_verify_mode => 1,
- SSL_verifycn_scheme => 'http',
- HTTPS_proxy => $_[0]->{ua}{https_proxy},
- %SSLopts,
- );
- };
+if (!$use_existent) {
+ # add SSL options
+ my $old_eso = UNIVERSAL::can( 'LWP::Protocol::https','_extra_sock_opts' );
+ no warnings 'redefine';
+ *LWP::Protocol::https::_extra_sock_opts = sub {
+ return (
+ $old_eso ? ( $old_eso->(@_) ):(),
+ SSL_verify_mode => 1,
+ SSL_verifycn_scheme => 'http',
+ HTTPS_proxy => $_[0]->{ua}{https_proxy},
+ %SSLopts,
+ );
+ };
+
+ # fix https_proxy handling - forward it to a variable handled by me
+ my $old_proxy = defined &LWP::UserAgent::proxy && \&LWP::UserAgent::proxy
+ or die "cannot find LWP::UserAgent::proxy";
+ *LWP::UserAgent::proxy = sub {
+ my ($self,$key,$val) = @_;
+ goto &$old_proxy if ref($key) || $key ne 'https';
+ if (@_>2) {
+ my $rv = &$old_proxy;
+ $self->{https_proxy} = delete $self->{proxy}{https}
+ || die "https proxy not set?";
+ }
+ return $self->{https_proxy};
+ };
+
+} else {
+ # wrapper around LWP::Protocol::https::_extra_sock_opts to support %SSLopts
+ my $old_eso = UNIVERSAL::can( 'LWP::Protocol::https','_extra_sock_opts' )
+ or die "no LWP::Protocol::https::_extra_sock_opts found";
+ no warnings 'redefine';
+ *LWP::Protocol::https::_extra_sock_opts = sub {
+ return (
+ $old_eso->(@_),
+ %SSLopts,
+ );
+ };
}
{
- # fix https_proxy handling - forward it to a variable handled by me
- my $old_proxy = defined &LWP::UserAgent::proxy && \&LWP::UserAgent::proxy
- or die "cannot find LWP::UserAgent::proxy";
- no warnings 'redefine';
- *LWP::UserAgent::proxy = sub {
- my ($self,$key,$val) = @_;
- goto &$old_proxy if ref($key) || $key ne 'https';
- if (@_>2) {
- my $rv = &$old_proxy;
- $self->{https_proxy} = delete $self->{proxy}{https}
- || die "https proxy not set?";
- }
- return $self->{https_proxy};
+
+ package Net::SSLGlue::LWP::Socket;
+ use IO::Socket::SSL;
+ use base 'IO::Socket::SSL';
+ my $sockclass = 'IO::Socket::INET';
+ use URI::Escape 'uri_unescape';
+ use MIME::Base64 'encode_base64';
+ $sockclass .= '6' if eval "require IO::Socket::INET6";
+
+ sub configure {
+ my ($self,$args) = @_;
+ my $phost = delete $args->{HTTPS_proxy}
+ or return $self->SUPER::configure($args);
+ $phost = URI->new($phost) if ! ref $phost;
+
+ my $port = $args->{PeerPort};
+ my $host = $args->{PeerHost} || $args->{PeerAddr};
+ if ( ! $port ) {
+ $host =~s{:(\w+)$}{};
+ $port = $args->{PeerPort} = $1;
+ $args->{PeerHost} = $host;
+ }
+ if ( $phost->scheme ne 'http' ) {
+ $@ = "scheme ".$phost->scheme." not supported for https_proxy";
+ return;
+ }
+ my $auth = '';
+ if ( my ($user,$pass) = split( ':', $phost->userinfo || '' ) ) {
+ $auth = "Proxy-authorization: Basic ".
+ encode_base64( uri_unescape($user).':'.uri_unescape($pass),'' ).
+ "\r\n";
}
-}
-{
+ my $pport = $phost->port;
+ $phost = $phost->host;
+
+ # temporally downgrade $self so that the right connect chain
+ # gets called w/o doing SSL stuff. If we don't do it it will
+ # try to call IO::Socket::SSL::connect
+ my $ssl_class = ref($self);
+ bless $self,$sockclass;
+ $self->configure({ %$args, PeerAddr => $phost, PeerPort => $pport }) or do {
+ $@ = "connect to proxy $phost port $pport failed";
+ return;
+ };
+ print $self "CONNECT $host:$port HTTP/1.0\r\n$auth\r\n";
+ my $hdr = '';
+ while (<$self>) {
+ $hdr .= $_;
+ last if $_ eq "\n" or $_ eq "\r\n";
+ }
+ if ( $hdr !~m{\AHTTP/1.\d 2\d\d} ) {
+ # error
+ $@ = "non 2xx response to CONNECT: $hdr";
+ return;
+ }
- package Net::SSLGlue::LWP::Socket;
- use IO::Socket::SSL;
- use base 'IO::Socket::SSL';
- my $sockclass = 'IO::Socket::INET';
- use URI::Escape 'uri_unescape';
- use MIME::Base64 'encode_base64';
- $sockclass .= '6' if eval "require IO::Socket::INET6";
-
- sub configure {
- my ($self,$args) = @_;
- my $phost = delete $args->{HTTPS_proxy}
- or return $self->SUPER::configure($args);
- $phost = URI->new($phost) if ! ref $phost;
-
- my $port = $args->{PeerPort};
- my $host = $args->{PeerHost} || $args->{PeerAddr};
- if ( ! $port ) {
- $host =~s{:(\w+)$}{};
- $port = $args->{PeerPort} = $1;
- $args->{PeerHost} = $host;
- }
- if ( $phost->scheme ne 'http' ) {
- $@ = "scheme ".$phost->scheme." not supported for https_proxy";
- return;
- }
- my $auth = '';
- if ( my ($user,$pass) = split( ':', $phost->userinfo || '' ) ) {
- $auth = "Proxy-authorization: Basic ".
- encode_base64( uri_unescape($user).':'.uri_unescape($pass),'' ).
- "\r\n";
- }
-
- my $pport = $phost->port;
- $phost = $phost->host;
-
- # temporally downgrade $self so that the right connect chain
- # gets called w/o doing SSL stuff. If we don't do it it will
- # try to call IO::Socket::SSL::connect
- my $ssl_class = ref($self);
- bless $self,$sockclass;
- $self->configure({ %$args, PeerAddr => $phost, PeerPort => $pport }) or do {
- $@ = "connect to proxy $phost port $pport failed";
- return;
- };
- print $self "CONNECT $host:$port HTTP/1.0\r\n$auth\r\n";
- my $hdr = '';
- while (<$self>) {
- $hdr .= $_;
- last if $_ eq "\n" or $_ eq "\r\n";
- }
- if ( $hdr !~m{\AHTTP/1.\d 2\d\d} ) {
- # error
- $@ = "non 2xx response to CONNECT: $hdr";
- return;
- }
-
- # and upgrade self by calling start_SSL
- $ssl_class->start_SSL( $self,
- SSL_verifycn_name => $host,
- %$args
- ) or do {
- $@ = "start SSL failed: $SSL_ERROR";
- return;
- };
- return $self;
+ # and upgrade self by calling start_SSL
+ $ssl_class->start_SSL( $self,
+ SSL_verifycn_name => $host,
+ %$args
+ ) or do {
+ $@ = "start SSL failed: $SSL_ERROR";
+ return;
};
+ return $self;
+ };
}
1;
@@ -136,25 +160,25 @@ sub import {
Net::SSLGlue::LWP - proper certificate checking for https in LWP
=head1 SYNOPSIS
-
- use Net::SSLGlue::LWP SSL_ca_path => ...;
- use LWP::Simple;
- get( 'https://www....' );
-
- {
- local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
-
- # switch off verification
- $Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0;
-
- # or: set different verification policy, because cert does
- # not conform to RFC (wildcards in CN are not allowed for https,
- # but some servers do it anyway)
- $Net::SSLGlue::LWP::SSLopts{SSL_verifycn_scheme} = {
- wildcards_in_cn => 'anywhere',
- check_cn => 'always',
- };
- }
+u
+ use Net::SSLGlue::LWP SSL_ca_path => ...;
+ use LWP::Simple;
+ get( 'https://www....' );
+
+ {
+ local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
+
+ # switch off verification
+ $Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0;
+
+ # or: set different verification policy, because cert does
+ # not conform to RFC (wildcards in CN are not allowed for https,
+ # but some servers do it anyway)
+ $Net::SSLGlue::LWP::SSLopts{SSL_verifycn_scheme} = {
+ wildcards_in_cn => 'anywhere',
+ check_cn => 'always',
+ };
+ }
=head1 DESCRIPTION
@@ -164,6 +188,9 @@ L<Net::HTTPS> is forced to use L<IO::Socket::SSL> instead of L<Crypt::SSLeay>,
and that L<LWP::Protocol::https> does proper certificate checking using the
C<http> SSL_verify_scheme from L<IO::Socket::SSL>.
+This module should only be used for older LWP version, see B<Supported LWP
+versions> below.
+
Because L<LWP> does not have a mechanism to forward arbitrary parameters for
the construction of the underlying socket these parameters can be set globally
when including the package, or with local settings of the
@@ -192,13 +219,20 @@ another name you can specify it with this parameter.
=back
+=head1 Supported LWP versions
+
+This module should be used for older LWP version only. Starting with version
+6.06 it is recommended to use LWP directly. If a recent version is found
+Net::SSLGlue::LWP will print out a warning and not monkey patch too much into
+LWP (only as much as necessary to still support C<%Net::SSLGlue::LWP::SSLopts>).
+
=head1 SEE ALSO
IO::Socket::SSL, LWP, Net::HTTPS, LWP::Protocol::https
=head1 COPYRIGHT
-This module is copyright (c) 2008, Steffen Ullrich.
+This module is copyright (c) 2008..2015, Steffen Ullrich.
All Rights Reserved.
This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.
diff --git a/lib/Net/SSLGlue/POP3.pm b/lib/Net/SSLGlue/POP3.pm
index 498e3fd..34b5174 100644
--- a/lib/Net/SSLGlue/POP3.pm
+++ b/lib/Net/SSLGlue/POP3.pm
@@ -4,42 +4,55 @@ use warnings;
package Net::SSLGlue::POP3;
use IO::Socket::SSL 1.19;
use Net::POP3;
-our $VERSION = 0.91;
-
-##############################################################################
-# mix starttls method into Net::POP3 which on SSL handshake success
-# upgrades the class to Net::POP3::_SSLified
-##############################################################################
-sub Net::POP3::starttls {
+our $VERSION = 0.911;
+
+my $DONT;
+BEGIN {
+ if (defined &Net::POP3::starttls) {
+ warn "using SSL support of Net::POP3 $Net::POP3::VERSION instead of SSLGlue";
+ $DONT = 1;
+ goto DONE;
+ }
+
+ ##############################################################################
+ # mix starttls method into Net::POP3 which on SSL handshake success
+ # upgrades the class to Net::SSLGlue::POP3::_SSLified
+ ##############################################################################
+ *Net::POP3::starttls = sub {
my $self = shift;
$self->_STLS or return;
my $host = $self->host;
# for name verification strip port from domain:port, ipv4:port, [ipv6]:port
$host =~s{(?<!:):\d+$}{};
- Net::POP3::_SSLified->start_SSL( $self,
- SSL_verify_mode => 1,
- SSL_verifycn_scheme => 'pop3',
- SSL_verifycn_name => $host,
- @_
+ Net::SSLGlue::POP3::_SSLified->start_SSL( $self,
+ SSL_verify_mode => 1,
+ SSL_verifycn_scheme => 'pop3',
+ SSL_verifycn_name => $host,
+ @_
) or return;
-}
-sub Net::POP3::_STLS {
+ };
+
+ *Net::POP3::_STLS = sub {
shift->command("STLS")->response() == Net::POP3::CMD_OK
-}
+ };
-no warnings 'redefine';
-my $old_new = \&Net::POP3::new;
-*Net::POP3::new = sub {
+ no warnings 'redefine';
+ my $old_new = \&Net::POP3::new;
+ *Net::POP3::new = sub {
my $class = shift;
my %arg = @_ % 2 == 0 ? @_ : ( Host => shift, at _ );
if ( delete $arg{SSL} ) {
- $arg{Port} ||= 995;
- return Net::POP3::_SSLified->new(%arg);
+ $arg{Port} ||= 995;
+ return Net::SSLGlue::POP3::_SSLified->new(%arg);
} else {
- return $old_new->($class,%arg);
+ return $old_new->($class,%arg);
}
-};
+ };
+
+ DONE:
+ 1;
+}
##############################################################################
# Socket class derived from IO::Socket::SSL
@@ -47,25 +60,29 @@ my $old_new = \&Net::POP3::new;
##############################################################################
our %SSLopts;
{
- package Net::POP3::_SSL_Socket;
- our @ISA = 'IO::Socket::SSL';
- sub configure_SSL {
- my ($self,$arg_hash) = @_;
-
- # set per default strict certificate verification
- $arg_hash->{SSL_verify_mode} = 1
- if ! exists $arg_hash->{SSL_verify_mode};
- $arg_hash->{SSL_verifycn_scheme} = 'pop3'
- if ! exists $arg_hash->{SSL_verifycn_scheme};
- $arg_hash->{SSL_verifycn_name} = $self->host
- if ! exists $arg_hash->{SSL_verifycn_name};
-
- # force keys from %SSLopts
- while ( my ($k,$v) = each %SSLopts ) {
- $arg_hash->{$k} = $v;
- }
- return $self->SUPER::configure_SSL($arg_hash)
+ package Net::SSLGlue::POP3::_SSL_Socket;
+ goto DONE if $DONT;
+ our @ISA = 'IO::Socket::SSL';
+ *configure_SSL = sub {
+ my ($self,$arg_hash) = @_;
+
+ # set per default strict certificate verification
+ $arg_hash->{SSL_verify_mode} = 1
+ if ! exists $arg_hash->{SSL_verify_mode};
+ $arg_hash->{SSL_verifycn_scheme} = 'pop3'
+ if ! exists $arg_hash->{SSL_verifycn_scheme};
+ $arg_hash->{SSL_verifycn_name} = $self->host
+ if ! exists $arg_hash->{SSL_verifycn_name};
+
+ # force keys from %SSLopts
+ while ( my ($k,$v) = each %SSLopts ) {
+ $arg_hash->{$k} = $v;
}
+ return $self->SUPER::configure_SSL($arg_hash)
+ };
+
+ DONE:
+ 1;
}
@@ -74,45 +91,48 @@ our %SSLopts;
# this talks SSL to the peer
##############################################################################
{
- package Net::POP3::_SSLified;
- use Carp 'croak';
-
- # deriving does not work because we need to replace a superclass
- # from Net::POP3, so just copy the class into the new one and then
- # change it
-
- # copy subs
- for ( keys %{Net::POP3::} ) {
- no strict 'refs';
- eval { *{$Net::POP3::{$_}} && *{$Net::POP3::{$_}}{CODE} } or next;
- *{$_} = \&{ "Net::POP3::$_" };
- }
+ package Net::SSLGlue::POP3::_SSLified;
+ use Carp 'croak';
+ goto DONE if $DONT;
+
+ # deriving does not work because we need to replace a superclass
+ # from Net::POP3, so just copy the class into the new one and then
+ # change it
+
+ # copy subs
+ for ( keys %{Net::POP3::} ) {
+ no strict 'refs';
+ *{$_} = \&{ "Net::POP3::$_" } if defined &{ "Net::POP3::$_" };
+ }
+
+ # copy + fix @ISA
+ our @ISA = @Net::POP3::ISA;
+ grep { s{^IO::Socket::INET$}{Net::SSLGlue::POP3::_SSL_Socket} } @ISA
+ or die "cannot find and replace IO::Socket::INET superclass";
+
+ # we are already sslified
+ no warnings 'redefine';
+ *starttls = sub { croak "have already TLS\n" };
+
+ my $old_new = \&new;
+ *new = sub {
+ my $class = shift;
+ my %arg = @_ % 2 == 0 ? @_ : ( Host => shift, at _ );
+ local %SSLopts;
+ $SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
+ return $old_new->($class,%arg);
+ };
+
+ # Net::Cmd getline uses select, but this is not sufficient with SSL
+ # note that this does no EBCDIC etc conversions
+ *getline = sub {
+ my $self = shift;
+ # skip Net::POP3 getline and go directly to IO::Socket::SSL
+ return $self->IO::Socket::SSL::getline(@_);
+ };
- # copy + fix @ISA
- our @ISA = @Net::POP3::ISA;
- grep { s{^IO::Socket::INET$}{Net::POP3::_SSL_Socket} } @ISA
- or die "cannot find and replace IO::Socket::INET superclass";
-
- # we are already sslified
- no warnings 'redefine';
- sub starttls { croak "have already TLS\n" }
-
- my $old_new = \&new;
- *Net::POP3::_SSLified::new = sub {
- my $class = shift;
- my %arg = @_ % 2 == 0 ? @_ : ( Host => shift, at _ );
- local %SSLopts;
- $SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
- return $old_new->($class,%arg);
- };
-
- # Net::Cmd getline uses select, but this is not sufficient with SSL
- # note that this does no EBCDIC etc conversions
- *Net::POP3::_SSLified::getline = sub {
- my $self = shift;
- # skip Net::POP3 getline and go directly to IO::Socket::SSL
- return $self->IO::Socket::SSL::getline(@_);
- };
+ DONE:
+ 1;
}
1;
@@ -123,14 +143,14 @@ Net::SSLGlue::POP3 - make Net::POP3 able to use SSL
=head1 SYNOPSIS
- use Net::SSLGlue::POP3;
- my $pop3s = Net::POP3->new( $host,
- SSL => 1,
- SSL_ca_path => ...
- );
+ use Net::SSLGlue::POP3;
+ my $pop3s = Net::POP3->new( $host,
+ SSL => 1,
+ SSL_ca_path => ...
+ );
- my $pop3 = Net::POP3->new( $host );
- $pop3->starttls( SSL_ca_path => ... );
+ my $pop3 = Net::POP3->new( $host );
+ $pop3->starttls( SSL_ca_path => ... );
=head1 DESCRIPTION
diff --git a/lib/Net/SSLGlue/SMTP.pm b/lib/Net/SSLGlue/SMTP.pm
index c5fb9dd..3b028b8 100644
--- a/lib/Net/SSLGlue/SMTP.pm
+++ b/lib/Net/SSLGlue/SMTP.pm
@@ -4,52 +4,65 @@ use warnings;
package Net::SSLGlue::SMTP;
use IO::Socket::SSL 1.19;
use Net::SMTP;
-our $VERSION = 1.0;
-
-##############################################################################
-# mix starttls method into Net::SMTP which on SSL handshake success
-# upgrades the class to Net::SMTP::_SSLified
-##############################################################################
-sub Net::SMTP::starttls {
+our $VERSION = 1.001;
+
+my $DONT;
+BEGIN {
+ if (defined &Net::SMTP::starttls) {
+ warn "using SSL support of Net::SMTP $Net::SMTP::VERSION instead of SSLGlue";
+ $DONT = 1;
+ goto DONE;
+ }
+
+ ##############################################################################
+ # mix starttls method into Net::SMTP which on SSL handshake success
+ # upgrades the class to Net::SSLGlue::SMTP::_SSLified
+ ##############################################################################
+ *Net::SMTP::starttls = sub {
my $self = shift;
$self->_STARTTLS or return;
my $host = $self->host;
# for name verification strip port from domain:port, ipv4:port, [ipv6]:port
$host =~s{(?<!:):\d+$}{};
- Net::SMTP::_SSLified->start_SSL( $self,
- SSL_verify_mode => 1,
- SSL_verifycn_scheme => 'smtp',
- SSL_verifycn_name => $host,
- @_
+ Net::SSLGlue::SMTP::_SSLified->start_SSL( $self,
+ SSL_verify_mode => 1,
+ SSL_verifycn_scheme => 'smtp',
+ SSL_verifycn_name => $host,
+ @_
) or return;
# another hello after starttls to read new ESMTP capabilities
return $self->hello(${*$self}{net_smtp_hello_domain});
-}
-sub Net::SMTP::_STARTTLS {
+ };
+
+ *Net::SMTP::_STARTTLS = sub {
shift->command("STARTTLS")->response() == Net::SMTP::CMD_OK
-}
+ };
-no warnings 'redefine';
-my $old_new = \&Net::SMTP::new;
-*Net::SMTP::new = sub {
+ no warnings 'redefine';
+ my $old_new = \&Net::SMTP::new;
+ *Net::SMTP::new = sub {
my $class = shift;
my %arg = @_ % 2 == 0 ? @_ : ( Host => shift, at _ );
if ( delete $arg{SSL} ) {
- $arg{Port} ||= 465;
- return Net::SMTP::_SSLified->new(%arg);
+ $arg{Port} ||= 465;
+ return Net::SSLGlue::SMTP::_SSLified->new(%arg);
} else {
- return $old_new->($class,%arg);
+ return $old_new->($class,%arg);
}
-};
+ };
-my $old_hello = \&Net::SMTP::hello;
-*Net::SMTP::hello = sub {
+ my $old_hello = \&Net::SMTP::hello;
+ *Net::SMTP::hello = sub {
my ($self,$domain) = @_;
${*$self}{net_smtp_hello_domain} = $domain if $domain;
goto &$old_hello;
-};
+ };
+
+ DONE:
+ 1;
+}
##############################################################################
# Socket class derived from IO::Socket::SSL
@@ -57,63 +70,71 @@ my $old_hello = \&Net::SMTP::hello;
##############################################################################
our %SSLopts;
{
- package Net::SMTP::_SSL_Socket;
- our @ISA = 'IO::Socket::SSL';
- sub configure_SSL {
- my ($self,$arg_hash) = @_;
-
- # set per default strict certificate verification
- $arg_hash->{SSL_verify_mode} = 1
- if ! exists $arg_hash->{SSL_verify_mode};
- $arg_hash->{SSL_verifycn_scheme} = 'smtp'
- if ! exists $arg_hash->{SSL_verifycn_scheme};
- $arg_hash->{SSL_verifycn_name} = $self->host
- if ! exists $arg_hash->{SSL_verifycn_name};
-
- # force keys from %SSLopts
- while ( my ($k,$v) = each %SSLopts ) {
- $arg_hash->{$k} = $v;
- }
- return $self->SUPER::configure_SSL($arg_hash)
+ package Net::SSLGlue::SMTP::_SSL_Socket;
+ goto DONE if $DONT;
+ our @ISA = 'IO::Socket::SSL';
+ *configure_SSL = sub {
+ my ($self,$arg_hash) = @_;
+
+ # set per default strict certificate verification
+ $arg_hash->{SSL_verify_mode} = 1
+ if ! exists $arg_hash->{SSL_verify_mode};
+ $arg_hash->{SSL_verifycn_scheme} = 'smtp'
+ if ! exists $arg_hash->{SSL_verifycn_scheme};
+ $arg_hash->{SSL_verifycn_name} = $self->host
+ if ! exists $arg_hash->{SSL_verifycn_name};
+
+ # force keys from %SSLopts
+ while ( my ($k,$v) = each %SSLopts ) {
+ $arg_hash->{$k} = $v;
}
+ return $self->SUPER::configure_SSL($arg_hash)
+ };
+
+ DONE:
+ 1;
}
##############################################################################
-# Net::SMTP derived from Net::SMTP::_SSL_Socket instead of IO::Socket::INET
+# Net::SMTP derived from Net::SSLGlue::SMTP::_SSL_Socket instead of IO::Socket::INET
# this talks SSL to the peer
##############################################################################
{
- package Net::SMTP::_SSLified;
- use Carp 'croak';
-
- # deriving does not work because we need to replace a superclass
- # from Net::SMTP, so just copy the class into the new one and then
- # change it
-
- # copy subs
- for ( keys %{Net::SMTP::} ) {
- no strict 'refs';
- *{$_} = \&{ "Net::SMTP::$_" } if *{$Net::SMTP::{$_}}{CODE};
- }
+ package Net::SSLGlue::SMTP::_SSLified;
+ use Carp 'croak';
+ goto DONE if $DONT;
+
+ # deriving does not work because we need to replace a superclass
+ # from Net::SMTP, so just copy the class into the new one and then
+ # change it
+
+ # copy subs
+ for ( keys %{Net::SMTP::} ) {
+ no strict 'refs';
+ *{$_} = \&{ "Net::SMTP::$_" } if defined &{ "Net::SMTP::$_" };
+ }
+
+ # copy + fix @ISA
+ our @ISA = @Net::SMTP::ISA;
+ grep { s{^IO::Socket::INET$}{Net::SSLGlue::SMTP::_SSL_Socket} } @ISA
+ or die "cannot find and replace IO::Socket::INET superclass";
+
+ # we are already sslified
+ no warnings 'redefine';
+ *starttls = sub { croak "have already TLS\n" };
+
+ my $old_new = \&new;
+ *new = sub {
+ my $class = shift;
+ my %arg = @_ % 2 == 0 ? @_ : ( Host => shift, at _ );
+ local %SSLopts;
+ $SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
+ return $old_new->($class,%arg);
+ };
- # copy + fix @ISA
- our @ISA = @Net::SMTP::ISA;
- grep { s{^IO::Socket::INET$}{Net::SMTP::_SSL_Socket} } @ISA
- or die "cannot find and replace IO::Socket::INET superclass";
-
- # we are already sslified
- no warnings 'redefine';
- sub starttls { croak "have already TLS\n" }
-
- my $old_new = \&new;
- *Net::SMTP::_SSLified::new = sub {
- my $class = shift;
- my %arg = @_ % 2 == 0 ? @_ : ( Host => shift, at _ );
- local %SSLopts;
- $SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
- return $old_new->($class,%arg);
- };
+ DONE:
+ 1;
}
1;
@@ -124,14 +145,14 @@ Net::SSLGlue::SMTP - make Net::SMTP able to use SSL
=head1 SYNOPSIS
- use Net::SSLGlue::SMTP;
- my $smtp_ssl = Net::SMTP->new( $host,
- SSL => 1,
- SSL_ca_path => ...
- );
+ use Net::SSLGlue::SMTP;
+ my $smtp_ssl = Net::SMTP->new( $host,
+ SSL => 1,
+ SSL_ca_path => ...
+ );
- my $smtp_plain = Net::SMTP->new( $host );
- $smtp_plain->starttls( SSL_ca_path => ... );
+ my $smtp_plain = Net::SMTP->new( $host );
+ $smtp_plain->starttls( SSL_ca_path => ... );
=head1 DESCRIPTION
diff --git a/t/external/03_lwp.t b/t/external/03_lwp.t
index a6f5853..aff0e08 100644
--- a/t/external/03_lwp.t
+++ b/t/external/03_lwp.t
@@ -15,8 +15,7 @@ use IO::Socket::SSL;
use LWP::Simple;
my $goodhost = 'google.de';
-# this does not work any longer - will be skipped in test
-my $badhost = 'www.fedora.org';
+my $badhost = 'badcert.maulwuff.de';
my $capath = '/etc/ssl/certs/'; # unix?
-d $capath or do {
@@ -61,6 +60,8 @@ if ( $sock = IO::Socket::INET->new(
if ( IO::Socket::SSL->start_SSL( $sock,
SSL_ca_path => $capath,
SSL_verify_mode => 1,
+ SSL_verifycn_scheme => 'http',
+ SSL_verifycn_name => $badhost,
)) {
diag("certificate for $badhost unexpectly correct");
$badhost = undef;
@@ -84,14 +85,14 @@ print $content ? "ok\n": "not ok # lwp connect $goodhost: $@\n";
if ( $badhost ) {
# $badhost -> should fail
diag("connecting to $badhost:443 with LWP");
- $content = get( 'https://$badhost' );
+ $content = get( "https://$badhost" );
print $content ? "not ok # lwp ssl connect $badhost should fail\n": "ok\n";
# $badhost -> should succeed if verify mode is 0
{
local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
$Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0;
- $content = get( 'https://$badhost' );
+ $content = get( "https://$badhost" );
print $content ? "ok\n": "not ok # lwp ssl $badhost w/o ssl verify\n";
}
}
diff --git a/t/external/05_ftp.t b/t/external/05_ftp.t
index 7a8cbbf..6980e03 100644
--- a/t/external/05_ftp.t
+++ b/t/external/05_ftp.t
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Test::More;
-my $server = 'ftp.rebex.net';
+my $server = 'test.rebex.net';
my $debug = 0;
BEGIN {
@@ -28,7 +28,7 @@ IO::Socket::INET->new( "$server:21" ) or do {
# ssl to the right host
diag( "connect inet to $server:990" );
my $sock = IO::Socket::INET->new( "$server:990") or do {
- plan skip_all => "$server:999 not reachable";
+ plan skip_all => "$server:990 not reachable";
};
# now we need CAs
@@ -39,12 +39,12 @@ close($cafh);
diag( "upgrade to ssl $server:990" );
IO::Socket::SSL->start_SSL($sock,
- %sslargs,
SSL_verify_mode => 1,
SSL_verifycn_name => $server,
- SSL_verifycn_scheme => 'ftp'
+ SSL_verifycn_scheme => 'ftp',
+ %sslargs,
) or do {
- plan skip_all => "$server:999 not upgradable to SSL: $SSL_ERROR";
+ plan skip_all => "$server:990 not upgradable to SSL: $SSL_ERROR";
};
plan tests => 9;
@@ -67,9 +67,9 @@ $ftp->prot('C');
ok(~~$ftp->ls,"directory listing clear");
# then TLS upgrade inside plain connection
-$ftp = Net::FTP->new($server, Passive => 1, Debug => $debug);
+$ftp = Net::FTP->new($server, Passive => 1, Debug => $debug, %sslargs);
ok($ftp,"ftp plain connect $server");
-my $ok = $ftp->starttls(%sslargs);
+my $ok = $ftp->starttls();
ok($ok,"ssl upgrade");
$ftp->login("anonymous",'net-sslglue-ftp at test.perl')
or die "login to $server failed";
@@ -84,24 +84,24 @@ ok(~~$ftp->ls,"directory listing after downgrade");
__DATA__
-# Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Class 1 Primary Intermediate Server CA
+# Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Class 2 Primary Intermediate Server CA
# Issuer: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority
-----BEGIN CERTIFICATE-----
-MIIGNDCCBBygAwIBAgIBGDANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJJTDEW
+MIIGNDCCBBygAwIBAgIBGjANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJJTDEW
MBQGA1UEChMNU3RhcnRDb20gTHRkLjErMCkGA1UECxMiU2VjdXJlIERpZ2l0YWwg
Q2VydGlmaWNhdGUgU2lnbmluZzEpMCcGA1UEAxMgU3RhcnRDb20gQ2VydGlmaWNh
-dGlvbiBBdXRob3JpdHkwHhcNMDcxMDI0MjA1NDE3WhcNMTcxMDI0MjA1NDE3WjCB
+dGlvbiBBdXRob3JpdHkwHhcNMDcxMDI0MjA1NzA5WhcNMTcxMDI0MjA1NzA5WjCB
jDELMAkGA1UEBhMCSUwxFjAUBgNVBAoTDVN0YXJ0Q29tIEx0ZC4xKzApBgNVBAsT
IlNlY3VyZSBEaWdpdGFsIENlcnRpZmljYXRlIFNpZ25pbmcxODA2BgNVBAMTL1N0
-YXJ0Q29tIENsYXNzIDEgUHJpbWFyeSBJbnRlcm1lZGlhdGUgU2VydmVyIENBMIIB
-IjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAtonGrO8JUngHrJJj0PREGBiE
-gFYfka7hh/oyULTTRwbw5gdfcA4Q9x3AzhA2NIVaD5Ksg8asWFI/ujjo/OenJOJA
-pgh2wJJuniptTT9uYSAK21ne0n1jsz5G/vohURjXzTCm7QduO3CHtPn66+6CPAVv
-kvek3AowHpNz/gfK11+AnSJYUq4G2ouHI2mw5CrY6oPSvfNx23BaKA+vWjhwRRI/
-ME3NO68X5Q/LoKldSKqxYVDLNM08XMML6BDAjJvwAwNi/rJsPnIO7hxDKslIDlc5
-xDEhyBDBLIf+VJVSH1I8MRKbf+fAoKVZ1eKPPvDVqOHXcDGpxLPPr21TLwb0pwID
+YXJ0Q29tIENsYXNzIDIgUHJpbWFyeSBJbnRlcm1lZGlhdGUgU2VydmVyIENBMIIB
+IjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA4k85L6GMmoWtCA4IPlfyiAEh
+G5SpbOK426oZGEY6UqH1D/RujOqWjJaHeRNAUS8i8gyLhw9l33F0NENVsTUJm9m8
+H/rrQtCXQHK3Q5Y9upadXVACHJuRjZzArNe7LxfXyz6CnXPrB0KSss1ks3RVG7RL
+hiEs93iHMuAW5Nq9TJXqpAp+tgoNLorPVavD5d1Bik7mb2VsskDPF125w2oLJxGE
+d2H2wnztwI14FBiZgZl1Y7foU9O6YekO+qIw80aiuckfbIBaQKwn7UhHM7BUxkYa
+8zVhwQIpkFR+ZE3EMFICgtffziFuGJHXuKuMJxe18KMBL47SLoc6PbQpZ4rEAwID
AQABo4IBrTCCAakwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYD
-VR0OBBYEFOtCNNCYsKuf9BtrCPfMZC7vDixFMB8GA1UdIwQYMBaAFE4L7xqkQFul
+VR0OBBYEFBHbI0X9VMxqcW+EigPXvvcBLyaGMB8GA1UdIwQYMBaAFE4L7xqkQFul
F2mHMMo0aEPQQa7yMGYGCCsGAQUFBwEBBFowWDAnBggrBgEFBQcwAYYbaHR0cDov
L29jc3Auc3RhcnRzc2wuY29tL2NhMC0GCCsGAQUFBzAChiFodHRwOi8vd3d3LnN0
YXJ0c3NsLmNvbS9zZnNjYS5jcnQwWwYDVR0fBFQwUjAnoCWgI4YhaHR0cDovL3d3
@@ -109,18 +109,18 @@ dy5zdGFydHNzbC5jb20vc2ZzY2EuY3JsMCegJaAjhiFodHRwOi8vY3JsLnN0YXJ0
c3NsLmNvbS9zZnNjYS5jcmwwgYAGA1UdIAR5MHcwdQYLKwYBBAGBtTcBAgEwZjAu
BggrBgEFBQcCARYiaHR0cDovL3d3dy5zdGFydHNzbC5jb20vcG9saWN5LnBkZjA0
BggrBgEFBQcCARYoaHR0cDovL3d3dy5zdGFydHNzbC5jb20vaW50ZXJtZWRpYXRl
-LnBkZjANBgkqhkiG9w0BAQUFAAOCAgEAIQlJPqWIbuALi0jaMU2P91ZXouHTYlfp
-tVbzhUV1O+VQHwSL5qBaPucAroXQ+/8gA2TLrQLhxpFy+KNN1t7ozD+hiqLjfDen
-xk+PNdb01m4Ge90h2c9W/8swIkn+iQTzheWq8ecf6HWQTd35RvdCNPdFWAwRDYSw
-xtpdPvkBnufh2lWVvnQce/xNFE+sflVHfXv0pQ1JHpXo9xLBzP92piVH0PN1Nb6X
-t1gW66pceG/sUzCv6gRNzKkC4/C2BBL2MLERPZBOVmTX3DxDX3M570uvh+v2/miI
-RHLq0gfGabDBoYvvF0nXYbFFSF87ICHpW7LM9NfpMfULFWE7epTj69m8f5SuauNi
-YpaoZHy4h/OZMn6SolK+u/hlz8nyMPyLwcKmltdfieFcNID1j0cHL7SRv7Gifl9L
-WtBbnySGBVFaaQNlQ0lxxeBvlDRr9hvYqbBMflPrj0jfyjO1SPo2ShpTpjMM0InN
-SRXNiTE8kMBy12VLUjWKRhFEuT2OKGWmPnmeXAhEKa2wNREuIU640ucQPl2Eg7PD
-wuTSxv0JS3QJ3fGz0xk+gA2iCxnwOOfFwq/iI9th4p1cbiCJSS4jarJiwUW0n6+L
-p/EiO/h94pDQehn7Skzj0n1fSoMD7SfWI55rjbRZotnvbIIp3XUZPD9MEI3vu3Un
-0q6Dp6jOW6c=
+LnBkZjANBgkqhkiG9w0BAQUFAAOCAgEAnQfh7pB2MWcWRXCMy4SLS1doRKWJwfJ+
+yyiL9edwd9W29AshYKWhdHMkIoDW2LqNomJdCTVCKfs5Y0ULpLA4Gmj0lRPM4EOU
+7Os5GuxXKdmZbfWEzY5zrsncavqenRZkkwjHHMKJVJ53gJD2uSl26xNnSFn4Ljox
+uMnTiOVfTtIZPUOO15L/zzi24VuKUx3OrLR2L9j3QGPV7mnzRX2gYsFhw3XtsntN
+rCEnME5ZRmqTF8rIOS0Bc2Vb6UGbERecyMhK76F2YC2uk/8M1TMTn08Tzt2G8fz4
+NVQVqFvnhX76Nwn/i7gxSZ4Nbt600hItuO3Iw/G2QqBMl3nf/sOjn6H0bSyEd6Si
+BeEX/zHdmvO4esNSwhERt1Axin/M51qJzPeGmmGSTy+UtpjHeOBiS0N9PN7WmrQQ
+oUCcSyrcuNDUnv3xhHgbDlePaVRCaHvqoO91DweijHOZq1X1BwnSrzgDapADDC+P
+4uhDwjHpb62H5Y29TiyJS1HmnExUdsASgVOb7KD8LJzaGJVuHjgmQid4YAjff20y
+6NjAbx/rJnWfk/x7G/41kNxTowemP4NVCitOYoIlzmYwXSzg+RkbdbmdmFamgyd6
+0Y+NWZP8P3PXLrQsldiL98l+x/ydrHIEH9LMF/TtNGCbnkqXBP7dcg5XVFEGcE3v
+qhykguAzx/Q=
-----END CERTIFICATE-----
# Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority
# Issuer: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-sslglue-perl.git
More information about the Pkg-perl-cvs-commits
mailing list