SL/Mailer/SMTP.pm

   1 package SL::Mailer::SMTP;
   2
   3 use strict;
   4
   5 use parent qw(Rose::Object);
   6
   7 use Rose::Object::MakeMethods::Generic
   8 (
   9   scalar => [ qw(myconfig mailer form status extended_status) ]
  10 );
  11
  12 my %security_config = (
  13   none => { require_module => 'Net::SMTP',          package => 'Net::SMTP',      port =>  25 },
  14   tls  => { require_module => 'Net::SSLGlue::SMTP', package => 'Net::SMTP',      port =>  25 },
  15   ssl  => { require_module => 'Net::SMTP::SSL',     package => 'Net::SMTP::SSL', port => 465 },
  16 );
  17
  18 sub init {
  19   my ($self) = @_;
  20
  21   Rose::Object::init(
  22     @_,
  23     status          => 'failed',
  24     extended_status => 'no send attempt made',
  25   );
  26
  27   my $cfg           = $::lx_office_conf{mail_delivery} || {};
  28   $self->{security} = exists $security_config{lc $cfg->{security}} ? lc $cfg->{security} : 'none';
  29   my $sec_cfg       = $security_config{ $self->{security} };
  30
  31   eval "require $sec_cfg->{require_module}" or do {
  32     $self->extended_status("$@");
  33     die $self->extended_status;
  34   };
  35
  36   $self->{smtp} = $sec_cfg->{package}->new($cfg->{host} || 'localhost', Port => $cfg->{port} || $sec_cfg->{port});
  37   if (!$self->{smtp}) {
  38     $self->extended_status('SMTP connection could not be initialized');
  39     die $self->extended_status;
  40   }
  41
  42   if ($self->{security} eq 'tls') {
  43     $self->{smtp}->starttls(SSL_verify_mode => 0) or do {
  44       $self->extended_status("$@");
  45       die $self->extended_status;
  46     };
  47   }
  48
  49   # Backwards compatibility: older Versions used 'user' instead of the
  50   # intended 'login'. Support both.
  51   my $login = $cfg->{login} || $cfg->{user};
  52
  53   return 1 unless $login;
  54
  55   if (!$self->{smtp}->auth($login, $cfg->{password})) {
  56     $self->extended_status('SMTP authentication failed');
  57     die $self->extended_status;
  58   }
  59 }
  60
  61 sub start_mail {
  62   my ($self, %params) = @_;
  63
  64   $self->{smtp}->mail($params{from})         or do { $self->extended_status($self->{smtp}->message); die $self->extended_status; };
  65   $self->{smtp}->recipient(@{ $params{to} }) or do { $self->extended_status($self->{smtp}->message); die $self->extended_status; };
  66   $self->{smtp}->data                        or do { $self->extended_status($self->{smtp}->message); die $self->extended_status; };
  67 }
  68
  69 sub print {
  70   my $self = shift;
  71
  72   # SMTP requires at most 1000 characters per line. Each line must be
  73   # terminated with <CRLF>, meaning \r\n in Perl.
  74
  75   # First, normalize the string by removing all \r in order to fix
  76   # possible wrong combinations like \n\r.
  77   my $str = join '', @_;
  78   $str    =~ s/\r//g;
  79
  80   # Now remove the very last newline so that we don't create a
  81   # superfluous empty line at the very end.
  82   $str =~ s/\n$//;
  83
  84   # Split the string on newlines keeping trailing empty parts. This is
  85   # requires so that input like "Content-Disposition: ..... \n\n" is
  86   # treated correctly. That's also why we had to remove the very last
  87   # \n in the prior step.
  88   my @lines = split /\n/, $str, -1;
  89
  90   # Send each line terminating it with \r\n.
  91   $self->{smtp}->datasend("$_\r\n") for @lines;
  92 }
  93
  94 sub send {
  95   my ($self) = @_;
  96
  97   my $ok = $self->{smtp}->dataend;
  98   $self->extended_status($self->{smtp}->message);
  99   $self->status('ok') if $ok;
 100
 101   $self->{smtp}->quit;
 102
 103   delete $self->{smtp};
 104 }
 105
 106 sub keep_from_header {
 107   my ($self, $item) = @_;
 108   return lc($item) eq 'bcc';
 109 }
 110
 111 1;