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 <d...@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( 'm...@example.org' ); +$smtp->to( 'y...@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( 'm...@example.org' ); +$smtp->to( 'y...@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 _______________________________________________ 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