[libnet-sslglue-perl] 01/39: [svn-inject] Installing original source of libnet-sslglue-perl
dom at earth.li
dom at earth.li
Thu Aug 27 18:38:41 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 8ce000477796109ddd6df8d7a7f5904fdbd482ed
Author: Dominic Hargreaves <dom at 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, at _ );
+ 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, at _ );
+ 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
More information about the Pkg-perl-cvs-commits
mailing list