[libnet-sslglue-perl] 26/39: Imported Upstream version 1.04
dom at earth.li
dom at earth.li
Thu Aug 27 18:38:43 UTC 2015
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 <dom at 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, at _ );
+ 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, 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(@_);
+ };
+}
+
+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
More information about the Pkg-perl-cvs-commits
mailing list