Re: [Mimedefang] FB Joins? And current copy of code we are using to handle DMARC reject/quarantine domains and mailing lists - Was Re: ADMINISTRIVIA: Yahoo users may not post to this mailing list

[David F. Skoll]

On Thu, 24 Apr 2014 18:08:43 -0400
"Kevin A. McGrail" <kmcgr...@pccc.com> wrote:

> On a related note, anyone know a quick way to handle modifying
> subjects like this so I properly modify it?

> Important Mailing List Notification 
> re:[=?utf-8?B?MjHkuJbnuqropoHkuYjnlLXlrZDllYbliqHvvIzopoHkuYjml6DllYblj6/liqHvvIE=?=]

There is no quick way.  It has to be done correctly.  You need to
un-mime the subject, convert to internal Perl Unicode, modify that
and then re-mime the subject.

Here are a pair of functions from our commercial CanIt product that
I hereby place in the public domain.  You need to "use MIME::Words;" first.

mime_to_utf8 takes MIME-encoded stuff and returns a Perl Unicode string.
utf8_to_mime goes the other way.

Regards,

David.

sub mime_to_utf8
{
        my ($mime_encoded_str) = @_;

        my @array = MIME::Words::decode_mimewords($mime_encoded_str);
        my $ans = '';
        foreach my $thing (@array) {
                # Use default encoding (iso-8859-1 aka Latin-1) 
                # if MIME::Words doesn't detect one.
                my $piece = eval {
                        Encode::decode($thing->[1] || 'iso-8859-1', 
$thing->[0], Encode::FB_PERLQQ)
                };
                if( ! $piece ) {
                        # If decode chokes, just give back the raw version.  It
                        # may be ugly, but it's better than dying
                        warn "Encode::decode() died with: $@";
                        $piece = $mime_encoded_str;
                }
                $ans .= $piece;
        }

        # Ensure internal UTF8 flag is on, even on non-wide
        # characters.
        utf8::upgrade($ans);
        return $ans;
}

sub utf8_to_mime
{
        my ($utf8_str) = @_;
        my $qp_result = MIME::Words::encode_mimeword($utf8_str, 'q', 'UTF-8');
        # If it doesn't make the string too long, return it
        if ($qp_result eq "=?UTF-8?Q?$utf8_str?=") {
                # No unsafe chars!
                return $utf8_str;
        }

        # If the ONLY change was to encode spaces, return original string
        my $encoded_spaces = $utf8_str;
        $encoded_spaces =~ s/ /=20/g;
        if ($qp_result eq "=?UTF-8?Q?$encoded_spaces?=") {
                return $utf8_str;
        }
        $encoded_spaces = $utf8_str;
        $encoded_spaces =~ s/ /_/g;
        if ($qp_result eq "=?UTF-8?Q?$encoded_spaces?=") {
                return $utf8_str;
        }


        # Encode spaces as underscores
        $qp_result =~ s/ /_/g;
        $qp_result =~ s/=20/_/g;
        if (length($qp_result) <= 1.6 * length($utf8_str)) {
                return $qp_result;
        }

        my $b64_result = MIME::Words::encode_mimeword($utf8_str, 'b', 'UTF-8');
        if (length($b64_result) < length($qp_result)) {
                return $b64_result;
        }
        return $qp_result;
}

_______________________________________________
NOTE: If there is a disclaimer or other legal boilerplate in the above
message, it is NULL AND VOID.  You may ignore it.

Visit http://www.mimedefang.org and http://www.roaringpenguin.com
MIMEDefang mailing list MIMEDefang@lists.roaringpenguin.com
http://lists.roaringpenguin.com/mailman/listinfo/mimedefang