| Subject: | i add a more support compliant with this lib tls and ssl for MIME::Lite |
add support with compliance to libraries
~]# perl -V
Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
Platform:
osname=linux, osvers=2.6.18-53.el5, archname=i386-linux-thread-multi
uname='linux builder10.centos.org 2.6.18-53.el5 #1 smp mon nov 12
02:14:55 est 2007 i686 athlon i386 gnulinux '
config_args='-des -Doptimize=-O2 -g -pipe -Wall
-Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector
--param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic
-fasynchronous-unwind-tables -Dversion=5.8.8 -Dmyhostname=localhost
-Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc.
-Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux-thread-multi
-Dvendorprefix=/usr -Dsiteprefix=/usr -Duseshrplib -Dusethreads
-Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db
-Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio
-Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly
-Dpager=/usr/bin/less -isr -Dd_gethostent_r_proto -Ud_endhostent_r_proto
-Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto
-Ud_endservent_r_proto -Ud_setservent_r_proto -Dinc_version_list=5.8.7
5.8.6 5.8.5 -Dscriptdir=/usr/bin'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define
usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing
-pipe -Wdeclaration-after-statement -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
optimize='-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions
-fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386
-mtune=generic -fasynchronous-unwind-tables',
cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe
-Wdeclaration-after-statement -I/usr/local/include -I/usr/include/gdbm'
ccversion='', gccversion='4.1.2 20080704 (Red Hat 4.1.2-48)',
gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='gcc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
libc=/lib/libc-2.5.so, so=so, useshrplib=true, libperl=libperl.so
gnulibc_version='2.5'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E
-Wl,-rpath,/usr/lib/perl5/5.8.8/i386-linux-thread-multi/CORE'
cccdlflags='-fPIC', lddlflags='-shared -O2 -g -pipe -Wall
-Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector
--param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic
-fasynchronous-unwind-tables -L/usr/local/lib'
Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY PERL_IMPLICIT_CONTEXT
PERL_MALLOC_WRAP USE_ITHREADS USE_LARGE_FILES
USE_PERLIO USE_REENTRANT_API
Built under linux
Compiled at Jun 7 2010 21:31:34
@INC:
/usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
/usr/lib/perl5/site_perl/5.8.8
/usr/lib/perl5/site_perl
/usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
/usr/lib/perl5/vendor_perl/5.8.8
/usr/lib/perl5/vendor_perl
/usr/lib/perl5/5.8.8/i386-linux-thread-multi
/usr/lib/perl5/5.8.8
.
uname -a
Linux r13151.ovh.net 2.6.32.2-xxxx-grs-ipv4-32 #1 SMP Tue Dec 29
14:41:18 UTC 2009 i686 i686 i386 GNU/Linux
| Subject: | tp.patch |
--- 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... arguments\n";
- }
+ }
}
}
@@ -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 $hostname\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->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 $hostname\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->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/([\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 " );
+}
+
#============================================================