Guest User

Untitled

a guest
Dec 13th, 2018
249
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.25 KB | None | 0 0
  1. package MIME::Lite::TLS;
  2.  
  3. use strict;
  4. use warnings;
  5. use Net::SMTP::TLS;
  6.  
  7. use parent 'MIME::Lite';
  8.  
  9.  
  10. =head1 NAME
  11.  
  12. MIME::Lite::TLS - adds send by SMTP+TLS to MIME::Lite
  13.  
  14. =head1 SYNOPSIS
  15.  
  16. Create a multipart message (i.e., one with attachments) and send it
  17. via SMTP+TLS
  18.  
  19. ### Create a new multipart message:
  20. $msg = MIME::Lite::TLS->new(
  21. From => 'me@myhost.com',
  22. To => 'you@yourhost.com',
  23. Cc => 'some@other.com, some@more.com',
  24. Subject => 'A message with 2 parts...',
  25. Type => 'multipart/mixed'
  26. );
  27.  
  28. ### Add parts (each "attach" has same arguments as "new"):
  29. $msg->attach(
  30. Type => 'TEXT',
  31. Data => "Here's the GIF file you wanted"
  32. );
  33. $msg->attach(
  34. Type => 'image/gif',
  35. Path => 'aaa000123.gif',
  36. Filename => 'logo.gif',
  37. Disposition => 'attachment'
  38. );
  39. ### use Net:SMTP to do the sending
  40. $msg->send('smtp_tls','smtp.gmail.com', User => 'example@gmail.com', Password => 'yupi' );
  41.  
  42.  
  43. =head1 DESCRIPTION
  44.  
  45. L<MIME::Lite> is great, until you need to send your messages to a server
  46. that requires TLS, like Google GMail servers.
  47.  
  48. This class extends L<MIME::Lite> to provide a new send method,
  49. C<smtp_tls>, that allows you to use such servers.
  50.  
  51.  
  52. =cut
  53.  
  54.  
  55. ## FIXME: a very large part of this is duplicated from send_by_smtp,
  56. ## move them to a common utility, reuse with parent MIME::Lite
  57. my @_net_smtp_tls_opts = qw( Hello Port Timeout User Password );
  58.  
  59. sub send_by_smtp_tls {
  60. my ($self, $hostname, %args) = @_;
  61.  
  62. # We may need the "From:" and "To:" headers to pass to the
  63. # SMTP mailer also.
  64. $self->{last_send_successful} = 0;
  65.  
  66. my @hdr_to = MIME::Lite::extract_only_addrs(scalar $self->get('To'));
  67. if ($MIME::Lite::AUTO_CC) {
  68. foreach my $field (qw(Cc Bcc)) {
  69. push @hdr_to, MIME::Lite::extract_only_addrs($_) for $self->get($field);
  70. }
  71. }
  72. Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
  73. unless @hdr_to;
  74.  
  75. $args{To} ||= \@hdr_to;
  76. $args{From} ||= MIME::Lite::extract_only_addrs(scalar $self->get('Return-Path'));
  77. $args{From} ||= MIME::Lite::extract_only_addrs(scalar $self->get('From'));
  78.  
  79. # Possibly authenticate
  80. if ( defined $args{AuthUser}
  81. and defined $args{AuthPass}
  82. and !$args{NoAuth})
  83. {
  84. $args{User} = $args{AuthUser};
  85. $args{Password} = $args{AuthPass};
  86. }
  87.  
  88. # Create SMTP client.
  89. # MIME::Lite::SMTP::TLS is just a wrapper giving a print method
  90. # to the SMTP object.
  91.  
  92. my %opts = MIME::Lite::__opts(\%args, @_net_smtp_tls_opts);
  93. my $smtp = MIME::Lite::SMTP::TLS->new($hostname, %opts);
  94.  
  95. $smtp->mail($args{From});
  96. $smtp->recipient(@{$args{To}});
  97. $smtp->data();
  98. $self->print_for_smtp($smtp);
  99. $smtp->dataend();
  100. $smtp->quit;
  101.  
  102. return $self->{last_send_successful} = 1;
  103. }
  104.  
  105.  
  106. package MIME::Lite::SMTP::TLS;
  107.  
  108. #============================================================
  109. # This class just adds a print() method to Net::SMTP.
  110. # Notice that we don't use/require it until it's needed!
  111.  
  112. use strict;
  113. use warnings;
  114. use parent 'Net::SMTP::TLS';
  115.  
  116. sub print {
  117. my $smtp = shift;
  118. $MIME::Lite::DEBUG and MIME::Lite::SMTP::_hexify(join("", @_));
  119. $smtp->datasend(@_);
  120. }
  121.  
  122.  
  123. 1;
Add Comment
Please, Sign In to add comment