Here's a patch to add rudimentary support for SMTP TSL authentication.
It doesn't support more than 1 user/password, but it's a start. I'll
also be submitting a patch for CPAN::Reporter that uses this.
If you have feedback, please holler.
Thanks!
Jeff
| Subject: | Test-Reporter-1.27.tls_support.diff |
diff -aur Test-Reporter-1.27/Makefile.PL Test-Reporter-1.27a/Makefile.PL
--- Test-Reporter-1.27/Makefile.PL 2005-01-10 13:35:53.000000000 -0800
+++ Test-Reporter-1.27a/Makefile.PL 2006-11-02 13:26:45.000000000 -0800
@@ -17,6 +17,7 @@
},
'PREREQ_PM' => {
'Net::SMTP' => 0,
+ 'Net::SMTP::TLS' => 0,
'File::Temp' => 0,
'File::Spec' => 0,
},
Only in Test-Reporter-1.27a: Makefile.old
diff -aur Test-Reporter-1.27/TODO Test-Reporter-1.27a/TODO
--- Test-Reporter-1.27/TODO 2005-01-10 13:35:53.000000000 -0800
+++ Test-Reporter-1.27a/TODO 2006-11-02 13:26:24.000000000 -0800
@@ -1 +1,3 @@
* support Net::SMTP_auth (hashrefs in ->mx()?)
+ - rudimentary support added, does not yet support different user/password per mx
+ - need to add error checking whe n using Net::SMTP::TLS
diff -aur Test-Reporter-1.27/lib/Test/Reporter.pm Test-Reporter-1.27a/lib/Test/Reporter.pm
--- Test-Reporter-1.27/lib/Test/Reporter.pm 2005-01-17 15:51:24.000000000 -0800
+++ Test-Reporter-1.27a/lib/Test/Reporter.pm 2006-11-02 13:22:49.000000000 -0800
@@ -18,6 +18,7 @@
use Config;
use Carp;
use Net::SMTP;
+use Net::SMTP::TLS;
use File::Temp;
use Test::Reporter::Mail::Util;
use Test::Reporter::Date::Format;
@@ -53,13 +54,16 @@
'_dir' => '',
'_subject_lock' => 0,
'_report_lock' => 0,
+ '_use_tls' => 0,
+ '_tls_user' => '',
+ '_tls_password' => '',
};
bless $self, $class;
$self->{_attr} = {
map {$_ => 1} qw(
- _address _distribution _comments _errstr _via _timeout _debug _dir
+ _address _distribution _comments _errstr _via _timeout _debug _dir _use_tls _tls_user _tls_password
)
};
@@ -106,7 +110,7 @@
my %params = @_;
my @defaults = qw(
- mx address grade distribution from comments via timeout debug dir);
+ mx address grade distribution from comments via timeout debug dir use_tls tls_user tls_password);
my %defaults = map {$_ => 1} @defaults;
for my $param (keys %params) {
@@ -231,7 +235,9 @@
return unless $self->_verify();
- if ($^O !~ /^(?:cygwin|MSWin32)$/ && $self->_have_mail_send()) {
+ if ($^O !~ /^(?:cygwin|MSWin32)$/
+ && $self->_have_mail_send()
+ && !$self->{_use_tls} ) { # we need to use Net::SMTP::TLS
return $self->_mail_send(@recipients);
}
else {
@@ -370,8 +376,13 @@
my $mx;
for my $server (@{$self->{_mx}}) {
- $smtp = Net::SMTP->new($server, Hello => $helo,
- Timeout => $self->{_timeout}, Debug => $debug);
+ $smtp = $self->{_use_tls}
+ ? Net::SMTP::TLS->new( $server, Hello => $helo,
+ Timeout => $self->{_timeout}, Debug => $debug,
+ User => $self->{_tls_user},
+ Password => $self->{_tls_password})
+ : Net::SMTP->new($server, Hello => $helo,
+ Timeout => $self->{_timeout}, Debug => $debug);
if (defined $smtp) {
$mx = $server;
@@ -426,12 +437,13 @@
$success += $smtp->dataend();
$success += $smtp->quit;
+ # apparently Net::SMTP::TLS doesn't return 1 for succesful operations the way Net::SMTP does...
if (@recipients) {
$self->errstr(__PACKAGE__ .
- ": Unable to send test report to one or more recipients\n") if $success != 14;
+ ": Unable to send test report to one or more recipients\n") if !$self->{_use_tls} && $success != 14;
}
else {
- $self->errstr(__PACKAGE__ . ": Unable to send test report\n") if $success != 12;
+ $self->errstr(__PACKAGE__ . ": Unable to send test report\n") if !$self->{_use_tls} && $success != 12;
}
return $self->errstr() ? 0 : 1;
@@ -765,6 +777,19 @@
really shouldn't need to use this unless the hardcoded MX's have
become wrong and you don't have Net::DNS installed.
+=item * B<use_tls>
+
+Optional. Indicates that TLS authentication should be used to send.
+If set, tls_user and tls_password must also be set.
+
+=item * B<tls_user>
+
+Optional. User to be used for TLS authentication.
+
+=item * B<tls_password>
+
+Optional. Password to be used for TLS authentication.
+
=item * B<mail_send_args>
Optional. If you have MailTools installed and you want to have it
@@ -842,6 +867,8 @@
=item * L<Net::SMTP>
+=item * L<Net::SMTP::TLS>
+
=item * L<File::Spec>
=item * L<File::Temp>
diff -aur Test-Reporter-1.27/t/reporter.t Test-Reporter-1.27a/t/reporter.t
--- Test-Reporter-1.27/t/reporter.t 2005-01-10 13:35:54.000000000 -0800
+++ Test-Reporter-1.27a/t/reporter.t 2006-11-02 11:42:48.000000000 -0800
@@ -4,7 +4,7 @@
use Test;
use Test::Reporter;
-BEGIN { plan tests => 54 }
+BEGIN { plan tests => 73 }
my $distro = sprintf "Test-Reporter-%s", $Test::Reporter::VERSION;
@@ -126,3 +126,46 @@
ok($reporter->report =~ /Summary of my/);
ok($reporter->grade, 'pass');
ok($reporter->distribution, $distro);
+
+#---
+
+undef $reporter;
+
+$reporter = Test::Reporter->new
+(
+ mx => [1, 2, 3, 4, 5],
+ address => 'foo@bar',
+ grade => 'pass',
+ distribution => 'Bar-1.0',
+ from => 'me@me.com',
+ comments => 'woo',
+ via => 'something',
+ timeout => 500,
+ debug => 0,
+ dir => '/tmp',
+ use_tls => 1,
+ tls_user => 'user',
+ tls_password => 'password',
+);
+ok(ref $reporter, 'Test::Reporter');
+ok($reporter->subject =~ /^PASS Bar-1.0\s/);
+ok($reporter->report =~ /This distribution has been tested/);
+ok($reporter->report =~ /Please cc any replies to/);
+ok($reporter->report =~ /Summary of my/);
+ok($reporter->report =~ /woo/);
+ok($reporter->grade, 'pass');
+ok($reporter->distribution, 'Bar-1.0');
+ok($reporter->timeout, 500);
+ok($reporter->comments, 'woo');
+ok($reporter->via, 'something');
+ok($reporter->from, 'me@me.com');
+ok($reporter->address, 'foo@bar');
+ok($reporter->debug, 0);
+ok(scalar @{$reporter->mx}, 5);
+ok($reporter->dir, '/tmp');
+ok($reporter->use_tls, 1);
+ok($reporter->tls_user, 'user');
+ok($reporter->tls_password, 'password');
+
+
+