Merge branch 'master' of github.com:kivitendo/kivitendo-erp
[kivitendo-erp.git] / 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) ]
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   my $cfg           = $::lx_office_conf{mail_delivery} || {};
24   $self->{security} = exists $security_config{lc $cfg->{security}} ? lc $cfg->{security} : 'none';
25   my $sec_cfg       = $security_config{ $self->{security} };
26
27   eval "require $sec_cfg->{require_module}" or die "$@";
28
29   $self->{smtp} = $sec_cfg->{package}->new($cfg->{host} || 'localhost', Port => $cfg->{port} || $sec_cfg->{port});
30   die unless $self->{smtp};
31
32   $self->{smtp}->starttls(SSL_verify_mode => 0) || die if $self->{security} eq 'tls';
33
34   return 1 unless $cfg->{login};
35
36   $self->{smtp}->auth($cfg->{user}, $cfg->{password}) or die;
37 }
38
39 sub start_mail {
40   my ($self, %params) = @_;
41
42   $self->{smtp}->mail($params{from});
43   $self->{smtp}->recipient(@{ $params{to} });
44   $self->{smtp}->data;
45 }
46
47 sub print {
48   my $self = shift;
49
50   # SMTP requires at most 1000 characters per line. Each line must be
51   # terminated with <CRLF>, meaning \r\n in Perl.
52
53   # First, normalize the string by removing all \r in order to fix
54   # possible wrong combinations like \n\r.
55   my $str = join '', @_;
56   $str    =~ s/\r//g;
57
58   # Now remove the very last newline so that we don't create a
59   # superfluous empty line at the very end.
60   $str =~ s/\n$//;
61
62   # Split the string on newlines keeping trailing empty parts. This is
63   # requires so that input like "Content-Disposition: ..... \n\n" is
64   # treated correctly. That's also why we had to remove the very last
65   # \n in the prior step.
66   my @lines = split /\n/, $str, -1;
67
68   # Send each line terminating it with \r\n.
69   $self->{smtp}->datasend("$_\r\n") for @lines;
70 }
71
72 sub send {
73   my ($self) = @_;
74
75   $self->{smtp}->dataend;
76   $self->{smtp}->quit;
77   delete $self->{smtp};
78 }
79
80 sub keep_from_header {
81   my ($self, $item) = @_;
82   return lc($item) eq 'bcc';
83 }
84
85 1;