[libnet-sslglue-perl] 10/39: [svn-upgrade] new version libnet-sslglue-perl (0.5)
dom at earth.li
dom at earth.li
Thu Aug 27 18:38:42 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 b08fcaa40ed95fd765e252ca48ecbf590db5b490
Author: Dominic Hargreaves <dom at earth.li>
Date: Sat Feb 5 16:27:43 2011 +0000
[svn-upgrade] new version libnet-sslglue-perl (0.5)
---
Changes | 25 ++++++++++++++
MANIFEST | 6 ++++
META.yml | 30 ++++++++++------
README | 2 ++
examples/lwp.pl | 8 +++++
examples/lwp_post.pl | 16 +++++++++
examples/send-ssl-mail.pl | 24 +++++++++++++
examples/send-starttls-mail.pl | 20 +++++++++++
lib/Net/SSLGlue.pm | 4 +--
lib/Net/SSLGlue/LWP.pm | 78 +++++++++++++++++++++++++++---------------
lib/Net/SSLGlue/SMTP.pm | 5 +--
11 files changed, 176 insertions(+), 42 deletions(-)
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..be1102c
--- /dev/null
+++ b/Changes
@@ -0,0 +1,25 @@
+0.5 2011/02/03
+documentation fixes: http://rt.cpan.org/Ticket/Display.html?id=65258
+
+0.4 2010/06/13
+added Changes, put examples into examples/ dir
+
+0.3 2010/05/13
+rewrite parts of Net::SSLGlue::LWP so that it sends the correct request
+to the peer even if https_proxy is used. In former version it ommitted
+the HTTP version number in the request (thus the request was invalid).
+Bug report by PMOONEY https://rt.cpan.org/Ticket/Display.html?id=57365
+
+0.2_1 2010/05/11
+document way to set different verification scheme for LWP
+requested by PMOONEY https://rt.cpan.org/Ticket/Display.html?57367
+
+0.2 2009/01/02
+https_proxy support for LWP, HTTPS_PROXY from Crypt::SSLeay did not work and
+the https_proxy from LWP was broken with both Crypt::SSLeay and
+IO::Socket::SSL (it did unencrypted https:// requests to the proxy).
+Fix it so that it now does CONNECT (this is the meaning of https_proxy for
+all other programs)
+
+0.1 2008/12/31
+initial release
diff --git a/MANIFEST b/MANIFEST
index fa49103..42c4f29 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -9,4 +9,10 @@ t/external/02_smtp.t
t/external/03_lwp.t
TODO
COPYRIGHT
+examples/lwp.pl
+examples/lwp_post.pl
+examples/send-ssl-mail.pl
+examples/send-starttls-mail.pl
+Changes
+README
META.yml Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
index 698e597..d898d83 100644
--- a/META.yml
+++ b/META.yml
@@ -1,13 +1,21 @@
--- #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
+name: Net-SSLGlue
+version: 0.5
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ IO::Socket::SSL: 1.19
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.54
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
diff --git a/README b/README
new file mode 100644
index 0000000..805b5b1
--- /dev/null
+++ b/README
@@ -0,0 +1,2 @@
+This Module helps LWP, Net::SMTP and Net::LDAP to be either
+SSL aware at all or to offer way for proper certificate checking.
diff --git a/examples/lwp.pl b/examples/lwp.pl
new file mode 100644
index 0000000..bce69a5
--- /dev/null
+++ b/examples/lwp.pl
@@ -0,0 +1,8 @@
+use strict;
+use LWP::UserAgent;
+use Net::SSLGlue::LWP SSL_ca_path => '/etc/ssl/certs';
+
+my $ua = LWP::UserAgent->new;
+$ua->env_proxy;
+my $resp = $ua->get( 'https://www.comdirect.de' ) || die $@;
+print $resp->content;
diff --git a/examples/lwp_post.pl b/examples/lwp_post.pl
new file mode 100644
index 0000000..4dd19d3
--- /dev/null
+++ b/examples/lwp_post.pl
@@ -0,0 +1,16 @@
+use strict;
+use LWP::UserAgent;
+use Net::SSLGlue::LWP SSL_ca_path => '/etc/ssl/certs', SSL_verify_mode => 0;
+
+my $ua = LWP::UserAgent->new;
+$ua->env_proxy;
+my $resp = $ua->post( 'https://service.gmx.net/de/cgi/login', {
+ AREA => 1,
+ EXT => 'redirect',
+ EXT2 => '',
+ uinguserid => '__uuid__',
+ dlevel => 'c',
+ id => 'a',
+ p => 'b',
+}) || die $@;
+print $resp->as_string;
diff --git a/examples/send-ssl-mail.pl b/examples/send-ssl-mail.pl
new file mode 100644
index 0000000..12a0ac3
--- /dev/null
+++ b/examples/send-ssl-mail.pl
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Net::SSLGlue::SMTP;
+my $smtp = Net::SMTP->new( 'mail.gmx.net',
+ SSL => 1,
+ SSL_ca_path => "/etc/ssl/certs",
+ Debug => 1
+) or die $@;
+die $smtp->peerhost.':'.$smtp->peerport;
+$smtp->auth( '123456','password' );
+$smtp->mail( 'me at example.org' );
+$smtp->to( 'you at example.org' );
+$smtp->data;
+$smtp->datasend( <<EOD );
+From: me
+To: you
+Subject: test test
+
+lalaal
+EOD
+$smtp->dataend;
+$smtp->quit;
+
diff --git a/examples/send-starttls-mail.pl b/examples/send-starttls-mail.pl
new file mode 100644
index 0000000..4ba615a
--- /dev/null
+++ b/examples/send-starttls-mail.pl
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+
+use Net::SSLGlue::SMTP;
+my $smtp = Net::SMTP->new( 'mail.gmx.net', Debug => 1 ) or die $@;
+$smtp->starttls( SSL_ca_path => "/etc/ssl/certs" ) or die $@;
+$smtp->auth( '123456','password' );
+$smtp->mail( 'me at example.org' );
+$smtp->to( 'you at example.org' );
+$smtp->data;
+$smtp->datasend( <<EOD );
+From: me
+To: you
+Subject: test test
+
+lalaal
+EOD
+$smtp->dataend;
+$smtp->quit;
+
diff --git a/lib/Net/SSLGlue.pm b/lib/Net/SSLGlue.pm
index 8fdb84c..d518ad2 100644
--- a/lib/Net/SSLGlue.pm
+++ b/lib/Net/SSLGlue.pm
@@ -1,5 +1,5 @@
package Net::SSLGlue;
-$VERSION = 0.2;
+our $VERSION = 0.5;
=head1 NAME
@@ -27,7 +27,7 @@ these modules. Currently is support for the following modules available:
=head1 COPYRIGHT
This module and the modules in the Net::SSLGlue Hierarchy distributed together
-with this module are copyright (c) 2008, Steffen Ullrich.
+with this module are copyright (c) 2008-2011, 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/LWP.pm b/lib/Net/SSLGlue/LWP.pm
index 8fb3222..7443179 100644
--- a/lib/Net/SSLGlue/LWP.pm
+++ b/lib/Net/SSLGlue/LWP.pm
@@ -1,26 +1,26 @@
use strict;
use warnings;
package Net::SSLGlue::LWP;
-our $VERSION = 0.2;
+our $VERSION = 0.3;
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
+# force Net::SSLGlue::LWP::Socket 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';
+ 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::SOCKET_CLASS ) ne $need ) {
+ 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
}
- die "cannot force IO::Socket:SSL into Net::HTTPS"
- if $Net::HTTPS::SOCKET_CLASS ne $need;
+ die "cannot force $need into Net::HTTPS"
+ if $Net::HTTPS::SSL_SOCKET_CLASS ne $need;
}
our %SSLopts; # set by local and import
@@ -63,23 +63,24 @@ sub import {
{
- my $old_new = UNIVERSAL::can( 'LWP::Protocol::https::Socket','new' );
+ package Net::SSLGlue::LWP::Socket;
+ use IO::Socket::SSL;
+ use base 'IO::Socket::SSL';
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);
+ $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 = delete $args{PeerPort};
- my $host = delete $args{PeerHost} || delete $args{PeerAddr};
+ my $port = $args->{PeerPort};
+ my $host = $args->{PeerHost} || $args->{PeerAddr};
if ( ! $port ) {
$host =~s{:(\w+)$}{};
- $port = $args{PeerPort} = $1;
- $args{PeerHost} = $host;
+ $port = $args->{PeerPort} = $1;
+ $args->{PeerHost} = $host;
}
if ( $phost->scheme ne 'http' ) {
$@ = "scheme ".$phost->scheme." not supported for https_proxy";
@@ -94,8 +95,16 @@ sub import {
my $pport = $phost->port;
$phost = $phost->host;
- my $self = $sockclass->new( PeerAddr => $phost, PeerPort => $pport )
- or return;
+
+ # 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>) {
@@ -106,12 +115,17 @@ sub import {
# error
$@ = "non 2xx response to CONNECT: $hdr";
return;
- } else {
- $class->start_SSL( $self,
- SSL_verifycn_name => $host,
- %args
- );
}
+
+ # 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;
};
}
@@ -129,7 +143,17 @@ Net::SSLGlue::LWP - proper certificate checking for https in LWP
{
local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
- $Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0; # no verification
+
+ # 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',
+ };
}
diff --git a/lib/Net/SSLGlue/SMTP.pm b/lib/Net/SSLGlue/SMTP.pm
index bbe588d..53a03ca 100644
--- a/lib/Net/SSLGlue/SMTP.pm
+++ b/lib/Net/SSLGlue/SMTP.pm
@@ -4,6 +4,7 @@ use warnings;
package Net::SSLGlue::SMTP;
use IO::Socket::SSL 1.19;
use Net::SMTP;
+our $VERSION = 0.5;
##############################################################################
# mix starttls method into Net::SMTP which on SSL handshake success
@@ -116,7 +117,7 @@ Net::SSLGlue::SMTP - make Net::SMTP able to use SSL
);
my $smtp_plain = Net::SMTP->new( $host );
- $smtp_plain->startssl( SSL_ca_path => ... );
+ $smtp_plain->starttls( SSL_ca_path => ... );
=head1 DESCRIPTION
@@ -137,7 +138,7 @@ 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
+=item starttls
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
--
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