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 8ce000477796109ddd6df8d7a7f5904fdbd482ed
Author: Dominic Hargreaves <d...@earth.li>
Date:   Wed May 20 16:41:20 2009 +0000

    [svn-inject] Installing original source of libnet-sslglue-perl
---
 COPYRIGHT               |   4 ++
 MANIFEST                |  12 ++++
 META.yml                |  13 ++++
 Makefile.PL             |  14 ++++
 TODO                    |   1 +
 lib/Net/SSLGlue.pm      |  33 +++++++++
 lib/Net/SSLGlue/LDAP.pm |  79 ++++++++++++++++++++
 lib/Net/SSLGlue/LWP.pm  | 181 ++++++++++++++++++++++++++++++++++++++++++++++
 lib/Net/SSLGlue/SMTP.pm | 188 ++++++++++++++++++++++++++++++++++++++++++++++++
 t/01_load.t             |  18 +++++
 t/external/02_smtp.t    |  85 ++++++++++++++++++++++
 t/external/03_lwp.t     |  75 +++++++++++++++++++
 12 files changed, 703 insertions(+)

diff --git a/COPYRIGHT b/COPYRIGHT
new file mode 100644
index 0000000..fe8f8bd
--- /dev/null
+++ b/COPYRIGHT
@@ -0,0 +1,4 @@
+These modules are copyright (c) 2008, 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/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..fa49103
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,12 @@
+lib/Net/SSLGlue.pm
+lib/Net/SSLGlue/LDAP.pm
+lib/Net/SSLGlue/LWP.pm
+lib/Net/SSLGlue/SMTP.pm
+Makefile.PL
+MANIFEST                       This list of files
+t/01_load.t
+t/external/02_smtp.t
+t/external/03_lwp.t
+TODO
+COPYRIGHT
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..698e597
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,13 @@
+--- #YAML:1.0
+name:                Net-SSLGlue
+version:             0.2
+abstract:            ~
+license:             ~
+author:              ~
+generated_by:        ExtUtils::MakeMaker version 6.44
+distribution_type:   module
+requires:     
+    IO::Socket::SSL:               1.19
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..f260435
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,14 @@
+use ExtUtils::MakeMaker;
+require 5.008;
+my $xt = prompt( "Should I do external tests?\n".
+       "These tests will fail if there is no internet connection or if a 
firewall\n".
+       "blocks some traffic.\n".
+       "[y/N]", 'n' );
+WriteMakefile(
+       NAME => 'Net::SSLGlue',
+       VERSION_FROM => 'lib/Net/SSLGlue.pm',
+       PREREQ_PM => {
+               'IO::Socket::SSL' => 1.19,
+       },
+       $xt =~m{^y}i ? ( test => { TESTS => 't/*.t t/external/*.t' }):(),
+);
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..011330a
--- /dev/null
+++ b/TODO
@@ -0,0 +1 @@
+ldap tests
diff --git a/lib/Net/SSLGlue.pm b/lib/Net/SSLGlue.pm
new file mode 100644
index 0000000..8fdb84c
--- /dev/null
+++ b/lib/Net/SSLGlue.pm
@@ -0,0 +1,33 @@
+package Net::SSLGlue;
+$VERSION = 0.2;
+
+=head1 NAME
+
+Net::SSLGlue - add/extend SSL support for common perl modules
+
+=head1 DESCRIPTION
+
+Some commonly used perl modules don't have SSL support at all, even if the
+protocol would support it. Others have SSL support, but most of them don't do
+proper checking of the servers certificate.
+
+The C<Net::SSLGlue::*> modules try to add SSL support or proper certificate to
+these modules. Currently is support for the following modules available:
+
+=over 4
+
+=item Net::SMTP - add SSL from beginning or using STARTTLS
+
+=item Net::LDAP - add proper certificate checking
+
+=item LWP - add proper certificate checking
+
+=back
+
+=head1 COPYRIGHT
+
+This module and the modules in the Net::SSLGlue Hierarchy distributed together
+with this module are copyright (c) 2008, 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/LDAP.pm b/lib/Net/SSLGlue/LDAP.pm
new file mode 100644
index 0000000..d2bad6c
--- /dev/null
+++ b/lib/Net/SSLGlue/LDAP.pm
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+package Net::DNSGlue::LDAP;
+our $VERSION = 0.2;
+use Net::LDAP;
+use IO::Socket::SSL 1.19;
+
+# can be reset with local
+our %SSLopts;
+
+# add SSL_verifycn_scheme to the SSL CTX args returned by
+# 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";
+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;
+};
+
+1;
+
+=head1 NAME
+
+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;
+
+
+=head1 DESCRIPTION
+
+L<Net::SSLGlue::LDAP> modifies L<Net::LDAP> so that it does proper certificate
+checking using the C<ldap> SSL_verify_scheme from L<IO::Socket::SSL>.
+
+Because L<Net::LDAP> does not have a mechanism to forward arbitrary parameter 
for
+the construction of the underlying socket these parameters can be set globally
+when including the package or with local settings of the
+C<%Net::SSLGlue::LDAP::SSLopts> variable.
+
+All of the C<SSL_*> parameter from L<IO::Socket::SSL> can be used, especially
+the following parameter is useful:
+
+=over 4
+
+=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 might specify it with this parameter.
+
+=back
+
+C<SSL_ca_path>, C<SSL_ca_file> for L<IO::Socket::SSL> can be set with the
+C<capath> and C<cafile> parameters of L<Net::LDAP::new> and C<SSL_verify_mode>
+can be set with C<verify>, but the meaning of the values differs (C<none> is 0,
+e.g. disable certificate verification).
+
+=head1 SEE ALSO
+
+IO::Socket::SSL, LWP, Net::LDAP
+
+=head1 COPYRIGHT
+
+This module is copyright (c) 2008, 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/LWP.pm b/lib/Net/SSLGlue/LWP.pm
new file mode 100644
index 0000000..8fb3222
--- /dev/null
+++ b/lib/Net/SSLGlue/LWP.pm
@@ -0,0 +1,181 @@
+use strict;
+use warnings;
+package Net::SSLGlue::LWP;
+our $VERSION = 0.2;
+use LWP::UserAgent '5.822';
+use IO::Socket::SSL 1.19;
+use URI::Escape 'uri_unescape';
+use MIME::Base64 'encode_base64';
+use URI;
+
+# force IO::Socket::SSL as superclass of Net::HTTPS, because
+# only it can verify certificates
+BEGIN {
+       my $oc = $Net::HTTPS::SOCKET_CLASS;
+       $Net::HTTPS::SOCKET_CLASS = my $need = 'IO::Socket::SSL';
+       require Net::HTTPS;
+       require LWP::Protocol::https;
+       if ( ( my $oc = $Net::HTTPS::SOCKET_CLASS ) ne $need ) {
+               # was probably loaded before, change ISA
+               grep { s{^\Q$oc\E$}{$need} } @Net::HTTPS::ISA
+       }
+       die "cannot force IO::Socket:SSL into Net::HTTPS"
+               if $Net::HTTPS::SOCKET_CLASS ne $need;
+}
+
+our %SSLopts;  # set by local and import
+sub import {
+       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,
+               );
+       };
+}
+
+{
+       # 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};
+       }
+}
+
+{
+
+       my $old_new = UNIVERSAL::can( 'LWP::Protocol::https::Socket','new' );
+       my $sockclass = 'IO::Socket::INET';
+       $sockclass .= '6' if eval "require IO::Socket::INET6" && ! $@;
+       no warnings 'redefine';
+       *LWP::Protocol::https::Socket::new = sub {
+               my $class = shift;
+               my %args = @_>1 ? @_ : ( PeerAddr => shift );
+               my $phost = delete $args{HTTPS_proxy}
+                       || return $old_new->($class,%args);
+               $phost = URI->new($phost) if ! ref $phost;
+
+               my $port = delete $args{PeerPort};
+               my $host = delete $args{PeerHost} || delete $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;
+               my $self = $sockclass->new( PeerAddr => $phost, PeerPort => 
$pport )
+                       or 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;
+               } else {
+                       $class->start_SSL( $self,
+                               SSL_verifycn_name => $host,
+                               %args
+                       );
+               }
+       };
+}
+
+1;
+
+=head1 NAME
+
+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;
+               $Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0; # no 
verification
+       }
+
+
+=head1 DESCRIPTION
+
+L<Net::SSLGlue::LWP> modifies L<Net::HTTPS> and L<LWP::Protocol::https> so that
+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>.
+
+Because L<LWP> does not have a mechanism to forward arbitrary parameter for
+the construction of the underlying socket these parameters can be set globally
+when including the package or with local settings of the
+C<%Net::SSLGlue::LWP::SSLopts> variable.
+
+All of the C<SSL_*> parameter from L<IO::Socket::SSL> can be used, especially
+the following parameters are 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. Typical for UNIX systems is L</etc/ssl/certs>.
+
+=item SSL_verify_mode
+
+If set to 0 disabled verification of the certificate. By default it is 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 might specify it with this parameter.
+
+=back
+
+=head1 SEE ALSO
+
+IO::Socket::SSL, LWP, Net::HTTPS, LWP::Protocol::https
+
+=head1 COPYRIGHT
+
+This module is copyright (c) 2008, 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/SMTP.pm b/lib/Net/SSLGlue/SMTP.pm
new file mode 100644
index 0000000..bbe588d
--- /dev/null
+++ b/lib/Net/SSLGlue/SMTP.pm
@@ -0,0 +1,188 @@
+use strict;
+use warnings;
+
+package Net::SSLGlue::SMTP;
+use IO::Socket::SSL 1.19;
+use Net::SMTP;
+
+##############################################################################
+# mix starttls method into Net::SMTP which on SSL handshake success 
+# upgrades the class to Net::SMTP::_SSLified
+##############################################################################
+sub Net::SMTP::starttls {
+       my $self = shift;
+       $self->_STARTTLS or return;
+       Net::SMTP::_SSLified->start_SSL( $self,
+               SSL_verify_mode => 1,
+               SSL_verifycn_scheme => 'smtp',
+               SSL_verifycn_name => ${*$self}{net_smtp_host},
+               @_ 
+       );
+}
+sub Net::SMTP::_STARTTLS { 
+       shift->command("STARTTLS")->response() == Net::SMTP::CMD_OK
+}
+
+no warnings 'redefine';
+my $old_new = \&Net::SMTP::new;
+*Net::SMTP::new = sub {
+       my $class = shift;
+       my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ );
+       if ( delete $arg{SSL} ) {
+               $arg{Port} ||= 465;
+               return Net::SMTP::_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::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}{net_smtp_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::SMTP derived from Net::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};
+       }
+
+       # 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,@_ );
+               local %SSLopts;
+               $SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg 
);
+               return $old_new->($class,%arg);
+       };
+}
+
+1;
+
+=head1 NAME
+
+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 => ...
+       );
+
+       my $smtp_plain = Net::SMTP->new( $host );
+       $smtp_plain->startssl( SSL_ca_path => ... );
+
+=head1 DESCRIPTION
+
+L<Net::SSLGlue::SMTP> expands L<Net::SMTP> so one can either start directly 
with SSL
+or switch later to SSL using the STARTTLS command.
+
+By default it will take care to verfify the certificate according to the rules
+for SMTP implemented in L<IO::Socket::SSL>.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+The method C<new> of L<Net::SMTP> 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::SMTP::new>.
+
+=item startssl
+
+If the connection is not yet SSLified it will issue the STARTTLS 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. Especially the following parameter
+are 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. Typical for UNIX systems is L</etc/ssl/certs>.
+
+=item SSL_verify_mode
+
+If set to 0 disabled verification of the certificate. By default it is 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 might specify it with this parameter.
+
+=back
+
+=head1 SEE ALSO
+
+IO::Socket::SSL, Net::SMTP
+
+=head1 COPYRIGHT
+
+This module is copyright (c) 2008, 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/01_load.t b/t/01_load.t
new file mode 100644
index 0000000..79ac543
--- /dev/null
+++ b/t/01_load.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+print "1..3\n";
+for (
+       [ 'Net::SMTP','SMTP' ],
+       [ 'LWP',      'LWP'  ],
+       [ 'Net::LDAP','LDAP' ],
+) {
+       my ($pkg,$glue) = @$_;
+       eval "use $pkg";
+       if ( ! $@ ) {
+               eval "use Net::SSLGlue::$glue";
+               print $@ ? "not ok # load $glue glue failed\n": "ok # load 
$glue glue\n"
+       } else {
+               print "ok # skip $glue glue\n"
+       }
+}
diff --git a/t/external/02_smtp.t b/t/external/02_smtp.t
new file mode 100644
index 0000000..8f3efb2
--- /dev/null
+++ b/t/external/02_smtp.t
@@ -0,0 +1,85 @@
+
+use strict;
+use warnings;
+
+BEGIN {
+       eval "use Net::SMTP";
+       if ( $@ ) {
+               print "1..0 # no Net::SMTP\n";
+               exit
+       }
+}
+
+use Net::SSLGlue::SMTP;
+
+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 mail.gmx.net:25" );
+IO::Socket::INET->new( 'mail.gmx.net:25' ) or do {
+       print "1..0 # mail.gmx.net:25 not reachable\n";
+       exit
+};
+
+# ssl to the right host
+diag( "connect ssl to mail.gmx.net:465" );
+IO::Socket::SSL->new( 
+       PeerAddr => 'mail.gmx.net:465',
+       SSL_ca_path => $capath,
+       SSL_verify_mode => 1,
+       SSL_verifycn_scheme => 'smtp' 
+       ) or do {
+       print "1..0 # mail.gmx.net:465 not reachable with SSL\n";
+       exit
+};
+
+# ssl to the wrong host 
+# the certificate mail.gmx.de returns is for mail.gmx.net
+diag( "connect ssl to mail.gmx.de:465" );
+IO::Socket::SSL->new( 
+       PeerAddr => 'mail.gmx.de:465',
+       SSL_ca_path => $capath,
+       SSL_verify_mode => 1,
+       SSL_verifycn_scheme => 'smtp' 
+       ) and do {
+       print "1..0 # mail.gmx.de:465 reachable with SSL\n";
+       exit
+};
+
+print "1..5\n";
+
+# first direct SSL
+my $smtp = Net::SMTP->new( 'mail.gmx.net', 
+       SSL => 1, 
+       SSL_ca_path => $capath,
+);
+print $smtp ? "ok\n" : "not ok # smtp connect mail.gmx.net\n";
+
+# then starttls
+$smtp = Net::SMTP->new( 'mail.gmx.net' );
+my $ok = $smtp->starttls( SSL_ca_path => $capath );
+print $ok ? "ok\n" : "not ok # smtp starttls mail.gmx.net\n";
+
+# against wrong host should fail
+$smtp = Net::SMTP->new( 'mail.gmx.de' ); # should succeed
+$ok = $smtp->starttls( SSL_ca_path => $capath ); 
+print $ok ? "not ok # smtp starttls mail.gmx.de did not fail\n": "ok\n";
+
+# but not if we specify the right SSL_verifycn_name
+$smtp = Net::SMTP->new( 'mail.gmx.de' ); # should succeed
+$ok = $smtp->starttls( SSL_ca_path => $capath, SSL_verifycn_name => 
'mail.gmx.net' ); 
+print $ok ? "ok\n" : "not ok # smtp starttls mail.gmx.de/net\n";
+
+# or disable verification
+$smtp = Net::SMTP->new( 'mail.gmx.de' ); # should succeed
+$ok = $smtp->starttls( SSL_verify_mode => 0 );
+print $ok ? "ok\n" : "not ok # smtp starttls mail.gmx.de\n";
+
+sub diag { 
+       #print STDERR "@_\n" 
+}
diff --git a/t/external/03_lwp.t b/t/external/03_lwp.t
new file mode 100644
index 0000000..cd167a2
--- /dev/null
+++ b/t/external/03_lwp.t
@@ -0,0 +1,75 @@
+
+use strict;
+use warnings;
+
+BEGIN {
+       eval "use LWP";
+       if ( $@ ) {
+               print "1..0 # no LWP\n";
+               exit
+       }
+}
+
+use Net::SSLGlue::LWP;
+use LWP::Simple;
+
+my $capath = '/etc/ssl/certs/'; # unix?
+-d $capath or do {
+       print "1..0 # cannot find system CA-path\n";
+       exit
+};
+Net::SSLGlue::LWP->import( SSL_ca_path => $capath );
+
+#
+# first check everything directly with IO::Socket::SSL
+#
+
+# signin.ebay.de has a certificate, which is for signin.ebay.com
+# but where signin.ebay.de is a subjectAltName
+IO::Socket::SSL->new(
+       PeerAddr => 'signin.ebay.de:443',
+       SSL_ca_path => $capath,
+       SSL_verify_mode => 1,
+       SSL_verifycn_scheme => 'http'
+) or do {
+       print "1..0 # ssl connect signin.ebay.de failed\n";
+       exit
+};
+
+# www.fedora.org has a certificate which has nothing in common 
+# with the hostname
+my $sock = IO::Socket::INET->new( 'www.fedora.org:443' ) or do {
+       print "1..0 # connect to www.fedora.org failed\n";
+       exit
+};
+IO::Socket::SSL->start_SSL( $sock,
+       SSL_ca_path => $capath,
+       SSL_verify_mode => 1,
+       SSL_verifycn_scheme => 'http'
+) and do {
+       print "1..0 # certificate for www.fedora.org unexpectly correct\n";
+       exit
+};
+
+#
+# and than check, that LWP uses the same checks
+#
+
+print "1..3\n";
+
+# signin.ebay.de -> should succeed
+my $content = get( 'https://signin.ebay.de' );
+print $content ? "ok\n": "not ok # lwp connect signin.ebay.de: $@\n";
+
+# www.fedora.org -> should fail
+$content = get( 'https://www.fedora.org' );
+print $content ? "not ok # lwp ssl connect www.fedora.org should fail\n": 
"ok\n";
+
+# www.fedora.org -> 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://www.fedora.org' );
+       print $content ? "ok\n": "not ok # lwp ssl www.fedora.org w/o ssl 
verify\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

Reply via email to