develooper Front page | perl.pep | Postings from October 2010

pacth for MIME::Lite

Thread Next
From:
fakessh
Date:
October 5, 2010 02:22
Subject:
pacth for MIME::Lite
Message ID:
1286270500.3329.20.camel@localhost.localdomain
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('toto@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

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About