| 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
|
|
|
|
|
|
|
|