X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMailer.pm;h=c4cea35f20181affeed2bd1be867520eb4b84bfa;hb=8084ef359515031ec8429b49baf0ab09858f55d2;hp=5123babb936f692c5a43db5073148375c10ce9bb;hpb=5cf977e52788c523150fa19225b90914e6ddc909;p=kivitendo-erp.git diff --git a/SL/Mailer.pm b/SL/Mailer.pm index 5123babb9..c4cea35f2 100644 --- a/SL/Mailer.pm +++ b/SL/Mailer.pm @@ -30,7 +30,16 @@ package Mailer; +use Email::Address; +use Encode; + use SL::Common; +use SL::MIME; +use SL::Template; + +use strict; + +my $num_sent = 0; sub new { $main::lxdebug->enter_sub(); @@ -52,30 +61,29 @@ sub mime_quote_text { my $l_start = length($q_start); my $new_text = "$q_start"; - $chars_left -= $l_start; + $chars_left -= $l_start if (defined $chars_left); for (my $i = 0; $i < length($text); $i++) { my $char = ord(substr($text, $i, 1)); - if (($char < 32) || ($char > 127) || - ($char == ord('?')) || ($char == ord('_'))) { - if ($chars_left < 5) { + if (($char < 32) || ($char > 127) || ($char == ord('?')) || ($char == ord('_'))) { + if ((defined $chars_left) && ($chars_left < 5)) { $new_text .= "?=\n $q_start"; $chars_left = 75 - $l_start; } $new_text .= sprintf("=%02X", $char); - $chars_left -= 3; + $chars_left -= 3 if (defined $chars_left); } else { $char = ord('_') if ($char == ord(' ')); - if ($chars_left < 5) { + if ((defined $chars_left) && ($chars_left < 5)) { $new_text .= "?=\n $q_start"; $chars_left = 75 - $l_start; } $new_text .= chr($char); - $chars_left--; + $chars_left-- if (defined $chars_left); } } @@ -93,38 +101,63 @@ sub send { local (*IN, *OUT); - my $boundary = time; - $boundary = "LxOffice-$self->{version}-$boundary"; - my $domain = $self->{from}; - $domain =~ s/(.*?\@|>)//g; - my $msgid = "$boundary\@$domain"; + $num_sent++; + my $boundary = time() . "-$$-${num_sent}"; + $boundary = "LxOffice-$self->{version}-$boundary"; + my $domain = $self->recode($self->{from}); + $domain =~ s/(.*?\@|>)//g; + my $msgid = "$boundary\@$domain"; + + my $form = $main::form; + my $myconfig = \%main::myconfig; + + my $email = $self->recode($myconfig->{email}); + $email =~ s/[^\w\.\-\+=@]//ig; - $self->{charset} = Common::DEFAULT_CHARSET unless $self->{charset}; + 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, $main::sendmail)) { + if (!open(OUT, "|$sendmail")) { $main::lxdebug->leave_sub(); - return "$main::sendmail : $!"; + return "$sendmail : $!"; } - $self->{contenttype} = "text/plain" unless $self->{contenttype}; - - my ($cc, $bcc); - $cc = "Cc: $self->{cc}\n" if $self->{cc}; - $bcc = "Bcc: $self->{bcc}\n" if $self->{bcc}; + $self->{charset} ||= Common::DEFAULT_CHARSET; + $self->{contenttype} ||= "text/plain"; foreach my $item (qw(to cc bcc)) { + next unless ($self->{$item}); + $self->{$item} = $self->recode($self->{$item}); $self->{$item} =~ s/\</{$item} =~ s/\$<\$/{$item} =~ s/\>/>/g; $self->{$item} =~ s/\$>\$/>/g; } - my $subject = $self->mime_quote_text($self->{subject}, 60); + $self->{from} = $self->recode($self->{from}); + + my $headers = ''; + foreach my $item (qw(from to cc bcc)) { + next unless ($self->{$item}); + my (@addr_objects) = Email::Address->parse($self->{$item}); + next unless (scalar @addr_objects); + + foreach my $addr_obj (@addr_objects) { + my $phrase = $addr_obj->phrase(); + if ($phrase) { + $phrase =~ s/^\"//; + $phrase =~ s/\"$//; + $addr_obj->phrase($self->mime_quote_text($phrase)); + } + + $headers .= sprintf("%s: %s\n", ucfirst($item), $addr_obj->format()); + } + } + + $headers .= sprintf("Subject: %s\n", $self->mime_quote_text($self->recode($self->{subject}), 60)); - print OUT qq|From: $self->{from} -To: $self->{to} -${cc}${bcc}Subject: $subject -Message-ID: <$msgid> + print OUT qq|${headers}Message-ID: <$msgid> X-Mailer: Lx-Office $self->{version} MIME-Version: 1.0 |; @@ -137,7 +170,7 @@ MIME-Version: 1.0 print OUT qq|--${boundary} Content-Type: $self->{contenttype}; charset="$self->{charset}" -$self->{message} +| . $self->recode($self->{message}) . qq| |; } @@ -155,10 +188,10 @@ $self->{message} $filename =~ s/(.*\/|\Q$self->{fileid}\E)//g; } - my $application = - ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) - ? "text" - : "application"; + my $application = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? "text" : "application"; + my $content_type = SL::MIME->mime_type_from_ext($filename); + $content_type = "${application}/$self->{format}" if (!$content_type && $self->{format}); + $content_type ||= 'application/octet-stream'; open(IN, $attachment); if ($?) { @@ -167,8 +200,15 @@ $self->{message} return "$attachment : $!"; } + # only set charset for attachements of type text. every other type should not have this field + # refer to bug 883 for detailed information + my $attachment_charset; + if (lc $application eq 'text' && $self->{charset}) { + $attachment_charset = qq|; charset="$self->{charset}" |; + } + print OUT qq|--${boundary} -Content-Type: $application/$self->{format}; name="$filename"; charset="$self->{charset}" +Content-Type: ${content_type}; name="$filename"$attachment_charset Content-Transfer-Encoding: BASE64 Content-Disposition: attachment; filename="$filename"\n\n|; @@ -187,7 +227,7 @@ Content-Disposition: attachment; filename="$filename"\n\n|; } else { print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}" -$self->{message} +| . $self->recode($self->{message}) . qq| |; } @@ -226,5 +266,12 @@ sub encode_base64 ($;$) { return $res; } +sub recode { + my $self = shift; + my $text = shift; + + return $::locale->is_utf8 ? Encode::encode('utf-8-strict', $text) : $text; +} + 1;