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 |
|
|
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.