line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MIME::Decoder::NBit; |
2
|
13
|
|
|
13
|
|
47
|
use strict; |
|
13
|
|
|
|
|
14
|
|
|
13
|
|
|
|
|
382
|
|
3
|
13
|
|
|
13
|
|
46
|
use warnings; |
|
13
|
|
|
|
|
15
|
|
|
13
|
|
|
|
|
584
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
MIME::Decoder::NBit - encode/decode a "7bit" or "8bit" stream |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 SYNOPSIS |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
A generic decoder object; see L for usage. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 DESCRIPTION |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
This is a MIME::Decoder subclass for the C<7bit> and C<8bit> content |
19
|
|
|
|
|
|
|
transfer encodings. These are not "encodings" per se: rather, they |
20
|
|
|
|
|
|
|
are simply assertions of the content of the message. |
21
|
|
|
|
|
|
|
From RFC-2045 Section 6.2.: |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Three transformations are currently defined: identity, the "quoted- |
24
|
|
|
|
|
|
|
printable" encoding, and the "base64" encoding. The domains are |
25
|
|
|
|
|
|
|
"binary", "8bit" and "7bit". |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
The Content-Transfer-Encoding values "7bit", "8bit", and "binary" all |
28
|
|
|
|
|
|
|
mean that the identity (i.e. NO) encoding transformation has been |
29
|
|
|
|
|
|
|
performed. As such, they serve simply as indicators of the domain of |
30
|
|
|
|
|
|
|
the body data, and provide useful information about the sort of |
31
|
|
|
|
|
|
|
encoding that might be needed for transmission in a given transport |
32
|
|
|
|
|
|
|
system. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
In keeping with this: as of MIME-tools 4.x, |
35
|
|
|
|
|
|
|
I |
36
|
|
|
|
|
|
|
all it does is attempt to I of the 7bit/8bit assertion, |
37
|
|
|
|
|
|
|
and issue a warning (one per message) if any are found. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head2 Legal 7bit data |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
RFC-2045 Section 2.7 defines legal C<7bit> data: |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
"7bit data" refers to data that is all represented as relatively |
45
|
|
|
|
|
|
|
short lines with 998 octets or less between CRLF line separation |
46
|
|
|
|
|
|
|
sequences [RFC-821]. No octets with decimal values greater than 127 |
47
|
|
|
|
|
|
|
are allowed and neither are NULs (octets with decimal value 0). CR |
48
|
|
|
|
|
|
|
(decimal value 13) and LF (decimal value 10) octets only occur as |
49
|
|
|
|
|
|
|
part of CRLF line separation sequences. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 Legal 8bit data |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
RFC-2045 Section 2.8 defines legal C<8bit> data: |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
"8bit data" refers to data that is all represented as relatively |
57
|
|
|
|
|
|
|
short lines with 998 octets or less between CRLF line separation |
58
|
|
|
|
|
|
|
sequences [RFC-821]), but octets with decimal values greater than 127 |
59
|
|
|
|
|
|
|
may be used. As with "7bit data" CR and LF octets only occur as part |
60
|
|
|
|
|
|
|
of CRLF line separation sequences and no NULs are allowed. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head2 How decoding is done |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
The B does a line-by-line pass-through from input to output, |
66
|
|
|
|
|
|
|
leaving the data unchanged I that an end-of-line sequence of |
67
|
|
|
|
|
|
|
CRLF is converted to a newline "\n". Given the line-oriented nature |
68
|
|
|
|
|
|
|
of 7bit and 8bit, this seems relatively sensible. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 How encoding is done |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
The B does a line-by-line pass-through from input to output, |
74
|
|
|
|
|
|
|
and simply attempts to I violations of the C<7bit>/C<8bit> |
75
|
|
|
|
|
|
|
domain. The default action is to warn once per encoding if violations |
76
|
|
|
|
|
|
|
are detected; the warnings may be silenced with the QUIET configuration |
77
|
|
|
|
|
|
|
of L. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head1 SEE ALSO |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
L |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 AUTHOR |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Eryq (F), ZeeGee Software Inc (F). |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
All rights reserved. This program is free software; you can redistribute |
89
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=cut |
92
|
|
|
|
|
|
|
|
93
|
13
|
|
|
13
|
|
45
|
use vars qw(@ISA $VERSION); |
|
13
|
|
|
|
|
14
|
|
|
13
|
|
|
|
|
632
|
|
94
|
|
|
|
|
|
|
|
95
|
13
|
|
|
13
|
|
53
|
use MIME::Decoder; |
|
13
|
|
|
|
|
14
|
|
|
13
|
|
|
|
|
256
|
|
96
|
13
|
|
|
13
|
|
42
|
use MIME::Tools qw(:msgs); |
|
13
|
|
|
|
|
15
|
|
|
13
|
|
|
|
|
5319
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
@ISA = qw(MIME::Decoder); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
### The package version, both in 1.23 style *and* usable by MakeMaker: |
101
|
|
|
|
|
|
|
$VERSION = "5.509"; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
### How many bytes to decode at a time? |
104
|
|
|
|
|
|
|
my $DecodeChunkLength = 8 * 1024; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
#------------------------------ |
107
|
|
|
|
|
|
|
# |
108
|
|
|
|
|
|
|
# decode_it IN, OUT |
109
|
|
|
|
|
|
|
# |
110
|
|
|
|
|
|
|
sub decode_it { |
111
|
58
|
|
|
58
|
1
|
72
|
my ($self, $in, $out) = @_; |
112
|
58
|
|
|
|
|
197
|
my $and_also; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
### Allocate a buffer suitable for a chunk and a line: |
115
|
58
|
|
|
|
|
458
|
local $_ = (' ' x ($DecodeChunkLength + 1024)); $_ = ''; |
|
58
|
|
|
|
|
84
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
### Get chunks until done: |
118
|
58
|
|
|
|
|
280
|
while ($in->read($_, $DecodeChunkLength)) { |
119
|
56
|
|
|
|
|
2046
|
$and_also = $in->getline; |
120
|
56
|
50
|
|
|
|
1297
|
$_ .= $and_also if defined($and_also); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
### Just got a chunk ending in a line. |
123
|
56
|
|
|
|
|
92
|
s/\015\012$/\n/g; |
124
|
56
|
|
|
|
|
132
|
$out->print($_); |
125
|
|
|
|
|
|
|
} |
126
|
58
|
|
|
|
|
888
|
1; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
#------------------------------ |
130
|
|
|
|
|
|
|
# |
131
|
|
|
|
|
|
|
# encode_it IN, OUT |
132
|
|
|
|
|
|
|
# |
133
|
|
|
|
|
|
|
sub encode_it { |
134
|
31
|
|
|
31
|
1
|
36
|
my ($self, $in, $out) = @_; |
135
|
31
|
|
|
|
|
27
|
my $saw_8bit = 0; ### warn them ONCE PER ENCODING if 8-bit data exists |
136
|
31
|
|
|
|
|
24
|
my $saw_long = 0; ### warn them ONCE PER ENCODING if long lines exist |
137
|
31
|
|
|
|
|
52
|
my $seven_bit = ($self->encoding eq '7bit'); ### 7bit? |
138
|
|
|
|
|
|
|
|
139
|
31
|
|
|
|
|
30
|
my $line; |
140
|
31
|
|
|
|
|
625
|
while (defined($line = $in->getline)) { |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
### Whine if encoding is 7bit and it has 8-bit data: |
143
|
401
|
100
|
100
|
|
|
13415
|
if ($seven_bit && ($line =~ /[\200-\377]/)) { ### oops! saw 8-bit data! |
144
|
1
|
50
|
|
|
|
5
|
whine "saw 8-bit data while encoding 7bit" unless $saw_8bit++; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
### Whine if long lines detected: |
148
|
401
|
100
|
|
|
|
524
|
if (length($line) > 998) { |
149
|
2
|
50
|
|
|
|
17
|
whine "saw long line while encoding 7bit/8bit" unless $saw_long++; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
### Output! |
153
|
401
|
|
|
|
|
636
|
$out->print($line); |
154
|
|
|
|
|
|
|
} |
155
|
31
|
|
|
|
|
1165
|
1; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
1; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
|