[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" <KMcGrail at 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;
}