patch pour MIME::Lite support tls et ssl

bonjour les news

je viens de finir l ecriture d un patch pour MIME::Lite
que voici

--- MIME-Lite-3.027/lib/MIME/Lite.pm 2009-10-10 04:04:04.000000000 +0200
+++ /usr/lib/perl5/vendor_perl/5.8.8/MIME/Lite.pm 2010-09-14
17:24:43.000000000 +0200
@@ -344,7 +344,7 @@


# GLOBALS, EXTERNAL/CONFIGURATION...
-$VERSION = '3.027';
+$VERSION = '3.025';

### Automatically interpret CC/BCC for SMTP:
$AUTO_CC = 1;
@@ -404,6 +404,8 @@
sendmail => [$SENDMAIL ? "$SENDMAIL -t -oi -oem" : undef],
smtp => [],
sub => [],
+ tls => [],
+ ssl => [],
);

### Boundary counter:
@@ -436,7 +438,7 @@

### See if we have/want MIME::Types
my $HaveMimeTypes = 0;
-if ( !$PARANOID and eval "require MIME::Types;
MIME::Types->VERSION(1.28);" ) {
+if ( !$PARANOID and eval "require MIME::Types;
MIME::Types->VERSION(1.004);" ) {
$HaveMimeTypes = 1;
push @Uses, "T$MIME::Types::VERSION";
}
@@ -2565,10 +2567,17 @@
if (@_) { ### args; use them just this once
$method = 'send_by_' . $meth;
@args = @_;
- } else { ### no args; use defaults
+ }
+ elsif (@_) { ### no args; use defaults
$method = "send_by_$Sender";
@args = @{ $SenderArgs{$Sender} || [] };
- }
+ } elsif (@_) {
+ $method = 'send_by_smtp_' . $meth;
+ @args = @{ $SenderArgs{$Sender} || [] };
+ } else {
+ $method = 'send_by_smtp_'. $meth;
+ @args = @{ $SenderArgs{$Sender} || [] };
+ }
$self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
Carp::croak "Unknown send method '$meth'" unless
$self->can($method);
return $self->$method(@args);
@@ -2836,6 +2845,123 @@
my $args=shift;
return map { exists $args->{$_} ? ( $_ => $args->{$_} ) : () } @_;
}
+sub send_by_smtp_tls {
+ require Net::SMTP::TLS;
+ my ($self,$hostname,%args) = @_;
+ # We may need the "From:" and "To:" headers to pass to the
+ # SMTP mailer also.
+ $self->{last_send_successful}=0;
+
+ my @hdr_to = extract_only_addrs( scalar $self->get('To') );
+ if ($AUTO_CC) {
+ foreach my $field (qw(Cc Bcc)) {
+ push @hdr_to, extract_only_addrs($_) for $self->get($field);
+ }
+ }
+ Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
+ unless @hdr_to;
+
+ $args{To} ||= \@hdr_to;
+ $args{From} ||= extract_only_addrs( scalar $self->get('Return-Path') );
+ $args{From} ||= extract_only_addrs( scalar $self->get('From') ) ;
+
+ # Create SMTP client.
+ # MIME::Lite::SMTP is just a wrapper giving a print method
+ # to the SMTP object.
+
+ my %opts = __opts(\%args, @_net_smtp_opts);
+ my $smtp = MIME::Lite::SMTP::TLS->new( $hostname, %opts )
+ or Carp::croak "SMTP Failed to connect to mail server: $!\n";
+
+ # Send the mail command
+ %opts = __opts( \%args, @_mail_opts);
+ $smtp->mail( $args{From}, %opts ? \%opts : () )
+ or die "SMTP mail() command failed: $!\n"
+ . $smtp->message . "\n";
+
+ # Send the recipients command
+ %opts = __opts( \%args, @_recip_opts);
+ $smtp->to( @{ $args{To} }, %opts ? \%opts : () )
+ or die "SMTP recipient() command failed: $!\n"
+ . $smtp->message . "\n";
+
+ # Send the data
+ $smtp->data
+ or die "SMTP data() command failed: $!\n"
+ . $smtp->message . "\n";
+ $self->datasend( eval {print_for_smtp($smtp)});
+
+ # Finish the mail
+ $smtp->dataend()
+ or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed.\n"
+ . "Last server message was:"
+ . $smtp->message
+ . "This probably represents a problem with newline encoding ";
+
+ # terminate the session
+ $smtp->quit;
+
+ return $self->{last_send_successful} = 1;
+}
+
+sub send_by_smtp_ssl {
+ require Net::SMTP::SSL;
+ my ($self,$hostname,%args) = @_;
+ # We may need the "From:" and "To:" headers to pass to the
+ # SMTP mailer also.
+ $self->{last_send_successful}=0;
+
+ my @hdr_to = extract_only_addrs( scalar $self->get('To') );
+ if ($AUTO_CC) {
+ foreach my $field (qw(Cc Bcc)) {
+ push @hdr_to, extract_only_addrs($_) for $self->get($field);
+ }
+ }
+ Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
+ unless @hdr_to;
+
+ $args{To} ||= \@hdr_to;
+ $args{From} ||= extract_only_addrs( scalar $self->get('Return-Path') );
+ $args{From} ||= extract_only_addrs( scalar $self->get('From') ) ;
+
+ # Create SMTP client.
+ # MIME::Lite::SMTP is just a wrapper giving a print method
+ # to the SMTP object.
+
+ my %opts = __opts(\%args, @_net_smtp_opts);
+ my $smtp = MIME::Lite::SMTP::SSL->new( $hostname, %opts )
+ or Carp::croak "SMTP Failed to connect to mail server: $!\n";
+
+ # Send the mail command
+ %opts = __opts( \%args, @_mail_opts);
+ $smtp->mail( $args{From}, %opts ? \%opts : () )
+ or die "SMTP mail() command failed: $!\n"
+ . $smtp->message . "\n";
+
+ # Send the recipients command
+ %opts = __opts( \%args, @_recip_opts);
+ $smtp->to( @{ $args{To} }, %opts ? \%opts : () )
+ or die "SMTP recipient() command failed: $!\n"
+ . $smtp->message . "\n";
+
+ # Send the data
+ $smtp->data
+ or die "SMTP data() command failed: $!\n"
+ . $smtp->message . "\n";
+ $self->datasend( eval {print_for_smtp($smtp)});
+
+ # Finish the mail
+ $smtp->dataend()
+ or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed.\n"
+ . "Last server message was:"
+ . $smtp->message
+ . "This probably represents a problem with newline encoding ";
+
+ # terminate the session
+ $smtp->quit;
+
+ return $self->{last_send_successful} = 1;
+}

sub send_by_smtp {
require Net::SMTP;
@@ -2864,7 +2990,6 @@
my %opts = __opts(\%args, @_net_smtp_opts);
my $smtp = MIME::Lite::SMTP->new( $hostname, %opts )
or Carp::croak "SMTP Failed to connect to mail server: $!\n";
-
# Possibly authenticate
if ( defined $args{AuthUser} and defined $args{AuthPass}
and !$args{NoAuth} )
@@ -2909,37 +3034,6 @@
return $self->{last_send_successful} = 1;
}

-=item send_by_testfile FILENAME
-
-I<Instance method.>
-Print message to a file (namely FILENAME), which will default to
-mailer.testfile
-If file exists, message will be appended.
-
-=cut
-
-sub send_by_testfile {
- my $self = shift;
-
- ### Use the default filename...
- my $filename = 'mailer.testfile';
-
- if ( @_ == 1 and !ref $_[0] ) {
- ### Use the given filename if given...
- $filename = shift @_;
- Carp::croak "no filename given to send_by_testfile" unless $filename;
- }
-
- ### Do it:
- local *FILE;
- open FILE, ">> $filename" or Carp::croak "open $filename: $!\n";
- $self->print( \*FILE );
- close FILE;
- my $return = ( ( $? >> 8 ) ? undef: 1 );
-
- return $self->{last_send_successful} = $return;
-}
-
=item last_send_successful

This method will return TRUE if the last send() or send_by_XXX()
method call was
@@ -2990,7 +3084,9 @@

### Create SMTP client:
require Net::SMTP;
- my $smtp = MIME::Lite::SMTP->new(@args)
+ require Net::SMTP::TLS;
+ require Net::SMTP::SSL;
+ my $smtp = MIME::Lite::SMTP->new(@args) ||
MIME::Lite::SMTP::TLS->new(@args) || MIME::Lite::SMTP::SSL->new(@args)
or Carp::croak("Failed to connect to mail server: $!\n");
$smtp->mail($from)
or Carp::croak( "SMTP MAIL command failed: $!\n" .
$smtp->message . "\n" );
@@ -3128,6 +3224,91 @@

#============================================================

+package MIME::Lite::SMTP::TLS;
+
+#============================================================
+# This class just adds a print() method to Net::SMTP.
+# Notice that we don't use/require it until it's needed!
+
+use strict;
+use vars qw( @ISA );
+@ISA = qw(Net::SMTP::TLS);
+
+# some of the below is borrowed from Data::Dumper
+my %esc = ( "\a" => "\\a",
+ "\b" => "\\b",
+ "\t" => "\\t",
+ "\n" => "\\n",
+ "\f" => "\\f",
+ "\r" => "\\r",
+ "\e" => "\\e",
+);
+
+sub _hexify {
+ local $_ = shift;
+ my @split = m/(.{1,16})/gs;
+ foreach my $split (@split) {
+ ( my $txt = $split ) =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txt\n";
+ }
+}
+
+sub print {
+ my $smtp = shift;
+ $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
+ $smtp->datasend(@_)
+ or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed.\n"
+ . "Last server message was:"
+ . $smtp->message
+ . "This probably represents a problem with
newline encoding " );
+}
+
+
+#============================================================
+
+package MIME::Lite::SMTP::SSL;
+
+#============================================================
+# This class just adds a print() method to Net::SMTP.
+# Notice that we don't use/require it until it's needed!
+
+use strict;
+use vars qw( @ISA );
+@ISA = qw(Net::SMTP::SSL);
+
+# some of the below is borrowed from Data::Dumper
+my %esc = ( "\a" => "\\a",
+ "\b" => "\\b",
+ "\t" => "\\t",
+ "\n" => "\\n",
+ "\f" => "\\f",
+ "\r" => "\\r",
+ "\e" => "\\e",
+ );
+
+sub _hexify {
+ local $_ = shift;
+ my @split = m/(.{1,16})/gs;
+ foreach my $split (@split) {
+ ( my $txt = $split ) =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txt\n";
+ }
+}
+
+sub print {
+ my $smtp = shift;
+ $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
+ $smtp->datasend(@_)
+ or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed.\n"
+ . "Last server message was:"
+ . $smtp->message
+ . "This probably represents a problem with newline encoding " );
+}
+
+#============================================================
+
package MIME::Lite::IO_Handle;

#============================================================
@@ -3640,7 +3821,7 @@

=head1 VERSION

-Version: 3.027
+Version: 3.01_06 (Dev Test Release)

=head1 CHANGE LOG

le patch est pleinement fonctionnel
mais malgre quand on declare dans le constructeur de tls le port 587
les emails continuent à sortir par le 25

la je ne sais pas du tout pourquoi