| Subject: | PATCH: Proposed tls_immediate option for mail servers such as fastmail.fm |
Hi Jenda,
I've been using Mail::Sender to send mail via the fastmail.fm service. Their mail server listens on 465 and expects an immediate TLS connection, without the usual negotiation of STARTTLS
The attached patch provides a proposed "tls_immediate" option which allows Mail::Sender to work with fastmail.
Cheers
Dave
| Subject: | mail_sender_tls_immediate_v0_8_23.patch |
diff -Naur old/Sender.pm new/Sender.pm
--- old/Sender.pm 2014-07-16 04:40:43.000000000 +1000
+++ new/Sender.pm 2014-10-04 08:31:07.279645824 +1000
@@ -871,6 +871,10 @@
If set to a true value the LOGIN authentication assumes the authid and authpwd
is already base64 encoded.
+=item tls_immediate
+
+If you set this option to a true value, the module will immediately initiate an SSL connection with the server, before even sending a HELO message
+
=item tls_allowed
If set to a true value Mail::Sender attempts to use LTS (SSL encrypted connection) whenever
@@ -1070,6 +1074,38 @@
return $CTypes{uc $ext} || 'application/octet-stream';
}
+sub start_tls {
+ my ($self, $s) = @_;
+
+ my %ssl_options = (
+ SSL_version =>'TLSv1',
+ SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
+ );
+ if (exists $self->{ssl_version}) { $ssl_options{SSL_version} = $self->{ssl_version}; }
+ if (exists $self->{ssl_verify_mode}) { $ssl_options{SSL_verify_mode} = $self->{ssl_verify_mode}; }
+ if (exists $self->{ssl_ca_path}) { $ssl_options{SSL_ca_path} = $self->{ssl_ca_path}; }
+ if (exists $self->{ssl_ca_file}) { $ssl_options{SSL_ca_file} = $self->{ssl_ca_file}; }
+ if (exists $self->{ssl_verifycb_name}) { $ssl_options{SSL_verifycb_name} = $self->{ssl_verifycb_name}; }
+ if (exists $self->{ssl_verifycn_schema}) { $ssl_options{ssl_verifycn_schema} = $self->{ssl_verifycn_schema}; }
+ if (exists $self->{ssl_hostname}) { $ssl_options{SSL_hostname} = $self->{ssl_hostname}; }
+
+ my $res;
+ if ($self->{'debug'}) {
+#print "Debug: \$s=$s\ntied(\$s)=" . tied($s) . "\n\${tied(\$s)}=${tied($s)}\n";
+#print "Debug: \$s=$s\n\${\$s}=" . ${$s} . "\n";
+#use PSH;
+#$::S = $s;
+#PSH::prompt;
+ $res = IO::Socket::SSL->start_SSL( tied(*$s)->[0], %ssl_options)
+ } else {
+ $res = IO::Socket::SSL->start_SSL( $s, %ssl_options)
+ }
+ if (! $res) {
+ return $self->Error(IO_SOCKET_SSL(IO::Socket::SSL::errstr()));
+ }
+ return;
+}
+
sub Connect {
my $self = shift();
@@ -1090,6 +1126,10 @@
or return $self->Error(DEBUGFILE($@));
$self->{'debug_level'} = 4 unless defined $self->{'debug_level'};
}
+ if ($self->{tls_immediate}) {
+ my $res = $self->start_tls($s);
+ return $res if $res;
+ }
$_ = get_response($s); if (not $_ or !/^[123]/) { return $self->Error(SERVNOTAVAIL($_)); }
$self->{'server'} = substr $_, 4;
@@ -1100,6 +1140,7 @@
}
if (($self->{tls_required} or $self->{tls_allowed})
+ and ! $self->{tls_immediate}
and ! $TLS_notsupported and (defined($self->{'supports'}{STARTTLS}) or defined($self->{'supports'}{TLS}))) {
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
@@ -1111,37 +1152,16 @@
return $self->Error(STARTTLS($code,$text)) if ($code != 220);
- my %ssl_options = (
- SSL_version =>'TLSv1',
- SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
- );
- if (exists $self->{ssl_version}) { $ssl_options{SSL_version} = $self->{ssl_version}; }
- if (exists $self->{ssl_verify_mode}) { $ssl_options{SSL_verify_mode} = $self->{ssl_verify_mode}; }
- if (exists $self->{ssl_ca_path}) { $ssl_options{SSL_ca_path} = $self->{ssl_ca_path}; }
- if (exists $self->{ssl_ca_file}) { $ssl_options{SSL_ca_file} = $self->{ssl_ca_file}; }
- if (exists $self->{ssl_verifycb_name}) { $ssl_options{SSL_verifycb_name} = $self->{ssl_verifycb_name}; }
- if (exists $self->{ssl_verifycn_schema}) { $ssl_options{ssl_verifycn_schema} = $self->{ssl_verifycn_schema}; }
- if (exists $self->{ssl_hostname}) { $ssl_options{SSL_hostname} = $self->{ssl_hostname}; }
-
- if ($self->{'debug'}) {
-#print "Debug: \$s=$s\ntied(\$s)=" . tied($s) . "\n\${tied(\$s)}=${tied($s)}\n";
-#print "Debug: \$s=$s\n\${\$s}=" . ${$s} . "\n";
-#use PSH;
-#$::S = $s;
-#PSH::prompt;
- $res = IO::Socket::SSL->start_SSL( tied(*$s)->[0], %ssl_options)
- } else {
- $res = IO::Socket::SSL->start_SSL( $s, %ssl_options)
- }
- if (! $res) {
- return $self->Error(IO_SOCKET_SSL(IO::Socket::SSL::errstr()));
- }
+ {
+ my $res = $self->start_tls($s);
+ return $res if $res;
+ }
{
my $res = $self->say_helo($s);
return $res if $res;
}
- } elsif ($self->{tls_required}) {
+ } elsif ($self->{tls_required} and ! $self->{tls_immediate}) {
if ($TLS_notsupported) {
return $self->Error(TLS_UNSUPPORTED_BY_ME($TLS_notsupported))
} else {
@@ -2663,6 +2683,19 @@
) or return $self->Error(CONNFAILED);
$s->autoflush(1);
+ binmode($s);
+
+ if ($self->{'debug'}) {
+ eval {
+ $s = __Debug( $s, $self->{'debug'});
+ }
+ or return $self->Error(DEBUGFILE($@));
+ $self->{'debug_level'} = 4 unless defined $self->{'debug_level'};
+ }
+ if ($self->{tls_immediate}) {
+ my $res = $self->start_tls($s);
+ return $res if $res;
+ }
$_ = get_response($s); if (not $_ or !/^[123]/) { return $self->Error(SERVNOTAVAIL($_)); }
$self->{'server'} = substr $_, 4;
diff -Naur old/t/01-create-object.t new/t/01-create-object.t
--- old/t/01-create-object.t 2012-12-13 05:55:28.000000000 +1100
+++ new/t/01-create-object.t 2014-10-04 08:34:27.729052105 +1000
@@ -16,6 +16,8 @@
ok( $sender->{smtpaddr}, "smtpaddr defined");
+ $sender->QueryAuthProtocols();
+
my $res = $sender->Connect();
ok( (ref($res) or $res >=0), "->Connect()")
or do { diag("Error: $Mail::Sender::Error"); exit};