Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

add to MIME::Lite support for smtp tls and ssl on port 587 465

by swilting (Beadle)
on Sep 16, 2010 at 20:07 UTC ( #860388=note: print w/ replies, xml ) Need Help??


in reply to add to MIME::Lite support for smtp tls on port 587

i re add my patch correct if the blow

~]$ diff -u Desktop/MIME-Lite-3.027/lib/MIME/Lite.pm /usr/lib/perl5/s +ite_perl/5.8.8/MIME/Lite.pm --- Desktop/MIME-Lite-3.027/lib/MIME/Lite.pm 2009-10-10 04:04:04.00 +0000000 +0200 +++ /usr/lib/perl5/site_perl/5.8.8/MIME/Lite.pm 2010-09-16 20:11:16.00 +0000000 +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 p +arts! 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($fiel +d); + } + } + 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-Pat +h') ); + $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 enco +ding "; + + # 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($fiel +d); + } + } + 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-Pat +h') ); + $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 enco +ding "; + + # 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 newl +ine 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 w +ith 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 w +ith newline encoding " ); +} + #============================================================

I find myself with an error during authentication SASL LOGIN an error that I can not explain. I use perl correctly . my exemple to not work authentifications is

#!/usr/bin/perl -w use Getopt::Long; use MIME::Lite; use strict; use warnings; my $cc; my $bcc; my $msg; GetOptions( 'cc=s' => \$cc, 'bcc=s' => \$bcc, ); my( $from, $to, $subject ) = @ARGV; $msg = MIME::Lite->new ( From => $from, To => $to, Subject => $subject ); $msg->send('tls','mail.fakessh.eu', Hello => 'mail.fakessh.eu', Port => "587", User => "fakessh\@fakessh.eu" , Password => "***************" , Debug => 4 );

thanks for more return


Comment on add to MIME::Lite support for smtp tls and ssl on port 587 465
Select or Download Code
Replies are listed 'Best First'.
Re: add to MIME::Lite support for smtp tls and ssl on port 587 465
by ww (Bishop) on Sep 16, 2010 at 23:41 UTC

    Please, boil it down to a succinct case...
    and stop posting as new threads that which makes sense only as followups to your earlier nodes!

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://860388]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (16)
As of 2015-07-31 13:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (277 votes), past polls