From 7734bb7c3e952c3351e454a82181f84dc27544bb Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Tue, 12 Dec 2006 21:15:52 +0000 Subject: [PATCH] Die Subject-Zeile in Mails MIME-konform quoten, da in Mails keine nicht-ASCII-Zeichen (z.B. Umlaute) vorkommen duerfen, vor allem in den Headern nicht. Fix fuer Bugzilla #370. --- SL/Mailer.pm | 48 ++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 46 insertions(+), 2 deletions(-) diff --git a/SL/Mailer.pm b/SL/Mailer.pm index 32e7ca28e..1a377f367 100644 --- a/SL/Mailer.pm +++ b/SL/Mailer.pm @@ -41,6 +41,48 @@ sub new { bless $self, $type; } +sub mime_quote_text { + $main::lxdebug->enter_sub(); + + my ($self, $text, $chars_left) = @_; + + my $q_start = "=?$self->{charset}?Q?"; + my $l_start = length($q_start); + + my $new_text = "$q_start"; + $chars_left -= $l_start; + + for (my $i = 0; $i < length($text); $i++) { + my $char = ord(substr($text, $i, 1)); + + if (($char < 33) || ($char > 127) || + ($char == ord('?')) || ($char == ord(' '))) { + if ($chars_left < 5) { + $new_text .= "?=\n $q_start"; + $chars_left = 75 - $l_start; + } + + $new_text .= sprintf("=%02x", $char); + $chars_left -= 3; + + } else { + if ($chars_left < 5) { + $new_text .= "?=\n $q_start"; + $chars_left = 75 - $l_start; + } + + $new_text .= chr($char); + $chars_left--; + } + } + + $new_text .= "?="; + + $main::lxdebug->leave_sub(); + + return $new_text; +} + sub send { $main::lxdebug->enter_sub(); @@ -52,7 +94,7 @@ sub send { $domain =~ s/(.*?\@|>)//g; my $msgid = "$boundary\@$domain"; - $self->{charset} = "ISO-8859-1" unless $self->{charset}; + $self->{charset} = "ISO-8859-15" unless $self->{charset}; if ($out) { if (!open(OUT, $out)) { @@ -79,9 +121,11 @@ sub send { $self->{$item} =~ s/\$>\$/>/g; } + my $subject = $self->mime_quote_text($self->{subject}, 60); + print OUT qq|From: $self->{from} To: $self->{to} -${cc}${bcc}Subject: $self->{subject} +${cc}${bcc}Subject: $subject Message-ID: <$msgid> X-Mailer: Lx-Office $self->{version} MIME-Version: 1.0 -- 2.20.1