Skip Menu |
 

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the Mail-Sender CPAN distribution.

Report information
The Basics
Id: 99302
Status: rejected
Priority: 0/
Queue: Mail-Sender

People
Owner: cwhitener [...] gmail.com
Requestors: DDICK [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: 0.8.23
Fixed in: (no value)



Subject: PATCH: Proposed tls_immediate option for mail servers such as fastmail.fm
Download (untitled) / with headers
text/plain 323b
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};
Download (untitled) / with headers
text/plain 434b
On Sat Oct 04 08:39:22 2014, DDICK wrote: Show quoted text
> The attached patch provides a proposed "tls_immediate" option which > allows Mail::Sender to work with fastmail.
I've added a second patch with complete coverage for both of fastmail.fm's options 1) an immediate TLS connection 2) a STARTTLS connection with the Auth Protocols ONLY supplied once the STARTTLS session has begun (need to run HELO twice to actually get the Auth Protocols)
Subject: mail_sender_tls_immediate_v0_8_23.patch2

Message body not shown because it is not plain text.

Download (untitled) / with headers
text/plain 565b
On Sun Oct 12 07:08:38 2014, DDICK wrote: Show quoted text
> On Sat Oct 04 08:39:22 2014, DDICK wrote:
> > The attached patch provides a proposed "tls_immediate" option which > > allows Mail::Sender to work with fastmail.
> > I've added a second patch with complete coverage for both of > fastmail.fm's options > > 1) an immediate TLS connection > 2) a STARTTLS connection with the Auth Protocols ONLY supplied once > the STARTTLS session has begun (need to run HELO twice to actually get > the Auth Protocols)
I've updated the patch to correctly refer to this option as "smtps"
Subject: mail_sender_smtps_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 smtps + +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->{smtps}) { + 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->{smtps} 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->{smtps}) { 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->{smtps}) { + 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};
Download (untitled) / with headers
text/plain 647b
On Mon Jan 26 08:12:59 2015, DDICK wrote: Show quoted text
> On Sun Oct 12 07:08:38 2014, DDICK wrote:
> > On Sat Oct 04 08:39:22 2014, DDICK wrote:
> > > The attached patch provides a proposed "tls_immediate" option which > > > allows Mail::Sender to work with fastmail.
> > > > I've added a second patch with complete coverage for both of > > fastmail.fm's options > > > > 1) an immediate TLS connection > > 2) a STARTTLS connection with the Auth Protocols ONLY supplied once > > the STARTTLS session has begun (need to run HELO twice to actually get > > the Auth Protocols)
> > I've updated the patch to correctly refer to this option as "smtps"
Code fixup
Subject: mail_sender_smtps_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 2015-01-26 11:05:47.014739208 +1100 @@ -871,6 +871,10 @@ If set to a true value the LOGIN authentication assumes the authid and authpwd is already base64 encoded. +=item smtps + +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->{smtps}) { # this is required for mail servers such as fastmail.fm on port 465 + 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; @@ -1099,6 +1139,23 @@ return $res if $res; } + if (!$self->{smtps}) { + my $res = $self->check_tls_connect($s); + return $res if $res; + } + + if ($self->{'auth'} or $self->{'username'}) { + $self->{'socket'} = $s; + my $res = $self->login(); + return $res if $res; + delete $self->{'socket'}; # it's supposed to be added later + } + + return $s; +} + +sub check_tls_connect { + my ($self, $s) = @_; if (($self->{tls_required} or $self->{tls_allowed}) and ! $TLS_notsupported and (defined($self->{'supports'}{STARTTLS}) or defined($self->{'supports'}{TLS}))) { Net::SSLeay::load_error_strings(); @@ -1111,31 +1168,10 @@ 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); @@ -1148,15 +1184,7 @@ return $self->Error(TLS_UNSUPPORTED_BY_SERVER()) } } - - if ($self->{'auth'} or $self->{'username'}) { - $self->{'socket'} = $s; - my $res = $self->login(); - return $res if $res; - delete $self->{'socket'}; # it's supposed to be added later - } - - return $s; + return; } sub Error { @@ -2663,6 +2691,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->{smtps}) { + 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; @@ -2671,6 +2712,12 @@ return $res if $res; } + if ((!keys %{$self->{'auth_protocols'}}) && (!$self->{smtps})) { + # some mail servers (such as fastmail.fm on port 587) only provide auth protocols over a TLS connection + my $res = $self->check_tls_connect($s); + return $res if $res; + } + $_ = send_cmd $s, "QUIT"; close $s; delete $self->{'socket'}; 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 2015-01-26 11:00:57.406517840 +1100 @@ -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};
Download (untitled) / with headers
text/plain 539b
Hi Dave, Thank you for the patch. However, the lack of a good test suite in this dist leaves me quite cautious about making large changes. There are other options for you, however. Email::Sender is an up-to-date dist that is well maintained and I would suggest you look at that. The transition to that dist shouldn't be too complex as the author has made it very simple to use. Once I get the test suite updated quite a bit here, I may look again at adding this patch, but I'm really in deprecation mode at the moment. Thanks, Chase
Download (untitled) / with headers
text/plain 346b
Hi Dave, As we discussed in email outside of the ticket, Mail::Sender is now marked deprecated and I'm going to forego adding any extra functionality at this point. Also, as we discussed, if you feel strongly about this in the future, please let me know and I'll do my best to work with you and try to get something going. Thanks again! Chase


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.