/Net-SSLGlue-1.01/lib/Net/SSLGlue/SMTP.pm
Perl | 203 lines | 133 code | 48 blank | 22 comment | 16 complexity | ab634f5aa6d308ef23fd0959b650903d MD5 | raw file
- use strict;
- use warnings;
- package Net::SSLGlue::SMTP;
- use IO::Socket::SSL 1.19;
- use Net::SMTP;
- our $VERSION = 1.0;
- ##############################################################################
- # 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;
- my $host = $self->host;
- # for name verification strip port from domain:port, ipv4:port, [ipv6]:port
- $host =~s{(?<!:):\d+$}{};
- Net::SMTP::_SSLified->start_SSL( $self,
- SSL_verify_mode => 1,
- SSL_verifycn_scheme => 'smtp',
- SSL_verifycn_name => $host,
- @_
- ) or return;
- # another hello after starttls to read new ESMTP capabilities
- return $self->hello(${*$self}{net_smtp_hello_domain});
- }
- 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);
- }
- };
- my $old_hello = \&Net::SMTP::hello;
- *Net::SMTP::hello = sub {
- my ($self,$domain) = @_;
- ${*$self}{net_smtp_hello_domain} = $domain if $domain;
- goto &$old_hello;
- };
- ##############################################################################
- # 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->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->starttls( SSL_ca_path => ... );
- =head1 DESCRIPTION
- L<Net::SSLGlue::SMTP> extends 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 verify 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 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
- 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::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.