Fix encoding corruption. rt.cpan.org: Bug #7457
encode_qp() since version 3.02 takes up 3 args. Third arg is a flag indicating binary mode. Since the flag meaning is inverted comparing to the MIME::Base64 patch suggested originally, the corresponding MIME-tools patch needs to be modified also. Submitted by: ak2@smr.ru
This commit is contained in:
Martin Blapp
parent
7841f83c76
commit
9125352749
Notes:
svn2git
2021-03-31 03:12:20 +00:00
svn path=/head/; revision=117981
1 changed files with 128 additions and 0 deletions
128
mail/p5-MIME-Tools/files/patch-Decoder-qpencode
Normal file
128
mail/p5-MIME-Tools/files/patch-Decoder-qpencode
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
--- lib/MIME/Decoder/QuotedPrint.pm.orig Wed Aug 25 11:46:45 2004
|
||||
+++ lib/MIME/Decoder/QuotedPrint.pm Wed Aug 25 11:48:27 2004
|
||||
@@ -54,7 +54,7 @@
|
||||
|
||||
use vars qw(@ISA $VERSION);
|
||||
use MIME::Decoder;
|
||||
-use MIME::QuotedPrint 2.03;
|
||||
+use MIME::QuotedPrint 3.03;
|
||||
|
||||
@ISA = qw(MIME::Decoder);
|
||||
|
||||
@@ -63,7 +63,7 @@
|
||||
|
||||
#------------------------------
|
||||
#
|
||||
-# encode_qp_really STRING
|
||||
+# encode_qp_really STRING TEXTUAL_TYPE_FLAG
|
||||
#
|
||||
# Encode QP, and then follow guideline 8 from RFC 2049 (thanks to Denis
|
||||
# N. Antonioli) whereby we make things a little safer for the transport
|
||||
@@ -71,7 +71,7 @@
|
||||
# grow beyond 76 characters!
|
||||
#
|
||||
sub encode_qp_really {
|
||||
- my $enc = encode_qp($_[0]);
|
||||
+ my $enc = encode_qp(shift, undef, not shift);
|
||||
if (length($enc) < 74) {
|
||||
$enc =~ s/^\.$/=2E/g; # force encoding of /^\.$/
|
||||
$enc =~ s/^From /=46rom /g; # force encoding of /^From /
|
||||
@@ -97,10 +97,10 @@
|
||||
# encode_it IN, OUT
|
||||
#
|
||||
sub encode_it {
|
||||
- my ($self, $in, $out) = @_;
|
||||
+ my ($self, $in, $out, $textual_type) = @_;
|
||||
|
||||
while (defined($_ = $in->getline)) {
|
||||
- $out->print(encode_qp_really($_));
|
||||
+ $out->print(encode_qp_really($_, $textual_type));
|
||||
}
|
||||
1;
|
||||
}
|
||||
--- lib/MIME/Decoder.pm.orig Wed Aug 25 11:49:42 2004
|
||||
+++ lib/MIME/Decoder.pm Wed Aug 25 11:50:26 2004
|
||||
@@ -248,14 +248,14 @@
|
||||
=cut
|
||||
|
||||
sub encode {
|
||||
- my ($self, $in, $out) = @_;
|
||||
+ my ($self, $in, $out, $textual_type) = @_;
|
||||
|
||||
### Coerce old-style filehandles to legit objects, and do it!
|
||||
$in = wraphandle($in);
|
||||
$out = wraphandle($out);
|
||||
|
||||
### Invoke back-end method to do the work:
|
||||
- $self->encode_it($in, $out) ||
|
||||
+ $self->encode_it($in, $out, $self->encoding eq 'quoted-printable' ? ($textual_type) : ()) ||
|
||||
die "$ME: ".$self->encoding." encoding failed\n";
|
||||
}
|
||||
|
||||
--- lib/MIME/Entity.pm.orig Wed Aug 25 11:50:54 2004
|
||||
+++ lib/MIME/Entity.pm Wed Aug 25 11:51:25 2004
|
||||
@@ -1853,7 +1853,7 @@
|
||||
|
||||
### Output the body:
|
||||
my $IO = $self->open("r") || die "open body: $!";
|
||||
- $decoder->encode($IO, $out) || return error "encoding failed";
|
||||
+ $decoder->encode($IO, $out, textual_type($self->head->mime_type) ? 1 : 0) || die "encoding failed\n";
|
||||
$IO->close;
|
||||
1;
|
||||
}
|
||||
--- lib/MIME/Decoder/QuotedPrint.pm.orig Thu Aug 26 12:28:37 2004
|
||||
+++ lib/MIME/Decoder/QuotedPrint.pm Thu Aug 26 12:28:26 2004
|
||||
@@ -73,7 +73,7 @@
|
||||
sub encode_qp_really {
|
||||
my $enc = encode_qp(shift, undef, not shift);
|
||||
if (length($enc) < 74) {
|
||||
- $enc =~ s/^\.$/=2E/g; # force encoding of /^\.$/
|
||||
+ $enc =~ s/^\.\n/=2E\n/g; # force encoding of /^\.$/
|
||||
$enc =~ s/^From /=46rom /g; # force encoding of /^From /
|
||||
}
|
||||
$enc;
|
||||
--- t/Misc.t.orig Sun May 21 07:15:26 2000
|
||||
+++ t/Misc.t Thu Aug 26 12:34:27 2004
|
||||
@@ -6,7 +6,7 @@
|
||||
|
||||
# Create checker:
|
||||
my $T = typical ExtUtils::TBone;
|
||||
-$T->begin(7);
|
||||
+$T->begin(12);
|
||||
|
||||
#------------------------------
|
||||
# Bug 971008 from Michael W. Normandin <michael.normandin@csfb.com>:
|
||||
@@ -67,13 +67,29 @@
|
||||
# $res =~ s/\./=2E/go;
|
||||
# $res =~ s/From /=46rom /go;
|
||||
# at the start of encode_qp_really in MIME::Decoder::QuotedPrint?
|
||||
+#
|
||||
+# Textual mode.
|
||||
+{
|
||||
+ use MIME::Decoder::QuotedPrint;
|
||||
+ my $pair;
|
||||
+ foreach $pair (["From me", "=46rom me=\n"],
|
||||
+ [".", ".=\n"], # soft line-break
|
||||
+ [".\n", "=2E\n"], # line-break
|
||||
+ [" From you", " From you=\n"]) {
|
||||
+ my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 1);
|
||||
+ $T->ok_eq($out, $pair->[1],
|
||||
+ "bug 970725-DNA: QP use of RFC2049 guideline 8");
|
||||
+ }
|
||||
+}
|
||||
+# Binary mode
|
||||
{
|
||||
use MIME::Decoder::QuotedPrint;
|
||||
my $pair;
|
||||
- foreach $pair (["From me", "=46rom me"],
|
||||
- [".", "=2E"],
|
||||
- [" From you", " From you"]) {
|
||||
- my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0]);
|
||||
+ foreach $pair (["From me", "=46rom me=\n"],
|
||||
+ [".", ".=\n"], # soft line-break
|
||||
+ [".\n", ".=0A=\n"], # line-break
|
||||
+ [" From you", " From you=\n"]) {
|
||||
+ my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 0);
|
||||
$T->ok_eq($out, $pair->[1],
|
||||
"bug 970725-DNA: QP use of RFC2049 guideline 8");
|
||||
}
|
||||
Loading…
Reference in a new issue