hello guys i am french i am love Perl i am good in Perl 3 level actually for perlmonks
i wrote a patch for MIME::Lite
i quote
~]# cat mimelitefinal.patch
--- Desktop/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-16
20:11:16.000000000 +0200
@@ -404,6 +404,8 @@
sendmail => [$SENDMAIL ? "$SENDMAIL -t -oi -oem" : undef],
smtp => [],
sub => [],
+ tls => [],
+ ssl => [],
);
### Boundary counter:
@@ -2562,25 +2564,23 @@
if ( ref($self) ) { ### instance method:
my ( $method, @args );
- if (@_) { ### args; use them just this once
- $method = 'send_by_' . $meth;
+ if (@_) { ### no args; use defaults
+ $method = 'send_by_'.$meth;
@args = @_;
- } else { ### no args; use defaults
+ } elsif (@_) {
+ my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
+ $Sender = $meth;
+ $SenderArgs{$Sender} = [...@_]; ### remaining args
+ return @old;
+ } 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 { ### class method:
- if (@_) {
- my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
- $Sender = $meth;
- $SenderArgs{$Sender} = [...@_]; ### remaining args
- return @old;
- } else {
+ } else {
Carp::croak "class method send must have HOW... arguments
\n";
- }
}
}
@@ -2829,7 +2829,7 @@
my @_mail_opts = qw( Size Return Bits Transaction Envelope );
my @_recip_opts = qw( SkipBad );
my @_net_smtp_opts = qw( Hello LocalAddr LocalPort Timeout
- Port ExactAddresses Debug );
+ Port User Password ExactAddresses Debug );
# internal: qw( NoAuth AuthUser AuthPass To From Host);
sub __opts {
@@ -2872,7 +2872,7 @@
if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
$smtp->auth( $args{AuthUser}, $args{AuthPass} )
or die "SMTP auth() command failed: $!\n"
- . $smtp->message . "\n";
+ . $smtp . "\n";
} else {
die "SMTP auth() command not supported on $hostname\n";
}
@@ -2893,14 +2893,14 @@
# Send the data
$smtp->data()
or die "SMTP data() command failed: $!\n"
- . $smtp->message . "\n";
+ . $smtp . "\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
+ . $smtp
. "This probably represents a problem with newline encoding ";
# terminate the session
@@ -2908,6 +2908,121 @@
return $self->{last_send_successful} = 1;
}
+sub send_by_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 . "\n";
+
+ # Send the recipients command
+ %opts = __opts( \%args, @_recip_opts);
+ $smtp->to( @{ $args{To} }, %opts ? \%opts : () )
+ or die "SMTP recipient() command failed: $!\n"
+ . $smtp . "\n";
+
+ # Send the data
+ $smtp->data()
+ or die "SMTP data() command failed: $!\n"
+ . $smtp . "\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 . "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;
+ 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 . "\n";
+
+ # Send the recipients command
+ %opts = __opts( \%args, @_recip_opts);
+ $smtp->to( @{ $args{To} }, %opts ? \%opts : () )
+ or die "SMTP recipient() command failed: $!\n"
+ . $smtp . "\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 . "This probably represents a problem with newline
encoding ";
+
+ # terminate the session
+ $smtp->quit;
+
+ return $self->{last_send_successful} = 1;
+}
=item send_by_testfile FILENAME
@@ -3121,10 +3236,92 @@
$smtp->datasend(@_)
or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command
failed.\n"
. "Last server message was:"
- . $smtp->message
+ . $smtp
. "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_tls = ( "\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_tls{$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 . "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_ssl = ( "\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_ssl{$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 . "This probably represents a problem
with newline encoding " );
+}
+
#============================================================
it's down in debugger in $mailer->mail('t...@toto.org')
and a more
no error is present in Net::SMTP::TLS
i know a découvert a bug
i don't understand this error
more appointment a pleasure
--
http://pgp.mit.edu:11371/pks/lookup?op=get&search=0x092164A7
gpg --keyserver pgp.mit.edu --recv-key 092164A7
signature.asc
Description: Ceci est une partie de message numériquement signée
