patch pour MIME::Lite support tls et ssl

Le
john.swilting
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'?!"
+ 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: $!";
+
+ # Send the mail command
+ %opts = __opts( %args, @_mail_opts);
+ $smtp->mail( $args{From}, %opts ? %opts : () )
+ or die "SMTP mail() command failed: $!"
+ . $smtp->message . "";
+
+ # Send the recipients command
+ %opts = __opts( %args, @_recip_opts);
+ $smtp->to( @{ $args{To} }, %opts ? %opts : () )
+ or die "SMTP recipient() command failed: $!"
+ . $smtp->message . "";
+
+ # Send the data
+ $smtp->data
+ or die "SMTP data() command failed: $!"
+ . $smtp->message . "";
+ $self->datasend( eval {print_for_smtp($smtp)});
+
+ # Finish the mail
+ $smtp->dataend()
+ or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed."
+ . "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'?!"
+ 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: $!";
+
+ # Send the mail command
+ %opts = __opts( %args, @_mail_opts);
+ $smtp->mail( $args{From}, %opts ? %opts : () )
+ or die "SMTP mail() command failed: $!"
+ . $smtp->message . "";
+
+ # Send the recipients command
+ %opts = __opts( %args, @_recip_opts);
+ $smtp->to( @{ $args{To} }, %opts ? %opts : () )
+ or die "SMTP recipient() command failed: $!"
+ . $smtp->message . "";
+
+ # Send the data
+ $smtp->data
+ or die "SMTP data() command failed: $!"
+ . $smtp->message . "";
+ $self->datasend( eval {print_for_smtp($smtp)});
+
+ # Finish the mail
+ $smtp->dataend()
+ or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed."
+ . "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: $!";
-
# 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: $!";
- $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: $!");
$smtp->mail($from)
or Carp::croak( "SMTP MAIL command failed: $!" .
$smtp->message . "" );
@@ -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",
+ "" => "",
+ "f" => "\f",
+ "" => "",
+ "e" => "\e",
+);
+
+sub _hexify {
+ local $_ = shift;
+ my @split = m/(.{1,16})/gs;
+ foreach my $split (@split) {
+ ( my $txt = $split ) =~ s/([abtfe])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txt";
+ }
+}
+
+sub print {
+ my $smtp = shift;
+ $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
+ $smtp->datasend(@_)
+ or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed."
+ . "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",
+ "" => "",
+ "f" => "\f",
+ "" => "",
+ "e" => "\e",
+ );
+
+sub _hexify {
+ local $_ = shift;
+ my @split = m/(.{1,16})/gs;
+ foreach my $split (@split) {
+ ( my $txt = $split ) =~ s/([abtfe])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txt";
+ }
+}
+
+sub print {
+ my $smtp = shift;
+ $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
+ $smtp->datasend(@_)
+ or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed."
+ . "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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Denis Dordoigne
Le #22571131
Bonjour,

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


Je ne me suis pas amusé à appliquer le patch, mais en le lisant je vois
bien des "+@ISA" mais aucun "", le @ISA ajouté ne serait-il pas
écrasé par la suite par celui d'origine ?

--
Denis Dordoigne
Membre de l'April - promouvoir et défendre le logiciel libre - april.org
Rejoignez maintenant plus de 5 000 personnes, associations,
entreprises et collectivités qui soutiennent notre action
john.swilting
Le #22574251
Denis Dordoigne a écrit :
Bonjour,

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


Je ne me suis pas amusé à appliquer le patch, mais en le lisant je vois
bien des "+@ISA" mais aucun "", le @ISA ajouté ne serait-il pas
écrasé par la suite par celui d'origine ?





merci de votre reponse que je prends comme un soutien
j ai reecrit le patch en collant au plus pres de la lib historique
je cite

~]# diff -u MIME-Lite-3.027/lib/MIME/Lite.pm
/usr/lib/perl5/site_perl/5.8.8/MIME/Lite.pm
--- MIME-Lite-3.027/lib/MIME/Lite.pm 2009-10-10 04:04:04.000000000 +0200
+++ /usr/lib/perl5/site_perl/5.8.8/MIME/Lite.pm 2010-09-15
18:47:00.000000000 +0200
@@ -404,6 +404,8 @@
sendmail => [$SENDMAIL ? "$SENDMAIL -t -oi -oem" : undef],
smtp => [],
sub => [],
+ tls => [],
+ ssl => [],
);

### Boundary counter:
@@ -2565,22 +2567,28 @@
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} || [] };
- }
- $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
- Carp::croak "Unknown send method '$meth'" unless
$self->can($method);
- return $self->$method(@args);
- } else { ### class method:
- if (@_) {
+ } elsif (@_) {
my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
$Sender = $meth;
$SenderArgs{$Sender} = [@_]; ### remaining args
return @old;
- } else {
+ } elsif (@_) {
+ $method = "send_by_$Sender";
+ @args = @{ $SenderArgs{$Sender} || [] };
+ } elsif (@_) {
+ $method = "send_by_$Sender";
+ @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);
+ } else {
Carp::croak "class method send must have HOW... argumentsn";
- }
+ }
}
}

@@ -2908,6 +2916,150 @@

return $self->{last_send_successful} = 1;
}
+sub send_by_tls {
+ require Net::SMTP::TLS;
+ require Net::SMTP_auth;
+ 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";
+
+ # Possibly authenticate
+ if ( defined $args{AuthUser} and defined $args{AuthPass}
+ and !$args{NoAuth} )
+ {
+ if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
+ $smtp->auth( $args{AuthUser}, $args{AuthPass} )
+ or die "SMTP auth() command failed: $!n"
+ . $smtp->message . "n";
+ } else {
+ die "SMTP auth() command not supported on $hostnamen";
+ }
+ }
+
+ # 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->recipient( @{ $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->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_ssl {
+ require Net::SMTP::SSL;
+ require Net::SMTP_auth;
+ 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";
+
+ # Possibly authenticate
+ if ( defined $args{AuthUser} and defined $args{AuthPass}
+ and !$args{NoAuth} )
+ {
+ if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
+ $smtp->auth( $args{AuthUser}, $args{AuthPass} )
+ or die "SMTP auth() command failed: $!n"
+ . $smtp->message . "n";
+ } else {
+ die "SMTP auth() command not supported on $hostnamen";
+ }
+ }
+
+ # 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->recipient( @{ $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->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;
+}

=item send_by_testfile FILENAME

@@ -3125,6 +3277,90 @@
. "This probably represents a problem with
newline encoding " );
}

+#=========================================================== +
+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/([abtnfre])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txtn";
+ }
+}
+
+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/([abtnfre])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txtn";
+ }
+}
+
+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 " );
+}
+

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

je colle pourtant à l esprit de MIME::Lite
mais la plus aucun mail ne sort avec un constructeur send de ce style
eval {
$msg->send('tls',$r->{config}->{smtpserver},
Hello => $r->{config}->{smtpserver} ,
Port => "587",
LocalPort => "587" ,
AuthUser=>$r->{user},
AuthPass=>$r->{perlwebmail}->{user}->{password})
or die "Send failed: $!";
} or do {
warn $@;
$r->{send_error} = "Check the recipients or try removing attachments.";
return create_message($r);
};
john.swilting
Le #22575501
john.swilting a écrit :
bonjour les news



le patch pas correct voici le bon
~]# diff -u MIME-Lite-3.027/lib/MIME/Lite.pm
/usr/lib/perl5/site_perl/5.8.8/MIME/Lite.pm
--- MIME-Lite-3.027/lib/MIME/Lite.pm 2009-10-10 04:04:04.000000000 +0200
+++ /usr/lib/perl5/site_perl/5.8.8/MIME/Lite.pm 2010-09-15
18:47:00.000000000 +0200
@@ -404,6 +404,8 @@
sendmail => [$SENDMAIL ? "$SENDMAIL -t -oi -oem" : undef],
smtp => [],
sub => [],
+ tls => [],
+ ssl => [],
);

### Boundary counter:
@@ -2565,22 +2567,28 @@
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} || [] };
- }
- $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
- Carp::croak "Unknown send method '$meth'" unless
$self->can($method);
- return $self->$method(@args);
- } else { ### class method:
- if (@_) {
+ } elsif (@_) {
my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
$Sender = $meth;
$SenderArgs{$Sender} = [@_]; ### remaining args
return @old;
- } else {
+ } elsif (@_) {
+ $method = "send_by_$Sender";
+ @args = @{ $SenderArgs{$Sender} || [] };
+ } elsif (@_) {
+ $method = "send_by_$Sender";
+ @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);
+ } else {
Carp::croak "class method send must have HOW... argumentsn";
- }
+ }
}
}

@@ -2908,6 +2916,150 @@

return $self->{last_send_successful} = 1;
}
+sub send_by_tls {
+ require Net::SMTP::TLS;
+ require Net::SMTP_auth;
+ 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";
+
+ # Possibly authenticate
+ if ( defined $args{AuthUser} and defined $args{AuthPass}
+ and !$args{NoAuth} )
+ {
+ if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
+ $smtp->auth( $args{AuthUser}, $args{AuthPass} )
+ or die "SMTP auth() command failed: $!n"
+ . $smtp->message . "n";
+ } else {
+ die "SMTP auth() command not supported on $hostnamen";
+ }
+ }
+
+ # 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->recipient( @{ $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->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_ssl {
+ require Net::SMTP::SSL;
+ require Net::SMTP_auth;
+ 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";
+
+ # Possibly authenticate
+ if ( defined $args{AuthUser} and defined $args{AuthPass}
+ and !$args{NoAuth} )
+ {
+ if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
+ $smtp->auth( $args{AuthUser}, $args{AuthPass} )
+ or die "SMTP auth() command failed: $!n"
+ . $smtp->message . "n";
+ } else {
+ die "SMTP auth() command not supported on $hostnamen";
+ }
+ }
+
+ # 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->recipient( @{ $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->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;
+}

=item send_by_testfile FILENAME

@@ -3125,6 +3277,90 @@
. "This probably represents a problem with
newline encoding " );
}

+#=========================================================== +
+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/([abtnfre])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txtn";
+ }
+}
+
+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/([abtnfre])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txtn";
+ }
+}
+
+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 " );
+}
+

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


la je ne sais pas du tout pourquoi
Publicité
Poster une réponse
Anonyme