Revision 5896d8bf
Von Moritz Bunkus vor mehr als 12 Jahren hinzugefügt
SL/Mailer.pm | ||
---|---|---|
bless $self, $type;
|
||
}
|
||
|
||
sub _create_driver {
|
||
my ($self) = @_;
|
||
|
||
my %params = (
|
||
mailer => $self,
|
||
form => $::form,
|
||
myconfig => \%::myconfig,
|
||
);
|
||
|
||
my $cfg = $::lx_office_conf{mail_delivery};
|
||
if (($cfg->{method} || 'smtp') ne 'smtp') {
|
||
require SL::Mailer::Sendmail;
|
||
return SL::Mailer::Sendmail->new(%params);
|
||
} else {
|
||
require SL::Mailer::SMTP;
|
||
return SL::Mailer::SMTP->new(%params);
|
||
}
|
||
}
|
||
|
||
sub mime_quote_text {
|
||
$main::lxdebug->enter_sub();
|
||
|
||
... | ... | |
|
||
my ($self) = @_;
|
||
|
||
local (*IN, *OUT);
|
||
local (*IN);
|
||
|
||
$num_sent++;
|
||
my $boundary = time() . "-$$-${num_sent}";
|
||
... | ... | |
my $form = $main::form;
|
||
my $myconfig = \%main::myconfig;
|
||
|
||
my $email = $self->recode($myconfig->{email});
|
||
$email =~ s/[^\w\.\-\+=@]//ig;
|
||
|
||
my %temp_form = ( %{ $form }, 'myconfig_email' => $email );
|
||
my $template = SL::Template::create(type => 'PlainText', form => \%temp_form);
|
||
my $sendmail = $template->parse_block($::lx_office_conf{applications}->{sendmail});
|
||
|
||
if (!open(OUT, "|$sendmail")) {
|
||
my $driver = eval { $self->_create_driver };
|
||
if (!$driver) {
|
||
$main::lxdebug->leave_sub();
|
||
return "$sendmail : $!";
|
||
return "send email : $@";
|
||
}
|
||
|
||
$self->{charset} ||= Common::DEFAULT_CHARSET;
|
||
... | ... | |
|
||
$self->{from} = $self->recode($self->{from});
|
||
|
||
my %addresses;
|
||
my $headers = '';
|
||
foreach my $item (qw(from to cc bcc)) {
|
||
$addresses{$item} = [];
|
||
next unless ($self->{$item});
|
||
|
||
my (@addr_objects) = Email::Address->parse($self->{$item});
|
||
next unless (scalar @addr_objects);
|
||
|
||
foreach my $addr_obj (@addr_objects) {
|
||
push @{ $addresses{$item} }, $addr_obj->address;
|
||
my $phrase = $addr_obj->phrase();
|
||
if ($phrase) {
|
||
$phrase =~ s/^\"//;
|
||
... | ... | |
$addr_obj->phrase($self->mime_quote_text($phrase));
|
||
}
|
||
|
||
$headers .= sprintf("%s: %s\n", ucfirst($item), $addr_obj->format());
|
||
$headers .= sprintf("%s: %s\n", ucfirst($item), $addr_obj->format()) unless $driver->keep_from_header($item);
|
||
}
|
||
}
|
||
|
||
$headers .= sprintf("Subject: %s\n", $self->mime_quote_text($self->recode($self->{subject}), 60));
|
||
|
||
print OUT qq|${headers}Message-ID: <$msgid>
|
||
$driver->start_mail(from => $self->{from}, to => [ map { @{ $addresses{$_} } } qw(to cc bcc) ]);
|
||
|
||
$driver->print(qq|${headers}Message-ID: <$msgid>
|
||
X-Mailer: Lx-Office $self->{version}
|
||
MIME-Version: 1.0
|
||
|;
|
||
|);
|
||
|
||
if ($self->{attachments}) {
|
||
print OUT qq|Content-Type: multipart/mixed; boundary="$boundary"
|
||
|
||
|;
|
||
$driver->print(qq|Content-Type: multipart/mixed; boundary="$boundary"\n\n|);
|
||
if ($self->{message}) {
|
||
print OUT qq|--${boundary}
|
||
$driver->print(qq|--${boundary}
|
||
Content-Type: $self->{contenttype}; charset="$self->{charset}"
|
||
|
||
| . $self->recode($self->{message}) . qq|
|
||
|
||
|;
|
||
|);
|
||
}
|
||
|
||
foreach my $attachment (@{ $self->{attachments} }) {
|
||
... | ... | |
|
||
open(IN, $attachment);
|
||
if ($?) {
|
||
close(OUT);
|
||
$main::lxdebug->leave_sub();
|
||
return "$attachment : $!";
|
||
}
|
||
... | ... | |
$attachment_charset = qq|; charset="$self->{charset}" |;
|
||
}
|
||
|
||
print OUT qq|--${boundary}
|
||
$driver->print(qq|--${boundary}
|
||
Content-Type: ${content_type}; name="$filename"$attachment_charset
|
||
Content-Transfer-Encoding: BASE64
|
||
Content-Disposition: attachment; filename="$filename"\n\n|;
|
||
Content-Disposition: attachment; filename="$filename"\n\n|);
|
||
|
||
my $msg = "";
|
||
while (<IN>) {
|
||
;
|
||
$msg .= $_;
|
||
}
|
||
print OUT &encode_base64($msg);
|
||
$driver->print(encode_base64($msg));
|
||
|
||
close(IN);
|
||
|
||
}
|
||
print OUT qq|--${boundary}--\n|;
|
||
$driver->print(qq|--${boundary}--\n|);
|
||
|
||
} else {
|
||
print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"
|
||
$driver->print(qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"
|
||
|
||
| . $self->recode($self->{message}) . qq|
|
||
|;
|
||
|);
|
||
}
|
||
|
||
close(OUT);
|
||
$driver->send;
|
||
|
||
$main::lxdebug->leave_sub();
|
||
|
||
... | ... | |
}
|
||
|
||
1;
|
||
|
SL/Mailer/SMTP.pm | ||
---|---|---|
package SL::Mailer::SMTP;
|
||
|
||
use strict;
|
||
|
||
use parent qw(Rose::Object);
|
||
|
||
use Rose::Object::MakeMethods::Generic
|
||
(
|
||
scalar => [ qw(myconfig mailer form) ]
|
||
);
|
||
|
||
sub init {
|
||
my ($self) = @_;
|
||
|
||
Rose::Object::init(@_);
|
||
|
||
my $cfg = $::lx_office_conf{mail_delivery} || {};
|
||
$self->{security} = lc($cfg->{security} || 'none');
|
||
|
||
if ($self->{security} eq 'tls') {
|
||
require Net::SMTP::TLS;
|
||
my %params;
|
||
if ($cfg->{login}) {
|
||
$params{User} = $cfg->{user};
|
||
$params{Password} = $cfg->{password};
|
||
}
|
||
$self->{smtp} = Net::SMTP::TLS->new($cfg->{host} || 'localhost', Port => $cfg->{port} || 25, %params);
|
||
|
||
} else {
|
||
my $module = $self->{security} eq 'ssl' ? 'Net::SMTP::SSL' : 'Net::SMTP';
|
||
my $default_port = $self->{security} eq 'ssl' ? 465 : 25;
|
||
eval "require $module" or die $@;
|
||
|
||
$self->{smtp} = $module->new($cfg->{host} || 'localhost', Port => $cfg->{port} || $default_port);
|
||
$self->{smtp}->auth($cfg->{user}, $cfg->{password}) if $cfg->{login};
|
||
}
|
||
|
||
die unless $self->{smtp};
|
||
}
|
||
|
||
sub start_mail {
|
||
my ($self, %params) = @_;
|
||
|
||
$self->{smtp}->mail($params{from});
|
||
$self->{smtp}->recipient(@{ $params{to} });
|
||
$self->{smtp}->data;
|
||
}
|
||
|
||
sub print {
|
||
my $self = shift;
|
||
|
||
$self->{smtp}->datasend(@_);
|
||
}
|
||
|
||
sub send {
|
||
my ($self) = @_;
|
||
|
||
$self->{smtp}->dataend;
|
||
$self->{smtp}->quit;
|
||
delete $self->{smtp};
|
||
}
|
||
|
||
sub keep_from_header {
|
||
my ($self, $item) = @_;
|
||
return lc($item) eq 'bcc';
|
||
}
|
||
|
||
1;
|
SL/Mailer/Sendmail.pm | ||
---|---|---|
package SL::Mailer::Sendmail;
|
||
|
||
use strict;
|
||
|
||
use IO::File;
|
||
use SL::Template;
|
||
|
||
use parent qw(Rose::Object);
|
||
|
||
use Rose::Object::MakeMethods::Generic
|
||
(
|
||
scalar => [ qw(myconfig mailer form) ]
|
||
);
|
||
|
||
sub init {
|
||
my ($self) = @_;
|
||
|
||
Rose::Object::init(@_);
|
||
|
||
my $email = $self->mailer->recode($self->myconfig->{email});
|
||
$email =~ s/[^\w\.\-\+=@]//ig;
|
||
|
||
my %temp_form = ( %{ $self->form }, myconfig_email => $email );
|
||
my $template = SL::Template::create(type => 'ShellCommand', form => \%temp_form);
|
||
my $sendmail = $::lx_office_conf{applications}->{sendmail} || $::lx_office_conf{mail_delivery}->{sendmail} || "sendmail -t";
|
||
$sendmail = $template->parse_block($sendmail);
|
||
|
||
$self->{sendmail} = IO::File->new("|$sendmail") || die "sendmail($sendmail): $!";
|
||
}
|
||
|
||
sub start_mail {
|
||
}
|
||
|
||
sub print {
|
||
my $self = shift;
|
||
|
||
$self->{sendmail}->print(@_);
|
||
}
|
||
|
||
sub send {
|
||
my ($self) = @_;
|
||
$self->{sendmail}->close;
|
||
delete $self->{sendmail};
|
||
}
|
||
|
||
sub keep_from_header {
|
||
0;
|
||
}
|
||
|
||
1;
|
config/lx_office.conf.default | ||
---|---|---|
# Path to the old memberfile (ignored on new installations)
|
||
memberfile = users/members
|
||
|
||
[applications]
|
||
# Location of sendmail
|
||
[mail_delivery]
|
||
# Delivery method can be 'sendmail' or 'smtp' (the default). For
|
||
# 'method = sendmail' the parameter 'mail_delivery.sendmail' is used
|
||
# as the executable to call. If 'applications.sendmail' still exists
|
||
# (backwards compatibility) then 'applications.sendmail' will be used
|
||
# instead of 'mail_delivery.sendmail'.
|
||
method = smtp
|
||
# Location of sendmail for 'method = sendmail'
|
||
sendmail = /usr/sbin/sendmail -t<%if myconfig_email%> -f <%myconfig_email%><%end%>
|
||
# Settings for 'method = smtp'.
|
||
host = localhost
|
||
port = 25
|
||
# Security can be 'tls', 'ssl' or 'none'. Unset equals 'none'. This
|
||
# determines whether or not encryption is used and which kind. For
|
||
# 'tls' the module 'Net::SMTP::TLS' is required; for 'ssl'
|
||
# 'Net::SMTP::TLS' is required and 'none' only uses 'Net::SMTP'.
|
||
security = tls
|
||
# Authentication is only used if 'login' is set. You should only use
|
||
# that with 'tls' or 'ssl' encryption.
|
||
login =
|
||
password =
|
||
|
||
[applications]
|
||
# Location of OpenOffice.org writer
|
||
openofficeorg_writer = oowriter
|
||
# 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.