Revision 5896d8bf
Von Moritz Bunkus vor etwa 12 Jahren hinzugefügt
SL/Mailer.pm | ||
---|---|---|
52 | 52 |
bless $self, $type; |
53 | 53 |
} |
54 | 54 |
|
55 |
sub _create_driver { |
|
56 |
my ($self) = @_; |
|
57 |
|
|
58 |
my %params = ( |
|
59 |
mailer => $self, |
|
60 |
form => $::form, |
|
61 |
myconfig => \%::myconfig, |
|
62 |
); |
|
63 |
|
|
64 |
my $cfg = $::lx_office_conf{mail_delivery}; |
|
65 |
if (($cfg->{method} || 'smtp') ne 'smtp') { |
|
66 |
require SL::Mailer::Sendmail; |
|
67 |
return SL::Mailer::Sendmail->new(%params); |
|
68 |
} else { |
|
69 |
require SL::Mailer::SMTP; |
|
70 |
return SL::Mailer::SMTP->new(%params); |
|
71 |
} |
|
72 |
} |
|
73 |
|
|
55 | 74 |
sub mime_quote_text { |
56 | 75 |
$main::lxdebug->enter_sub(); |
57 | 76 |
|
... | ... | |
99 | 118 |
|
100 | 119 |
my ($self) = @_; |
101 | 120 |
|
102 |
local (*IN, *OUT);
|
|
121 |
local (*IN); |
|
103 | 122 |
|
104 | 123 |
$num_sent++; |
105 | 124 |
my $boundary = time() . "-$$-${num_sent}"; |
... | ... | |
111 | 130 |
my $form = $main::form; |
112 | 131 |
my $myconfig = \%main::myconfig; |
113 | 132 |
|
114 |
my $email = $self->recode($myconfig->{email}); |
|
115 |
$email =~ s/[^\w\.\-\+=@]//ig; |
|
116 |
|
|
117 |
my %temp_form = ( %{ $form }, 'myconfig_email' => $email ); |
|
118 |
my $template = SL::Template::create(type => 'PlainText', form => \%temp_form); |
|
119 |
my $sendmail = $template->parse_block($::lx_office_conf{applications}->{sendmail}); |
|
120 |
|
|
121 |
if (!open(OUT, "|$sendmail")) { |
|
133 |
my $driver = eval { $self->_create_driver }; |
|
134 |
if (!$driver) { |
|
122 | 135 |
$main::lxdebug->leave_sub(); |
123 |
return "$sendmail : $!";
|
|
136 |
return "send email : $@";
|
|
124 | 137 |
} |
125 | 138 |
|
126 | 139 |
$self->{charset} ||= Common::DEFAULT_CHARSET; |
... | ... | |
137 | 150 |
|
138 | 151 |
$self->{from} = $self->recode($self->{from}); |
139 | 152 |
|
153 |
my %addresses; |
|
140 | 154 |
my $headers = ''; |
141 | 155 |
foreach my $item (qw(from to cc bcc)) { |
156 |
$addresses{$item} = []; |
|
142 | 157 |
next unless ($self->{$item}); |
158 |
|
|
143 | 159 |
my (@addr_objects) = Email::Address->parse($self->{$item}); |
144 | 160 |
next unless (scalar @addr_objects); |
145 | 161 |
|
146 | 162 |
foreach my $addr_obj (@addr_objects) { |
163 |
push @{ $addresses{$item} }, $addr_obj->address; |
|
147 | 164 |
my $phrase = $addr_obj->phrase(); |
148 | 165 |
if ($phrase) { |
149 | 166 |
$phrase =~ s/^\"//; |
... | ... | |
151 | 168 |
$addr_obj->phrase($self->mime_quote_text($phrase)); |
152 | 169 |
} |
153 | 170 |
|
154 |
$headers .= sprintf("%s: %s\n", ucfirst($item), $addr_obj->format()); |
|
171 |
$headers .= sprintf("%s: %s\n", ucfirst($item), $addr_obj->format()) unless $driver->keep_from_header($item);
|
|
155 | 172 |
} |
156 | 173 |
} |
157 | 174 |
|
158 | 175 |
$headers .= sprintf("Subject: %s\n", $self->mime_quote_text($self->recode($self->{subject}), 60)); |
159 | 176 |
|
160 |
print OUT qq|${headers}Message-ID: <$msgid> |
|
177 |
$driver->start_mail(from => $self->{from}, to => [ map { @{ $addresses{$_} } } qw(to cc bcc) ]); |
|
178 |
|
|
179 |
$driver->print(qq|${headers}Message-ID: <$msgid> |
|
161 | 180 |
X-Mailer: Lx-Office $self->{version} |
162 | 181 |
MIME-Version: 1.0 |
163 |
|; |
|
182 |
|);
|
|
164 | 183 |
|
165 | 184 |
if ($self->{attachments}) { |
166 |
print OUT qq|Content-Type: multipart/mixed; boundary="$boundary" |
|
167 |
|
|
168 |
|; |
|
185 |
$driver->print(qq|Content-Type: multipart/mixed; boundary="$boundary"\n\n|); |
|
169 | 186 |
if ($self->{message}) { |
170 |
print OUT qq|--${boundary}
|
|
187 |
$driver->print(qq|--${boundary}
|
|
171 | 188 |
Content-Type: $self->{contenttype}; charset="$self->{charset}" |
172 | 189 |
|
173 | 190 |
| . $self->recode($self->{message}) . qq| |
174 | 191 |
|
175 |
|; |
|
192 |
|);
|
|
176 | 193 |
} |
177 | 194 |
|
178 | 195 |
foreach my $attachment (@{ $self->{attachments} }) { |
... | ... | |
195 | 212 |
|
196 | 213 |
open(IN, $attachment); |
197 | 214 |
if ($?) { |
198 |
close(OUT); |
|
199 | 215 |
$main::lxdebug->leave_sub(); |
200 | 216 |
return "$attachment : $!"; |
201 | 217 |
} |
... | ... | |
207 | 223 |
$attachment_charset = qq|; charset="$self->{charset}" |; |
208 | 224 |
} |
209 | 225 |
|
210 |
print OUT qq|--${boundary}
|
|
226 |
$driver->print(qq|--${boundary}
|
|
211 | 227 |
Content-Type: ${content_type}; name="$filename"$attachment_charset |
212 | 228 |
Content-Transfer-Encoding: BASE64 |
213 |
Content-Disposition: attachment; filename="$filename"\n\n|; |
|
229 |
Content-Disposition: attachment; filename="$filename"\n\n|);
|
|
214 | 230 |
|
215 | 231 |
my $msg = ""; |
216 | 232 |
while (<IN>) { |
217 | 233 |
; |
218 | 234 |
$msg .= $_; |
219 | 235 |
} |
220 |
print OUT &encode_base64($msg);
|
|
236 |
$driver->print(encode_base64($msg));
|
|
221 | 237 |
|
222 | 238 |
close(IN); |
223 | 239 |
|
224 | 240 |
} |
225 |
print OUT qq|--${boundary}--\n|;
|
|
241 |
$driver->print(qq|--${boundary}--\n|);
|
|
226 | 242 |
|
227 | 243 |
} else { |
228 |
print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"
|
|
244 |
$driver->print(qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"
|
|
229 | 245 |
|
230 | 246 |
| . $self->recode($self->{message}) . qq| |
231 |
|; |
|
247 |
|);
|
|
232 | 248 |
} |
233 | 249 |
|
234 |
close(OUT);
|
|
250 |
$driver->send;
|
|
235 | 251 |
|
236 | 252 |
$main::lxdebug->leave_sub(); |
237 | 253 |
|
... | ... | |
274 | 290 |
} |
275 | 291 |
|
276 | 292 |
1; |
277 |
|
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 |
sub init { |
|
13 |
my ($self) = @_; |
|
14 |
|
|
15 |
Rose::Object::init(@_); |
|
16 |
|
|
17 |
my $cfg = $::lx_office_conf{mail_delivery} || {}; |
|
18 |
$self->{security} = lc($cfg->{security} || 'none'); |
|
19 |
|
|
20 |
if ($self->{security} eq 'tls') { |
|
21 |
require Net::SMTP::TLS; |
|
22 |
my %params; |
|
23 |
if ($cfg->{login}) { |
|
24 |
$params{User} = $cfg->{user}; |
|
25 |
$params{Password} = $cfg->{password}; |
|
26 |
} |
|
27 |
$self->{smtp} = Net::SMTP::TLS->new($cfg->{host} || 'localhost', Port => $cfg->{port} || 25, %params); |
|
28 |
|
|
29 |
} else { |
|
30 |
my $module = $self->{security} eq 'ssl' ? 'Net::SMTP::SSL' : 'Net::SMTP'; |
|
31 |
my $default_port = $self->{security} eq 'ssl' ? 465 : 25; |
|
32 |
eval "require $module" or die $@; |
|
33 |
|
|
34 |
$self->{smtp} = $module->new($cfg->{host} || 'localhost', Port => $cfg->{port} || $default_port); |
|
35 |
$self->{smtp}->auth($cfg->{user}, $cfg->{password}) if $cfg->{login}; |
|
36 |
} |
|
37 |
|
|
38 |
die unless $self->{smtp}; |
|
39 |
} |
|
40 |
|
|
41 |
sub start_mail { |
|
42 |
my ($self, %params) = @_; |
|
43 |
|
|
44 |
$self->{smtp}->mail($params{from}); |
|
45 |
$self->{smtp}->recipient(@{ $params{to} }); |
|
46 |
$self->{smtp}->data; |
|
47 |
} |
|
48 |
|
|
49 |
sub print { |
|
50 |
my $self = shift; |
|
51 |
|
|
52 |
$self->{smtp}->datasend(@_); |
|
53 |
} |
|
54 |
|
|
55 |
sub send { |
|
56 |
my ($self) = @_; |
|
57 |
|
|
58 |
$self->{smtp}->dataend; |
|
59 |
$self->{smtp}->quit; |
|
60 |
delete $self->{smtp}; |
|
61 |
} |
|
62 |
|
|
63 |
sub keep_from_header { |
|
64 |
my ($self, $item) = @_; |
|
65 |
return lc($item) eq 'bcc'; |
|
66 |
} |
|
67 |
|
|
68 |
1; |
SL/Mailer/Sendmail.pm | ||
---|---|---|
1 |
package SL::Mailer::Sendmail; |
|
2 |
|
|
3 |
use strict; |
|
4 |
|
|
5 |
use IO::File; |
|
6 |
use SL::Template; |
|
7 |
|
|
8 |
use parent qw(Rose::Object); |
|
9 |
|
|
10 |
use Rose::Object::MakeMethods::Generic |
|
11 |
( |
|
12 |
scalar => [ qw(myconfig mailer form) ] |
|
13 |
); |
|
14 |
|
|
15 |
sub init { |
|
16 |
my ($self) = @_; |
|
17 |
|
|
18 |
Rose::Object::init(@_); |
|
19 |
|
|
20 |
my $email = $self->mailer->recode($self->myconfig->{email}); |
|
21 |
$email =~ s/[^\w\.\-\+=@]//ig; |
|
22 |
|
|
23 |
my %temp_form = ( %{ $self->form }, myconfig_email => $email ); |
|
24 |
my $template = SL::Template::create(type => 'ShellCommand', form => \%temp_form); |
|
25 |
my $sendmail = $::lx_office_conf{applications}->{sendmail} || $::lx_office_conf{mail_delivery}->{sendmail} || "sendmail -t"; |
|
26 |
$sendmail = $template->parse_block($sendmail); |
|
27 |
|
|
28 |
$self->{sendmail} = IO::File->new("|$sendmail") || die "sendmail($sendmail): $!"; |
|
29 |
} |
|
30 |
|
|
31 |
sub start_mail { |
|
32 |
} |
|
33 |
|
|
34 |
sub print { |
|
35 |
my $self = shift; |
|
36 |
|
|
37 |
$self->{sendmail}->print(@_); |
|
38 |
} |
|
39 |
|
|
40 |
sub send { |
|
41 |
my ($self) = @_; |
|
42 |
$self->{sendmail}->close; |
|
43 |
delete $self->{sendmail}; |
|
44 |
} |
|
45 |
|
|
46 |
sub keep_from_header { |
|
47 |
0; |
|
48 |
} |
|
49 |
|
|
50 |
1; |
config/lx_office.conf.default | ||
---|---|---|
102 | 102 |
# Path to the old memberfile (ignored on new installations) |
103 | 103 |
memberfile = users/members |
104 | 104 |
|
105 |
[applications] |
|
106 |
# Location of sendmail |
|
105 |
[mail_delivery] |
|
106 |
# Delivery method can be 'sendmail' or 'smtp' (the default). For |
|
107 |
# 'method = sendmail' the parameter 'mail_delivery.sendmail' is used |
|
108 |
# as the executable to call. If 'applications.sendmail' still exists |
|
109 |
# (backwards compatibility) then 'applications.sendmail' will be used |
|
110 |
# instead of 'mail_delivery.sendmail'. |
|
111 |
method = smtp |
|
112 |
# Location of sendmail for 'method = sendmail' |
|
107 | 113 |
sendmail = /usr/sbin/sendmail -t<%if myconfig_email%> -f <%myconfig_email%><%end%> |
114 |
# Settings for 'method = smtp'. |
|
115 |
host = localhost |
|
116 |
port = 25 |
|
117 |
# Security can be 'tls', 'ssl' or 'none'. Unset equals 'none'. This |
|
118 |
# determines whether or not encryption is used and which kind. For |
|
119 |
# 'tls' the module 'Net::SMTP::TLS' is required; for 'ssl' |
|
120 |
# 'Net::SMTP::TLS' is required and 'none' only uses 'Net::SMTP'. |
|
121 |
security = tls |
|
122 |
# Authentication is only used if 'login' is set. You should only use |
|
123 |
# that with 'tls' or 'ssl' encryption. |
|
124 |
login = |
|
125 |
password = |
|
126 |
|
|
127 |
[applications] |
|
108 | 128 |
# Location of OpenOffice.org writer |
109 | 129 |
openofficeorg_writer = oowriter |
110 | 130 |
# Location of the X virtual frame buffer used for OpenOffice |
Auch abrufbar als: Unified diff
E-Mails auch per SMTP verschicken können
Default ist nun, via SMTP über localhost zu verschicken. Mögliche
Optionen sind: TLS oder SSL-Verschlüsselung, Authentifizierung,
Verwendung von Sendmail anstelle von SMTP (wie bisher).
Dokumentation folgt morgen.