X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FI18N.pm;h=bc267e43869d805b4f9094352dc7c7f68b99ac79;hp=79c3e8a15f22cfdacb3421746de1e3df21639ba9;hb=e9e0cf0989259b94d9758eceff448666a2e5a5cc;hpb=2041a9143fac20b79ead4a1ae01224dedf5b27c2

diff --git a/rt/lib/RT/I18N.pm b/rt/lib/RT/I18N.pm
index 79c3e8a15..bc267e438 100644
--- a/rt/lib/RT/I18N.pm
+++ b/rt/lib/RT/I18N.pm
@@ -1,26 +1,51 @@
-# BEGIN LICENSE BLOCK
-# 
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-# 
-# (Except where explictly superceded by other copyright notices)
-# 
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
-# 
-# 
-# END LICENSE BLOCK
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
 =head1 NAME
 
 RT::I18N - a base class for localization of RT
@@ -30,23 +55,21 @@ RT::I18N - a base class for localization of RT
 package RT::I18N;
 
 use strict;
+use warnings;
+
+
 use Locale::Maketext 1.04;
 use Locale::Maketext::Lexicon 0.25;
-use base ('Locale::Maketext::Fuzzy');
-use vars qw( %Lexicon );
+use base 'Locale::Maketext::Fuzzy';
 
-#If we're running on 5.6, we desperately need Encode::compat. But if we're on 5.8, we don't really need it.
-BEGIN { if ($] < 5.007001) {
-require Encode::compat;
-} }
 use Encode;
-
 use MIME::Entity;
 use MIME::Head;
+use File::Glob;
 
 # I decree that this project's first language is English.
 
-%Lexicon = (
+our %Lexicon = (
    'TEST_STRING' => 'Concrete Mixer',
 
     '__Content-Type' => 'text/plain; charset=utf-8',
@@ -66,59 +89,69 @@ use MIME::Head;
 
 Initializes the lexicons used for localization.
 
-=begin testing
-
-use_ok (RT::I18N);
-ok(RT::I18N->Init);
-
-=end testing
 
 =cut
 
 sub Init {
+
+    my @lang = RT->Config->Get('LexiconLanguages');
+    @lang = ('*') unless @lang;
+
+    # load default functions
+    require substr(__FILE__, 0, -3) . '/i_default.pm';
+
     # Load language-specific functions
-    foreach my $language ( glob(substr(__FILE__, 0, -3) . "/*.pm")) {
-        if ($language =~ /^([-\w.\/\\~:]+)$/) {
-            require $1;
+    foreach my $file ( File::Glob::bsd_glob(substr(__FILE__, 0, -3) . "/*.pm") ) {
+        unless ( $file =~ /^([-\w\s\.\/\\~:]+)$/ ) {
+            warn("$file is tainted. not loading");
+            next;
         }
-        else {
-	    warn("$language is tainted. not loading");
-        } 
+        $file = $1;
+
+        my ($lang) = ($file =~ /([^\\\/]+?)\.pm$/);
+        next unless grep $_ eq '*' || $_ eq $lang, @lang;
+        require $file;
     }
 
-    my @lang = @RT::LexiconLanguages;
-    @lang = ('*') unless @lang;
+    my %import;
+    foreach my $l ( @lang ) {
+        $import{$l} = [
+            Gettext => $RT::LexiconPath."/$l.po",
+        ];
+        push @{ $import{$l} }, map {(Gettext => "$_/$l.po")} RT->PluginDirs('po');
+        push @{ $import{$l} }, (Gettext => $RT::LocalLexiconPath."/*/$l.po",
+                                Gettext => $RT::LocalLexiconPath."/$l.po");
+    }
 
     # Acquire all .po files and iterate them into lexicons
-    Locale::Maketext::Lexicon->import({
-	_decode	=> 1, map {
-	    $_	=> [
-		Gettext => (substr(__FILE__, 0, -3) . "/$_.po"),
-		Gettext => "$RT::LocalLexiconPath/*/$_.po",
-	    ],
-	} @lang
-    });
+    Locale::Maketext::Lexicon->import({ _decode => 1, %import });
 
     return 1;
 }
 
+sub LoadLexicons {
+
+    no strict 'refs';
+    foreach my $k (keys %{RT::I18N::} ) {
+        next if $k eq 'main::';
+        next unless index($k, '::', -2) >= 0;
+        next unless exists ${ 'RT::I18N::'. $k }{'Lexicon'};
+
+        my $lex = *{ ${'RT::I18N::'. $k }{'Lexicon'} }{HASH};
+        # run fetch to force load
+        my $tmp = $lex->{'foo'};
+        # XXX: untie may fail with "untie attempted
+        # while 1 inner references still exist"
+        # TODO: untie that has to lower fetch impact
+        # untie %$lex if tied %$lex;
+    }
+}
+
 =head2 encoding
 
 Returns the encoding of the current lexicon, as yanked out of __ContentType's "charset" field.
 If it can't find anything, it returns 'ISO-8859-1'
 
-=begin testing
-
-ok(my $chinese = RT::I18N->get_handle('zh_tw'));
-ok(UNIVERSAL::can($chinese, 'maketext'));
-ok($chinese->maketext('__Content-Type') =~ /utf-8/i, "Found the utf-8 charset for traditional chinese in the string ".$chinese->maketext('__Content-Type'));
-ok($chinese->encoding eq 'utf-8', "The encoding is 'utf-8' -".$chinese->encoding);
-
-ok(my $en = RT::I18N->get_handle('en'));
-ok(UNIVERSAL::can($en, 'maketext'));
-ok($en->encoding eq 'utf-8', "The encoding ".$en->encoding." is 'utf-8'");
-
-=end testing
 
 
 =cut
@@ -126,11 +159,10 @@ ok($en->encoding eq 'utf-8', "The encoding ".$en->encoding." is 'utf-8'");
 
 sub encoding { 'utf-8' }
 
-# {{{ SetMIMEEntityToUTF8
 
 =head2 SetMIMEEntityToUTF8 $entity
 
-An utility method which will try to convert entity body into utf8.
+An utility function which will try to convert entity body into utf8.
 It's now a wrap-up of SetMIMEEntityToEncoding($entity, 'utf-8').
 
 =cut
@@ -139,83 +171,85 @@ sub SetMIMEEntityToUTF8 {
     RT::I18N::SetMIMEEntityToEncoding(shift, 'utf-8');
 }
 
-# }}}
 
-# {{{ SetMIMEEntityToEncoding
+
+=head2 IsTextualContentType $type
+
+An utility function that determines whether $type is I<textual>, meaning
+that it can sensibly be converted to Unicode text.
+
+Currently, it returns true iff $type matches this regular expression
+(case-insensitively):
+
+    ^(?:text/(?:plain|html)|message/rfc822)\b
+
+
+=cut
+
+sub IsTextualContentType {
+    my $type = shift;
+    ($type =~ m{^(?:text/(?:plain|html)|message/rfc822)\b}i) ? 1 : 0;
+}
+
 
 =head2 SetMIMEEntityToEncoding $entity, $encoding
 
-An utility method which will try to convert entity body into specified
+An utility function which will try to convert entity body into specified
 charset encoding (encoded as octets, *not* unicode-strings).  It will
 iterate all the entities in $entity, and try to convert each one into
 specified charset if whose Content-Type is 'text/plain'.
 
-This method doesn't return anything meaningful.
+This function doesn't return anything meaningful.
 
 =cut
 
 sub SetMIMEEntityToEncoding {
     my ( $entity, $enc, $preserve_words ) = ( shift, shift, shift );
 
-    #if ( $entity->is_multipart ) {
-    #$RT::Logger->crit("This entity is a multipart " . $entity->head->as_string);
-	SetMIMEEntityToEncoding( $_, $enc, $preserve_words ) foreach $entity->parts;
-    #}
+    # do the same for parts first of all
+    SetMIMEEntityToEncoding( $_, $enc, $preserve_words ) foreach $entity->parts;
 
-    my $charset = _FindOrGuessCharset($entity) or return;
-    # one and only normalization
-    $charset = 'utf-8' if $charset =~ /^utf-?8$/i;
-    $enc     = 'utf-8' if $enc     =~ /^utf-?8$/i;
+    my $head = $entity->head;
+
+    my $charset = _FindOrGuessCharset($entity);
+    if ( $charset ) {
+        unless( Encode::find_encoding($charset) ) {
+            $RT::Logger->warning("Encoding '$charset' is not supported");
+            $charset = undef;
+        }
+    }
+    unless ( $charset ) {
+        $head->replace( "X-RT-Original-Content-Type" => $head->mime_attr('Content-Type') );
+        $head->mime_attr('Content-Type' => 'application/octet-stream');
+        return;
+    }
 
     SetMIMEHeadToEncoding(
-	$entity->head,
+	$head,
 	_FindOrGuessCharset($entity, 1) => $enc,
 	$preserve_words
     );
 
-    my $head = $entity->head;
-
-    # convert at least MIME word encoded attachment filename
-    foreach my $attr (qw(content-type.name content-disposition.filename)) {
-	if ( my $name = $head->mime_attr($attr) and !$preserve_words ) {
-	    $head->mime_attr( $attr => DecodeMIMEWordsToUTF8($name) );
-	}
-    }
-
     # If this is a textual entity, we'd need to preserve its original encoding
-    $head->add( "X-RT-Original-Encoding" => $charset )
-	if $head->mime_attr('content-type.charset') or $head->mime_type =~ /^text/;
-
+    $head->replace( "X-RT-Original-Encoding" => $charset )
+	if $head->mime_attr('content-type.charset') or IsTextualContentType($head->mime_type);
 
-    return unless ( $head->mime_type =~ qr{^(text/plain|message/rfc822)$}i  );
-    
+    return unless IsTextualContentType($head->mime_type);
 
     my $body = $entity->bodyhandle;
 
-    if ( $enc ne $charset && $body) {
-	my @lines = $body->as_lines or return;
+    if ( $body && ($enc ne $charset || $enc =~ /^utf-?8(?:-strict)?$/i) ) {
+        my $string = $body->as_string or return;
 
-	# {{{ Convert the body
-	eval {
-	    $RT::Logger->debug("Converting '$charset' to '$enc' for ". $head->mime_type . " - ". $head->get('subject'));
+        $RT::Logger->debug( "Converting '$charset' to '$enc' for "
+              . $head->mime_type . " - "
+              . ( $head->get('subject') || 'Subjectless message' ) );
 
-	    # NOTE:: see the comments at the end of the sub.
-	    Encode::_utf8_off( $lines[$_] ) foreach ( 0 .. $#lines );
-	    Encode::from_to( $lines[$_], $charset => $enc ) for ( 0 .. $#lines );
-	};
+        # NOTE:: see the comments at the end of the sub.
+        Encode::_utf8_off($string);
+        Encode::from_to( $string, $charset => $enc );
 
-	if ($@) {
-	    $RT::Logger->error( "Encoding error: " . $@ . " defaulting to ISO-8859-1 -> UTF-8" );
-	    eval {
-		Encode::from_to( $lines[$_], 'iso-8859-1' => $enc ) foreach ( 0 .. $#lines );
-	    };
-	    if ($@) {
-		$RT::Logger->crit( "Totally failed to convert to utf-8: " . $@ . " I give up" );
-	    }
-	}
-	# }}}
-
-        my $new_body = MIME::Body::InCore->new( \@lines );
+        my $new_body = MIME::Body::InCore->new($string);
 
         # set up the new entity
         $head->mime_attr( "content-type" => 'text/plain' )
@@ -236,9 +270,7 @@ sub SetMIMEEntityToEncoding {
 # Not turning off the UTF-8 flag in the string will prevent the string
 # from conversion.
 
-# }}}
 
-# {{{ DecodeMIMEWordsToUTF8
 
 =head2 DecodeMIMEWordsToUTF8 $raw
 
@@ -256,55 +288,121 @@ tried.  Maybe it's ok now.
 
 sub DecodeMIMEWordsToUTF8 {
     my $str = shift;
-    DecodeMIMEWordsToEncoding($str, 'utf-8');
+    return DecodeMIMEWordsToEncoding($str, 'utf-8', @_);
 }
 
 sub DecodeMIMEWordsToEncoding {
     my $str = shift;
-    my $enc = shift;
-
-   
-    @_ = $str =~ m/([^=]*)=\?([^?]+)\?([QqBb])\?([^?]+)\?=([^=]*)/g;
-
-    return ($str) unless (@_);
-
-    $str = "";
-    while (@_) {
-	my ($prefix, $charset, $encoding, $enc_str, $trailing) =
-	    (shift, shift, shift, shift, shift);
-
-        $trailing =~ s/\s?\t?$//;               # Observed from Outlook Express
-
-	if ($encoding eq 'Q' or $encoding eq 'q') {
-	    use MIME::QuotedPrint;
-	    $enc_str =~ tr/_/ /;		# Observed from Outlook Express
-	    $enc_str = decode_qp($enc_str);
-	} elsif ($encoding eq 'B' or $encoding eq 'b') {
-	    use MIME::Base64;
-	    $enc_str = decode_base64($enc_str);
-	} else {
-	    $RT::Logger->warning("RT::I18N::DecodeMIMEWordsToCharset got a " .
-			      "strange encoding: $encoding.");
-	}
-
-	# now we have got a decoded subject, try to convert into the encoding
-	unless ($charset eq $enc) {
-	    eval { Encode::from_to($enc_str, $charset,  $enc) };
-	    if ($@) {
-		$charset = _GuessCharset( $enc_str );
-		Encode::from_to($enc_str, $charset, $enc);
-	    }
-	}
-
-	$str .= $prefix . $enc_str . $trailing;
+    my $to_charset = _CanonicalizeCharset(shift);
+    my $field = shift || '';
+
+    # handle filename*=ISO-8859-1''%74%E9%73%74%2E%74%78%74, parameter value
+    # continuations, and similar syntax from RFC 2231
+    if ($field =~ /^Content-(Type|Disposition)/i) {
+        # This concatenates continued parameters and normalizes encoded params
+        # to QB encoded-words which we handle below
+        $str = MIME::Field::ParamVal->parse($str)->stringify;
+    }
+
+    # Pre-parse by removing all whitespace between encoded words
+    my $encoded_word = qr/
+                 =\?            # =?
+                 ([^?]+?)       # charset
+                 (?:\*[^?]+)?   # optional '*language'
+                 \?             # ?
+                 ([QqBb])       # encoding
+                 \?             # ?
+                 ([^?]+)        # encoded string
+                 \?=            # ?=
+                 /x;
+    $str =~ s/($encoded_word)\s+(?=$encoded_word)/$1/g;
+
+    # Also merge quoted-printable sections together, in case multiple
+    # octets of a single encoded character were split between chunks.
+    # Though not valid according to RFC 2047, this has been seen in the
+    # wild.
+    1 while $str =~ s/(=\?[^?]+\?[Qq]\?)([^?]+)\?=\1([^?]+)\?=/$1$2$3?=/i;
+
+    # XXX TODO: use decode('MIME-Header', ...) and Encode::Alias to replace our
+    # custom MIME word decoding and charset canonicalization.  We can't do this
+    # until we parse before decode, instead of the other way around.
+    my @list = $str =~ m/(.*?)          # prefix
+                         $encoded_word
+                         ([^=]*)        # trailing
+                        /xgcs;
+
+    if ( @list ) {
+        # add everything that hasn't matched to the end of the latest
+        # string in array this happen when we have 'key="=?encoded?="; key="plain"'
+        $list[-1] .= substr($str, pos $str);
+
+        $str = "";
+        while (@list) {
+            my ($prefix, $charset, $encoding, $enc_str, $trailing) =
+                    splice @list, 0, 5;
+            $charset  = _CanonicalizeCharset($charset);
+            $encoding = lc $encoding;
+
+            $trailing =~ s/\s?\t?$//;               # Observed from Outlook Express
+
+            if ( $encoding eq 'q' ) {
+                use MIME::QuotedPrint;
+                $enc_str =~ tr/_/ /;		# Observed from Outlook Express
+                $enc_str = decode_qp($enc_str);
+            } elsif ( $encoding eq 'b' ) {
+                use MIME::Base64;
+                $enc_str = decode_base64($enc_str);
+            } else {
+                $RT::Logger->warning("Incorrect encoding '$encoding' in '$str', "
+                    ."only Q(uoted-printable) and B(ase64) are supported");
+            }
+
+            # now we have got a decoded subject, try to convert into the encoding
+            if ( $charset ne $to_charset || $charset =~ /^utf-?8(?:-strict)?$/i ) {
+                if ( Encode::find_encoding($charset) ) {
+                    Encode::from_to( $enc_str, $charset, $to_charset );
+                } else {
+                    $RT::Logger->warning("Charset '$charset' is not supported");
+                    $enc_str =~ s/[^[:print:]]/\357\277\275/g;
+                    Encode::from_to( $enc_str, 'UTF-8', $to_charset )
+                        unless $to_charset eq 'utf-8';
+                }
+            }
+
+            # XXX TODO: RT doesn't currently do the right thing with mime-encoded headers
+            # We _should_ be preserving them encoded until after parsing is completed and
+            # THEN undo the mime-encoding.
+            #
+            # This routine should be translating the existing mimeencoding to utf8 but leaving
+            # things encoded.
+            #
+            # It's legal for headers to contain mime-encoded commas and semicolons which
+            # should not be treated as address separators. (Encoding == quoting here)
+            #
+            # until this is fixed, we must escape any string containing a comma or semicolon
+            # this is only a bandaid
+
+            # Some _other_ MUAs encode quotes _already_, and double quotes
+            # confuse us a lot, so only quote it if it isn't quoted
+            # already.
+            $enc_str = qq{"$enc_str"}
+                if $enc_str =~ /[,;]/
+                and $enc_str !~ /^".*"$/
+                and $prefix !~ /"$/ and $trailing !~ /^"/
+                and (!$field || $field =~ /^(?:To$|From$|B?Cc$|Content-)/i);
+
+            $str .= $prefix . $enc_str . $trailing;
+        }
     }
 
+    # We might have \n without trailing whitespace, which will result in
+    # invalid headers.
+    $str =~ s/\n//g;
+
     return ($str)
 }
 
-# }}}
 
-# {{{ _FindOrGuessCharset
 
 =head2 _FindOrGuessCharset MIME::Entity, $head_only
 
@@ -319,24 +417,22 @@ sub _FindOrGuessCharset {
     my $head_only = shift;
     my $head = $entity->head;
 
-    if ($head->mime_attr("content-type.charset")) {
-	return $head->mime_attr("content-type.charset");
+    if ( my $charset = $head->mime_attr("content-type.charset") ) {
+        return _CanonicalizeCharset($charset);
     }
 
-    if ( !$head_only and $head->mime_type =~ m{^text/}) {
-	my $body = $entity->bodyhandle or return;
-	return _GuessCharset( $body->as_string );
+    if ( !$head_only and $head->mime_type =~ m{^text/} ) {
+        my $body = $entity->bodyhandle or return;
+        return _GuessCharset( $body->as_string );
     }
     else {
-	# potentially binary data -- don't guess the body
-	return _GuessCharset( $head->as_string );
+
+        # potentially binary data -- don't guess the body
+        return _GuessCharset( $head->as_string );
     }
 }
 
-# }}}
-
 
-# {{{ _GuessCharset
 
 =head2 _GuessCharset STRING
 
@@ -344,44 +440,111 @@ use Encode::Guess to try to figure it out the string's encoding.
 
 =cut
 
+use constant HAS_ENCODE_GUESS => do { local $@; eval { require Encode::Guess; 1 } };
+use constant HAS_ENCODE_DETECT => do { local $@; eval { require Encode::Detect::Detector; 1 } };
+
 sub _GuessCharset {
-    my $fallback = 'iso-8859-1';
-    my $charset;
-
-    if ( @RT::EmailInputEncodings and eval { require Encode::Guess; 1 } ) {
-	Encode::Guess->set_suspects(@RT::EmailInputEncodings);
-	my $decoder = Encode::Guess->guess( $_[0] );
-
-	if ( ref $decoder ) {
-	    $charset = $decoder->name;
-	    $RT::Logger->debug("Guessed encoding: $charset");
-	    return $charset;
-	}
-	elsif ($decoder =~ /(\S+ or .+)/) {
-	    my %matched = map { $_ => 1 } split(/ or /, $1);
-	    return 'utf-8' if $matched{'utf8'}; # one and only normalization
-
-	    foreach my $suspect (@RT::EmailInputEncodings) {
-		next unless $matched{$suspect};
-		$RT::Logger->debug("Encode::Guess ambiguous ($decoder); using $suspect");
-		$charset = $suspect;
-		last;
-	    }
-	}
-	else {
-	    $RT::Logger->warning("Encode::Guess failed: $decoder; fallback to $fallback");
-	}
+    my $fallback = _CanonicalizeCharset('iso-8859-1');
+
+    # if $_[0] is null/empty, we don't guess its encoding
+    return $fallback
+        unless defined $_[0] && length $_[0];
+
+    my @encodings = RT->Config->Get('EmailInputEncodings');
+    unless ( @encodings ) {
+        $RT::Logger->warning("No EmailInputEncodings set, fallback to $fallback");
+        return $fallback;
+    }
+
+    if ( $encodings[0] eq '*' ) {
+        shift @encodings;
+        if ( HAS_ENCODE_DETECT ) {
+            my $charset = Encode::Detect::Detector::detect( $_[0] );
+            if ( $charset ) {
+                $RT::Logger->debug("Encode::Detect::Detector guessed encoding: $charset");
+                return _CanonicalizeCharset( Encode::resolve_alias( $charset ) );
+            }
+            else {
+                $RT::Logger->debug("Encode::Detect::Detector failed to guess encoding");
+            }
+        }
+        else {
+	    $RT::Logger->error(
+                "You requested to guess encoding, but we couldn't"
+                ." load Encode::Detect::Detector module"
+            );
+        }
+    }
+
+    unless ( @encodings ) {
+        $RT::Logger->warning("No EmailInputEncodings set except '*', fallback to $fallback");
+        return $fallback;
+    }
+
+    unless ( HAS_ENCODE_GUESS ) {
+        $RT::Logger->error("We couldn't load Encode::Guess module, fallback to $fallback");
+        return $fallback;
+    }
+
+    Encode::Guess->set_suspects( @encodings );
+    my $decoder = Encode::Guess->guess( $_[0] );
+    unless ( defined $decoder ) {
+        $RT::Logger->warning("Encode::Guess failed: decoder is undefined; fallback to $fallback");
+        return $fallback;
+    }
+
+    if ( ref $decoder ) {
+        my $charset = $decoder->name;
+        $RT::Logger->debug("Encode::Guess guessed encoding: $charset");
+        return _CanonicalizeCharset( $charset );
+    }
+    elsif ($decoder =~ /(\S+ or .+)/) {
+        my %matched = map { $_ => 1 } split(/ or /, $1);
+        return 'utf-8' if $matched{'utf8'}; # one and only normalization
+
+        foreach my $suspect (RT->Config->Get('EmailInputEncodings')) {
+            next unless $matched{$suspect};
+            $RT::Logger->debug("Encode::Guess ambiguous ($decoder); using $suspect");
+            return _CanonicalizeCharset( $suspect );
+        }
     }
     else {
-	$RT::Logger->warning("Cannot Encode::Guess; fallback to $fallback");
+        $RT::Logger->warning("Encode::Guess failed: $decoder; fallback to $fallback");
     }
 
-    return($charset || $fallback);
+    return $fallback;
 }
 
-# }}}
+=head2 _CanonicalizeCharset NAME
+
+canonicalize charset, return lowercase version.
+special cases are: gb2312 => gbk, utf8 => utf-8
+
+=cut
+
+sub _CanonicalizeCharset {
+    my $charset = lc shift;
+    return $charset unless $charset;
+
+    # Canonicalize aliases if they're known
+    if (my $canonical = Encode::resolve_alias($charset)) {
+        $charset = $canonical;
+    }
+
+    if ( $charset eq 'utf8' || $charset eq 'utf-8-strict' ) {
+        return 'utf-8';
+    }
+    elsif ( $charset eq 'euc-cn' ) {
+        # gbk is superset of gb2312/euc-cn so it's safe
+        return 'gbk';
+        # XXX TODO: gb18030 is an even larger, more permissive superset of gbk,
+        # but needs Encode::HanExtra installed
+    }
+    else {
+        return $charset;
+    }
+}
 
-# {{{ SetMIMEHeadToEncoding
 
 =head2 SetMIMEHeadToEncoding HEAD OLD_CHARSET NEW_CHARSET
 
@@ -395,42 +558,35 @@ all the time
 sub SetMIMEHeadToEncoding {
     my ( $head, $charset, $enc, $preserve_words ) = ( shift, shift, shift, shift );
 
-    $charset = 'utf-8' if $charset eq 'utf8';
-    $enc     = 'utf-8' if $enc     eq 'utf8';
+    $charset = _CanonicalizeCharset($charset);
+    $enc     = _CanonicalizeCharset($enc);
 
     return if $charset eq $enc and $preserve_words;
 
     foreach my $tag ( $head->tags ) {
+        next unless $tag; # seen in wild: headers with no name
         my @values = $head->get_all($tag);
         $head->delete($tag);
         foreach my $value (@values) {
-            if ( $charset ne $enc ) {
-
-                eval {
-                    Encode::_utf8_off($value);
-                    Encode::from_to( $value, $charset => $enc );
-                };
-                if ($@) {
-                    $RT::Logger->error( "Encoding error: " . $@
-                                       . " defaulting to ISO-8859-1 -> UTF-8" );
-                    eval { Encode::from_to( $value, 'iso-8859-1' => $enc ) };
-                    if ($@) {
-                        $RT::Logger->crit( "Totally failed to convert to utf-8: " . $@ . " I give up" );
-                    }
-                }
+            if ( $charset ne $enc || $enc =~ /^utf-?8(?:-strict)?$/i ) {
+                Encode::_utf8_off($value);
+                Encode::from_to( $value, $charset => $enc );
             }
-            $value = DecodeMIMEWordsToEncoding( $value, $enc ) unless $preserve_words;
-            $head->add( $tag, $value );
+            $value = DecodeMIMEWordsToEncoding( $value, $enc, $tag )
+                unless $preserve_words;
+
+            # We intentionally add a leading space when re-adding the
+            # header; Mail::Header strips it before storing, but it
+            # serves to prevent it from "helpfully" canonicalizing
+            # $head->add("Subject", "Subject: foo") into the same as
+            # $head->add("Subject", "foo");
+            $head->add( $tag, " " . $value );
         }
     }
 
 }
-# }}}
 
-eval "require RT::I18N_Vendor";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/I18N_Vendor.pm});
-eval "require RT::I18N_Local";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/I18N_Local.pm});
+RT::Base->_ImportOverlays();
 
 1;  # End of module.