API tools faq
paste
Guest User

patch to add tls and ssl to MIME::Lite lib per

a guest
Sep 15th, 2010
139
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 9.71 KB | None | 0 0
raw download clone embed print report
  1. ~]# diff -u MIME-Lite-3.027/lib/MIME/Lite.pm /usr/lib/perl5/site_perl/5.8.8/MIME/Lite.pm
  2. --- MIME-Lite-3.027/lib/MIME/Lite.pm 2009-10-10 04:04:04.000000000 +0200
  3. +++ /usr/lib/perl5/site_perl/5.8.8/MIME/Lite.pm 2010-09-15 18:47:00.000000000 +0200
  4. @@ -404,6 +404,8 @@
  5. sendmail => [$SENDMAIL ? "$SENDMAIL -t -oi -oem" : undef],
  6. smtp => [],
  7. sub => [],
  8. + tls => [],
  9. + ssl => [],
  10. );
  11.  
  12. ### Boundary counter:
  13. @@ -2565,22 +2567,28 @@
  14. if (@_) { ### args; use them just this once
  15. $method = 'send_by_' . $meth;
  16. @args = @_;
  17. - } else { ### no args; use defaults
  18. + } elsif (@_) { ### no args; use defaults
  19. $method = "send_by_$Sender";
  20. @args = @{ $SenderArgs{$Sender} || [] };
  21. - }
  22. - $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
  23. - Carp::croak "Unknown send method '$meth'" unless $self->can($method);
  24. - return $self->$method(@args);
  25. - } else { ### class method:
  26. - if (@_) {
  27. + } elsif (@_) {
  28. my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
  29. $Sender = $meth;
  30. $SenderArgs{$Sender} = [@_]; ### remaining args
  31. return @old;
  32. - } else {
  33. + } elsif (@_) {
  34. + $method = "send_by_$Sender";
  35. + @args = @{ $SenderArgs{$Sender} || [] };
  36. + } elsif (@_) {
  37. + $method = "send_by_$Sender";
  38. + @args = @{ $SenderArgs{$Sender} || [] };
  39. +
  40. +
  41. + $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
  42. + Carp::croak "Unknown send method '$meth'" unless $self->can($method);
  43. + return $self->$method(@args);
  44. + } else {
  45. Carp::croak "class method send must have HOW... arguments\n";
  46. - }
  47. + }
  48. }
  49. }
  50.  
  51. @@ -2908,6 +2916,150 @@
  52.  
  53. return $self->{last_send_successful} = 1;
  54. }
  55. +sub send_by_tls {
  56. + require Net::SMTP::TLS;
  57. + require Net::SMTP_auth;
  58. + my ($self,$hostname,%args) = @_;
  59. + # We may need the "From:" and "To:" headers to pass to the
  60. + # SMTP mailer also.
  61. + $self->{last_send_successful}=0;
  62. +
  63. + my @hdr_to = extract_only_addrs( scalar $self->get('To') );
  64. + if ($AUTO_CC) {
  65. + foreach my $field (qw(Cc Bcc)) {
  66. + push @hdr_to, extract_only_addrs($_) for $self->get($field);
  67. + }
  68. + }
  69. + Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
  70. + unless @hdr_to;
  71. +
  72. + $args{To} ||= \@hdr_to;
  73. + $args{From} ||= extract_only_addrs( scalar $self->get('Return-Path') );
  74. + $args{From} ||= extract_only_addrs( scalar $self->get('From') ) ;
  75. +
  76. + # Create SMTP client.
  77. + # MIME::Lite::SMTP is just a wrapper giving a print method
  78. + # to the SMTP object.
  79. +
  80. + my %opts = __opts(\%args, @_net_smtp_opts);
  81. + my $smtp = MIME::Lite::SMTP::TLS->new( $hostname, %opts )
  82. + or Carp::croak "SMTP Failed to connect to mail server: $!\n";
  83. +
  84. + # Possibly authenticate
  85. + if ( defined $args{AuthUser} and defined $args{AuthPass}
  86. + and !$args{NoAuth} )
  87. + {
  88. + if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
  89. + $smtp->auth( $args{AuthUser}, $args{AuthPass} )
  90. + or die "SMTP auth() command failed: $!\n"
  91. + . $smtp->message . "\n";
  92. + } else {
  93. + die "SMTP auth() command not supported on $hostname\n";
  94. + }
  95. + }
  96. +
  97. + # Send the mail command
  98. + %opts = __opts( \%args, @_mail_opts);
  99. + $smtp->mail( $args{From}, %opts ? \%opts : () )
  100. + or die "SMTP mail() command failed: $!\n"
  101. + . $smtp->message . "\n";
  102. +
  103. + # Send the recipients command
  104. + %opts = __opts( \%args, @_recip_opts);
  105. + $smtp->recipient( @{ $args{To} }, %opts ? \%opts : () )
  106. + or die "SMTP recipient() command failed: $!\n"
  107. + . $smtp->message . "\n";
  108. +
  109. + # Send the data
  110. + $smtp->data()
  111. + or die "SMTP data() command failed: $!\n"
  112. + . $smtp->message . "\n";
  113. + $self->print_for_smtp($smtp);
  114. +
  115. + # Finish the mail
  116. + $smtp->dataend()
  117. + or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed.\n"
  118. + . "Last server message was:"
  119. + . $smtp->message
  120. + . "This probably represents a problem with newline encoding ";
  121. +
  122. + # terminate the session
  123. + $smtp->quit;
  124. +
  125. + return $self->{last_send_successful} = 1;
  126. +}
  127. +sub send_by_ssl {
  128. + require Net::SMTP::SSL;
  129. + require Net::SMTP_auth;
  130. + my ($self,$hostname,%args) = @_;
  131. + # We may need the "From:" and "To:" headers to pass to the
  132. + # SMTP mailer also.
  133. + $self->{last_send_successful}=0;
  134. +
  135. + my @hdr_to = extract_only_addrs( scalar $self->get('To') );
  136. + if ($AUTO_CC) {
  137. + foreach my $field (qw(Cc Bcc)) {
  138. + push @hdr_to, extract_only_addrs($_) for $self->get($field);
  139. + }
  140. + }
  141. + Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
  142. + unless @hdr_to;
  143. +
  144. + $args{To} ||= \@hdr_to;
  145. + $args{From} ||= extract_only_addrs( scalar $self->get('Return-Path') );
  146. + $args{From} ||= extract_only_addrs( scalar $self->get('From') ) ;
  147. +
  148. + # Create SMTP client.
  149. + # MIME::Lite::SMTP is just a wrapper giving a print method
  150. + # to the SMTP object.
  151. +
  152. + my %opts = __opts(\%args, @_net_smtp_opts);
  153. + my $smtp = MIME::Lite::SMTP::SSL->new( $hostname, %opts )
  154. + or Carp::croak "SMTP Failed to connect to mail server: $!\n";
  155. +
  156. + # Possibly authenticate
  157. + if ( defined $args{AuthUser} and defined $args{AuthPass}
  158. + and !$args{NoAuth} )
  159. + {
  160. + if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
  161. + $smtp->auth( $args{AuthUser}, $args{AuthPass} )
  162. + or die "SMTP auth() command failed: $!\n"
  163. + . $smtp->message . "\n";
  164. + } else {
  165. + die "SMTP auth() command not supported on $hostname\n";
  166. + }
  167. + }
  168. +
  169. + # Send the mail command
  170. + %opts = __opts( \%args, @_mail_opts);
  171. + $smtp->mail( $args{From}, %opts ? \%opts : () )
  172. + or die "SMTP mail() command failed: $!\n"
  173. + . $smtp->message . "\n";
  174. +
  175. + # Send the recipients command
  176. + %opts = __opts( \%args, @_recip_opts);
  177. + $smtp->recipient( @{ $args{To} }, %opts ? \%opts : () )
  178. + or die "SMTP recipient() command failed: $!\n"
  179. + . $smtp->message . "\n";
  180. +
  181. + # Send the data
  182. + $smtp->data()
  183. + or die "SMTP data() command failed: $!\n"
  184. + . $smtp->message . "\n";
  185. + $self->print_for_smtp($smtp);
  186. +
  187. + # Finish the mail
  188. + $smtp->dataend()
  189. + or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed.\n"
  190. + . "Last server message was:"
  191. + . $smtp->message
  192. + . "This probably represents a problem with newline encoding ";
  193. +
  194. + # terminate the session
  195. + $smtp->quit;
  196. +
  197. + return $self->{last_send_successful} = 1;
  198. +}
  199.  
  200. =item send_by_testfile FILENAME
  201.  
  202. @@ -3125,6 +3277,90 @@
  203. . "This probably represents a problem with newline encoding " );
  204. }
  205.  
  206. +#============================================================
  207. +
  208. +package MIME::Lite::SMTP::TLS;
  209. +
  210. +#============================================================
  211. +# This class just adds a print() method to Net::SMTP.
  212. +# Notice that we don't use/require it until it's needed!
  213. +
  214. +use strict;
  215. +use vars qw( @ISA );
  216. +@ISA = qw(Net::SMTP::TLS);
  217. +
  218. +# some of the below is borrowed from Data::Dumper
  219. +my %esc = ( "\a" => "\\a",
  220. + "\b" => "\\b",
  221. + "\t" => "\\t",
  222. + "\n" => "\\n",
  223. + "\f" => "\\f",
  224. + "\r" => "\\r",
  225. + "\e" => "\\e",
  226. + );
  227. +
  228. +sub _hexify {
  229. + local $_ = shift;
  230. + my @split = m/(.{1,16})/gs;
  231. + foreach my $split (@split) {
  232. + ( my $txt = $split ) =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/sg;
  233. + $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
  234. + print STDERR "M::L >>> $split : $txt\n";
  235. + }
  236. +}
  237. +
  238. +sub print {
  239. + my $smtp = shift;
  240. + $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
  241. + $smtp->datasend(@_)
  242. + or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed.\n"
  243. + . "Last server message was:"
  244. + . $smtp->message
  245. + . "This probably represents a problem with newline encoding " );
  246. +}
  247. +
  248. +#============================================================
  249. +
  250. +package MIME::Lite::SMTP::SSL;
  251. +
  252. +#============================================================
  253. +# This class just adds a print() method to Net::SMTP.
  254. +# Notice that we don't use/require it until it's needed!
  255. +
  256. +use strict;
  257. +use vars qw( @ISA );
  258. +@ISA = qw(Net::SMTP::SSL);
  259. +
  260. +# some of the below is borrowed from Data::Dumper
  261. +my %esc = ( "\a" => "\\a",
  262. + "\b" => "\\b",
  263. + "\t" => "\\t",
  264. + "\n" => "\\n",
  265. + "\f" => "\\f",
  266. + "\r" => "\\r",
  267. + "\e" => "\\e",
  268. + );
  269. +
  270. +sub _hexify {
  271. + local $_ = shift;
  272. + my @split = m/(.{1,16})/gs;
  273. + foreach my $split (@split) {
  274. + ( my $txt = $split ) =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/sg;
  275. + $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
  276. + print STDERR "M::L >>> $split : $txt\n";
  277. + }
  278. +}
  279. +
  280. +sub print {
  281. + my $smtp = shift;
  282. + $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
  283. + $smtp->datasend(@_)
  284. + or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed.\n"
  285. + . "Last server message was:"
  286. + . $smtp->message
  287. + . "This probably represents a problem with newline encoding " );
  288. +}
  289. +
  290.  
  291. #============================================================
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!