Net::SSLGlue::SMTP - make Net::SMTP able to use SSL

Net-SSLGlue documentation Contained in the Net-SSLGlue distribution.

Index

Code Index:

NAME

Top

Net::SSLGlue::SMTP - make Net::SMTP able to use SSL

SYNOPSIS

Top

  	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 => ... );

DESCRIPTION

Top

Net::SSLGlue::SMTP extends 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 IO::Socket::SSL.

METHODS

Top

new

The method new of Net::SMTP is now able to start directly with SSL when the argument <SSL = 1>> is given. In this case it will not create an IO::Socket::INET object but an IO::Socket::SSL object. One can give the usual SSL_* parameter of IO::Socket::SSL to Net::SMTP::new.

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 SSL_* parameter of IO::Socket::SSL will be given.

peer_certificate ...

Once the SSL connection is established the object is derived from IO::Socket::SSL so that you can use this method to get information about the certificate. See the IO::Socket::SSL documentation.

All of these methods can take the SSL_* parameter from IO::Socket::SSL to change the behavior of the SSL connection. The following parameters are especially useful:

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 etc/ssl/certs on UNIX systems.

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.

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.

SEE ALSO

Top

IO::Socket::SSL, Net::SMTP

COPYRIGHT

Top

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.

Net-SSLGlue documentation Contained in the Net-SSLGlue distribution. 
use strict;
use warnings;

package Net::SSLGlue::SMTP;
use IO::Socket::SSL 1.19;
use Net::SMTP;
our $VERSION = 0.7;

##############################################################################
# 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}{net_smtp_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,
		@_ 
	);
}
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;