Hallo CPAN,
Die Top-Level-Header sind nicht konform. Es steht dort (Oktette kodiert als UTF-8):
Return-Path: ‰-Test <patrickx.com>
From: ‰-Test <patrickx.com>
Subject: Eine Linkempfehlung von ‰-Test (patrickx.com)
Ja, weil durch encodeURICompenent() im JavaScript bereits UTF-8 bei Perl ankommt!
Es muss aber nach RFC 2047 bspw. so aussehen:
Return-Path: =?UTF-8?B?4oCwLVRlc3Qg?=<patrickx.com>
From: =?UTF-8?B?4oCwLVRlc3Qg?=<patrickx.com>
Subject: =?UTF-8?B?RWluZSBMaW5rZW1wZmVobHVuZyB2b24g4oCwLVRlc3Qg?=(patrickx.com)
Ich weiß es jetzt nach Deinen letzten Hinweisen, aber:
Das erreichst du, wie in meinem ersten Posting geschrieben, mit
Encode::encode('MIME-Header', $subject)
,
Hatten wir ja schon, das ergibt doppeltgemoppeltes Encoding! Warum? Weil die Strings bereits UTF-8 sind, wie erwähnt wegen encodeURIComponent()... Und encode('MIME-header, $foo) wandelt auch in UTF-8 um, alore l'abbiamo, il doppeltes Encoding, il Schei?-Encoding!
Abärre ich habe es jetzt dank Deiner Tipps geschafft, dass alles (Header und Body) in allen Mail-Clients und Webmail-Interfaces, die ich zum Testen habe, korrekt ankommt... Die Lösung: erst UTF-8 decoden, dann MIME-header encoden - und zwar nur die kritischen Header-Teile:
Ohne decode und ohne encode('MIME-header', $from) zeigen GMX und die 1und1 Interfaces bei ‰-Test als gewähltem Sendernamen:
‰-Test
Yahoo und die Windows-Clients zeigten korrekt:
‰-Test
Ohne decode und mit encode('MIME-header', $from) zeigen _alle_ Clients:
â°-Test
Mit decode und mit encode('MIME-header', $from) bringen _alle_ Clients das korrekte Ergebnis, nämlich:
‰-Test
Hier der komplette Code:
#!/usr/bin/perl -w
##### Atomic Eggs #####
BEGIN {
use CGI::Carp qw(carpout);
open(LOG, ">>error") or die;
carpout(*LOG);
}
use strict;
use lib '.';
use CGI;
use MIME::Lite;
use Encode qw(encode decode);
my $cgi = CGI->new();
my $pic = '/pics/sb/ok.gif';
if(scalar($cgi->param())!=8) {
print $cgi->header(-Status => 403); exit
} elsif(length(decode('UTF-8',$cgi->param('sendername'))) > 50 || length(decode('UTF-8',$cgi->param('recipientname'))) > 50 || length(decode('UTF-8',$cgi->param('message'))) > 250) {
print $cgi->header(-Status => 403); exit
} else {
for ($cgi->param('recipientmail'), $cgi->param('sendermail')) {
my $tmp1 = my @tmp1 = split(/\,/, $_); my $tmp2 = my @tmp2 = split(/\\n/, $_);
if ($tmp1> 1 || $tmp2 > 1) { print $cgi->header(-Status => 403); exit }
if ($_ =~ /&b?cc=/i) { print $cgi->header(-Status => 403); exit }
if (length($_) > 100) { print $cgi->header(-Status => 403); exit }
}
}
my $mlVersion = join(" ", MIME::Lite->VERSION, $INC{'MIME/Lite.pm'});
my $sender = $cgi->param('sendername') ? $cgi->param('sendername').' ('.$cgi->param('sendermail').')' : $cgi->param('sendermail');
my $senderForSubjectline = $cgi->param('sendername') ? decode('UTF-8',$cgi->param('sendername')).' ('.$cgi->param('sendermail').')' : $cgi->param('sendermail');
my $from = $cgi->param('sendername') ? decode('UTF-8',$cgi->param('sendername')).' <'.$cgi->param('sendermail').'>' : $cgi->param('sendermail');
my $mailTo = $cgi->param('recipientmail');
my $subject = 'Eine Linkempfehlung von '.$senderForSubjectline;
my $headline1 = $cgi->param('recipientname') ? 'Hallo '.$cgi->param('recipientname').'!' : 'Hallo!';
my $headline2 = $sender.' möchte Ihnen diesen Link empfehlen:';
my $headline3 = $cgi->param('sendername') ? 'Nachricht von '.$cgi->param('sendername').':' : 'Nachricht:';
my $plainTextMessage = $cgi->param('message') ? $headline3.$/.$cgi->param('message') : '------';
my $htmlMessage = $cgi->param('message') ? qq~<h3>$headline3</h3>\n<p>~ . $cgi->param('message') ."</p>" : " ";
my $hlink = $cgi->param('title') ne '' ? '<a href="'.$cgi->param('page').'">'.$cgi->param('title').'</a>' : '<a href="'.$cgi->param('page').'">'.$cgi->param('page').'</a>';
my $note = 'Wichtiger Hinweis: ';
my $disclaimer = 'Die Identität des Absenders dieser E-Mail wurde von Atomic Eggs nicht überprüft.'.$/.'Atomic Eggs stellt lediglich die Schnittstelle zur Verfügung, mit deren Hilfe Internetnutzer Linkempfehlungen an Freunde und Bekannte verschicken können.';
my $plain = $headline1.$/.$/.$headline2.$/.$/.$cgi->param('title').' ('.$cgi->param('page').')'.$/.$/.$plainTextMessage.$/.$/.$/.$note.$disclaimer;
my $html = qq~<body style="font-family:Arial, sans-serif">\n
<h1>$headline1</h1>\n
<h2>$headline2</h2>\n
<p><strong>$hlink</strong></p>\n
<p>$htmlMessage</p>
<p style="margin-top: 100px; font-size:10px"><b>$note</b>$disclaimer</p>
<img src="http://www.atomic-eggs.com/pics/atomicegg.gif"><br>
ML-VERSION: $mlVersion
</body>~;
my $email = MIME::Lite->new( 'Return-Path' => $from,
From => encode('MIME-Header', $from),
To => $cgi->param('recipientmail'),
Subject => encode('MIME-Header', $subject),
Type => 'multipart/mixed',
Encoding => '7bit',
'Auto-Submitted' => 'auto-generated'
);
my $body = MIME::Lite->new( Type => 'multipart/alternative',
Encoding => '8bit'
);
$body->attach( Type => 'text/plain; charset=UTF-8',
Data => $plain
);
$body->attach( Type => 'text/html; charset=UTF-8',
Data => $html
);
$email->attach($body);
$email->send();
returnOk();
sub returnOk {
print "Location: $pic\n\n";
}
Ergebnis:
GMX-Webmailer: OK
Yahoo-Webmailer: OK
1&1-Webmailer alt: OK
1&1-Webmailer neu: OK
Windows Mail: OK
Windows Live Mail: OK
Die schwere Geburt ist Vergangenheit!
Danke Dir nochmals für all die Geduld!
Patrick - wieder nach Italien will!