This is an automated email from the git hooks/post-receive script. dom pushed a commit to branch master in repository libnet-sslglue-perl.
commit 9c6d0db9d52a5e3ddd81f8ada7846124c3428be8 Author: Dominic Hargreaves <d...@earth.li> Date: Sun Oct 27 14:10:28 2013 +0000 Imported Upstream version 1.04 --- Changes | 13 ++++ MANIFEST | 2 + META.yml | 4 +- lib/Net/SSLGlue.pm | 6 +- lib/Net/SSLGlue/POP3.pm | 202 ++++++++++++++++++++++++++++++++++++++++++++++++ t/external/04_pop3.t | 87 +++++++++++++++++++++ 6 files changed, 310 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index f53914c..7741a5c 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,16 @@ +1.04 2013/08/01 +replace Net::Cmd::getline via Net::SSLGlue::POP3 because it assumed, that it +just needs to wait for read events on the sockets - which is not the case for +SSL (e.g. SSL_WANT_READ, SSL_WANT_WRITE). +Fixes https://rt.cpan.org/Ticket/Display.html?id=87507. +Thanks to MICHIELB for reporting + +1.03 2013/05/15 +fixed documentation for Net::SSLGlue::POP3 + +1.02 2013/05/14 +added Net::SSLGlue::POP3 + 1.01 2012/01/31 Net::SSLGlue::LDAP as wrongly named Net::DNSGlue::LDAP diff --git a/MANIFEST b/MANIFEST index 42c4f29..dde4968 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,11 +2,13 @@ lib/Net/SSLGlue.pm lib/Net/SSLGlue/LDAP.pm lib/Net/SSLGlue/LWP.pm lib/Net/SSLGlue/SMTP.pm +lib/Net/SSLGlue/POP3.pm Makefile.PL MANIFEST This list of files t/01_load.t t/external/02_smtp.t t/external/03_lwp.t +t/external/04_pop3.t TODO COPYRIGHT examples/lwp.pl diff --git a/META.yml b/META.yml index 5296399..38dff5f 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: Net-SSLGlue -version: 1.01 +version: 1.04 abstract: ~ author: [] license: unknown @@ -15,7 +15,7 @@ no_index: directory: - t - inc -generated_by: ExtUtils::MakeMaker version 6.56 +generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 diff --git a/lib/Net/SSLGlue.pm b/lib/Net/SSLGlue.pm index ca34c7d..a1c38b9 100644 --- a/lib/Net/SSLGlue.pm +++ b/lib/Net/SSLGlue.pm @@ -1,5 +1,5 @@ package Net::SSLGlue; -our $VERSION = '1.01'; +our $VERSION = '1.04'; =head1 NAME @@ -19,6 +19,8 @@ available: =item Net::SMTP - add SSL from beginning or using STARTTLS +=item Net::POP3 - add SSL from beginning or using STLS + =item Net::LDAP - add proper certificate checking =item LWP - add proper certificate checking @@ -28,7 +30,7 @@ available: =head1 COPYRIGHT This module and the modules in the Net::SSLGlue Hierarchy distributed together -with this module are copyright (c) 2008-2011, Steffen Ullrich. +with this module are copyright (c) 2008-2013, Steffen Ullrich. All Rights Reserved. These modules are free software. They 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 new file mode 100644 index 0000000..498e3fd --- /dev/null +++ b/lib/Net/SSLGlue/POP3.pm @@ -0,0 +1,202 @@ +use strict; +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 { + 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, + @_ + ) or return; +} +sub Net::POP3::_STLS { + shift->command("STLS")->response() == Net::POP3::CMD_OK +} + +no warnings 'redefine'; +my $old_new = \&Net::POP3::new; +*Net::POP3::new = sub { + my $class = shift; + my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ ); + if ( delete $arg{SSL} ) { + $arg{Port} ||= 995; + return Net::POP3::_SSLified->new(%arg); + } else { + return $old_new->($class,%arg); + } +}; + +############################################################################## +# Socket class derived from IO::Socket::SSL +# strict certificate verification per default +############################################################################## +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) + } +} + + +############################################################################## +# Net::POP3 derived from Net::POP3::_SSL_Socket instead of IO::Socket::INET +# 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::$_" }; + } + + # 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,@_ ); + 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(@_); + }; +} + +1; + +=head1 NAME + +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 => ... + ); + + my $pop3 = Net::POP3->new( $host ); + $pop3->starttls( SSL_ca_path => ... ); + +=head1 DESCRIPTION + +L<Net::SSLGlue::POP3> extends L<Net::POP3> so one can either start directly with SSL +or switch later to SSL using the STLS command. + +By default it will take care to verify the certificate according to the rules +for POP3 implemented in L<IO::Socket::SSL>. + +=head1 METHODS + +=over 4 + +=item new + +The method C<new> of L<Net::POP3> is now able to start directly with SSL when +the argument C<<SSL => 1>> is given. In this case it will not create an +L<IO::Socket::INET> object but an L<IO::Socket::SSL> object. One can give the +usual C<SSL_*> parameter of L<IO::Socket::SSL> to C<Net::POP3::new>. + +=item starttls + +If the connection is not yet SSLified it will issue the STLS 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. + +=item peer_certificate ... + +Once the SSL connection is established the object is derived from +L<IO::Socket::SSL> so that you can use this method to get information about the +certificate. See the L<IO::Socket::SSL> documentation. + +=back + +All of these methods can take the C<SSL_*> parameter from L<IO::Socket::SSL> to +change the behavior of the SSL connection. The following parameters are +especially useful: + +=over 4 + +=item SSL_ca_path, SSL_ca_file + +Specifies the path or a file where the CAs used for checking the certificates +are located. This is typically L</etc/ssl/certs> on UNIX systems. + +=item SSL_verify_mode + +If set to 0, verification of the certificate will be disabled. By default +it is set to 1 which means that the peer certificate is checked. + +=item SSL_verifycn_name + +Usually the name given as the hostname in the constructor is used to verify the +identity of the certificate. If you want to check the certificate against +another name you can specify it with this parameter. + +=back + +=head1 SEE ALSO + +IO::Socket::SSL, Net::POP3 + +=head1 COPYRIGHT + +This module is copyright (c) 2013, 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/t/external/04_pop3.t b/t/external/04_pop3.t new file mode 100644 index 0000000..4fc3b7e --- /dev/null +++ b/t/external/04_pop3.t @@ -0,0 +1,87 @@ + +use strict; +use warnings; + +BEGIN { + eval "use Net::POP3"; + if ( $@ ) { + print "1..0 # no Net::POP3\n"; + exit + } +} + +use Net::SSLGlue::POP3; + +my $capath = '/etc/ssl/certs/'; # unix? +-d $capath or do { + print "1..0 # cannot find system CA-path\n"; + exit +}; + +# first try to connect w/o smtp +# plain +diag( "connect inet to pop.gmx.net:110" ); +IO::Socket::INET->new( 'pop.gmx.net:110' ) or do { + print "1..0 # pop.gmx.net:110 not reachable\n"; + exit +}; + +# ssl to the right host +diag( "connect ssl to pop.gmx.net:995" ); +IO::Socket::SSL->new( + PeerAddr => 'pop.gmx.net:995', + SSL_ca_path => $capath, + SSL_verify_mode => 1, + SSL_verifycn_scheme => 'smtp' +) or do { + print "1..0 # pop.gmx.net:995 not reachable with SSL\n"; + exit +}; + +# ssl to the wrong host +# the certificate pop.gmx.de returns is for pop.gmx.net +diag( "connect ssl to pop.gmx.de:995" ); +IO::Socket::SSL->new( + PeerAddr => 'pop.gmx.de:995', + SSL_ca_path => $capath, + SSL_verify_mode => 1, + SSL_verifycn_scheme => 'smtp' +) and do { + print "1..0 # pop.gmx.de:995 reachable with SSL\n"; + exit +}; + +print "1..6\n"; + +# first direct SSL +my $smtp = Net::POP3->new( 'pop.gmx.net', + SSL => 1, + SSL_ca_path => $capath, +); +print $smtp ? "ok\n" : "not ok # smtp connect pop.gmx.net\n"; + +# then starttls +$smtp = Net::POP3->new( 'pop.gmx.net' ); +my $ok = $smtp->starttls( SSL_ca_path => $capath ); +print $ok ? "ok\n" : "not ok # smtp starttls pop.gmx.net\n"; +# check that we can talk on connection +print $smtp->quit ? "ok\n": "not ok # quit failed\n"; + +# against wrong host should fail +$smtp = Net::POP3->new( 'pop.gmx.de' ); # should succeed +$ok = $smtp->starttls( SSL_ca_path => $capath ); +print $ok ? "not ok # smtp starttls pop.gmx.de did not fail\n": "ok\n"; + +# but not if we specify the right SSL_verifycn_name +$smtp = Net::POP3->new( 'pop.gmx.de' ); # should succeed +$ok = $smtp->starttls( SSL_ca_path => $capath, SSL_verifycn_name => 'pop.gmx.net' ); +print $ok ? "ok\n" : "not ok # smtp starttls pop.gmx.de/net\n"; + +# or disable verification +$smtp = Net::POP3->new( 'pop.gmx.de' ); # should succeed +$ok = $smtp->starttls( SSL_verify_mode => 0 ); +print $ok ? "ok\n" : "not ok # smtp starttls pop.gmx.de\n"; + +sub diag { + #print STDERR "@_\n" +} -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-sslglue-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits