This file is indexed.

/usr/share/perl5/MIME/Parser/Reader.pm is in libmime-tools-perl 5.503-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
package MIME::Parser::Reader;

=head1 NAME

MIME::Parser::Reader - a line-oriented reader for a MIME::Parser


=head1 SYNOPSIS

This module is used internally by MIME::Parser; you probably
don't need to be looking at it at all.  But just in case...

    ### Create a top-level reader, where chunks end at EOF:
    $rdr = MIME::Parser::Reader->new();

    ### Spawn a child reader, where chunks also end at a boundary:
    $subrdr = $rdr->spawn->add_boundary($bound);

    ### Spawn a child reader, where chunks also end at a given string:
    $subrdr = $rdr->spawn->add_terminator($string);

    ### Read until boundary or terminator:
    $subrdr->read_chunk($in, $out);


=head1 DESCRIPTION

A line-oriented reader which can deal with virtual end-of-stream
defined by a collection of boundaries.

B<Warning:> this is a private class solely for use by MIME::Parser.
This class has no official public interface

=cut

use strict;

### All possible end-of-line sequences.
### Note that "" is included because last line of stream may have no newline!
my @EOLs = ("", "\r", "\n", "\r\n", "\n\r");

### Long line:
my $LONGLINE = ' ' x 1000;


#------------------------------
#
# new
#
# I<Class method.>
# Construct an empty (top-level) reader.
#
sub new {
    my ($class) = @_;
    my $eos;
    return bless {
	Bounds => [],
	BH     => {},
	TH     => {},
	EOS    => \$eos,
    }, $class;
}

#------------------------------
#
# spawn
#
# I<Instance method.>
# Return a reader which is mostly a duplicate, except that the EOS
# accumulator is shared.
#
sub spawn {
    my $self = shift;
    my $dup = bless {}, ref($self);
    $dup->{Bounds} = [ @{$self->{Bounds}} ];  ### deep copy
    $dup->{BH}     = { %{$self->{BH}} };      ### deep copy
    $dup->{TH}     = { %{$self->{TH}} };      ### deep copy
    $dup->{EOS}    = $self->{EOS};            ### shallow copy; same ref!
    $dup;
}

#------------------------------
#
# add_boundary BOUND
#
# I<Instance method.>
# Let BOUND be the new innermost boundary.  Returns self.
#
sub add_boundary {
    my ($self, $bound) = @_;
    unshift @{$self->{Bounds}}, $bound;   ### now at index 0
    $self->{BH}{"--$bound"}   = "DELIM $bound";
    $self->{BH}{"--$bound--"} = "CLOSE $bound";
    $self;
}

#------------------------------
#
# add_terminator LINE
#
# I<Instance method.>
# Let LINE be another terminator.  Returns self.
#
sub add_terminator {
    my ($self, $line) = @_;
    foreach (@EOLs) {
	$self->{TH}{"$line$_"} = "DONE $line";
    }
    $self;
}

#------------------------------
#
# has_bounds
#
# I<Instance method.>
# Are there boundaries to contend with?
#
sub has_bounds {
    scalar(@{shift->{Bounds}});
}

#------------------------------
#
# depth
#
# I<Instance method.>
# How many levels are there?
#
sub depth {
    scalar(@{shift->{Bounds}});
}

#------------------------------
#
# eos [EOS]
#
# I<Instance method.>
# Return the last end-of-stream token seen.
# See read_chunk() for what these might be.
#
sub eos {
    my $self = shift;
    ${$self->{EOS}} = $_[0] if @_;
    ${$self->{EOS}};
}

#------------------------------
#
# eos_type [EOSTOKEN]
#
# I<Instance method.>
# Return the high-level type of the given token (defaults to our token).
#
#    DELIM       saw an innermost boundary like --xyz
#    CLOSE       saw an innermost boundary like --xyz--
#    DONE        callback returned false
#    EOF         end of file
#    EXT         saw boundary of some higher-level
#
sub eos_type {
    my ($self, $eos) = @_;
    $eos = $self->eos if (@_ == 1);

    if    ($eos =~ /^(DONE|EOF)/) {
	return $1;
    }
    elsif ($eos =~ /^(DELIM|CLOSE) (.*)$/) {
	return (($2 eq $self->{Bounds}[0]) ? $1 : 'EXT');
    }
    else {
	die("internal error: unable to classify boundary token ($eos)");
    }
}

#------------------------------
#
# native_handle HANDLE
#
# I<Function.>
# Can we do native i/o on HANDLE?  If true, returns the handle
# that will respond to native I/O calls; else, returns undef.
#
sub native_handle {
    my $fh = shift;
    return $fh if ($fh->isa('IO::File') || $fh->isa('IO::Handle'));
    return $fh if (ref $fh eq 'GLOB');
    undef;
}

#------------------------------
#
# read_chunk INHANDLE, OUTHANDLE
#
# I<Instance method.>
# Get lines until end-of-stream.
# Returns the terminating-condition token:
#
#    DELIM xyz   saw boundary line "--xyz"
#    CLOSE xyz   saw boundary line "--xyz--"
#    DONE xyz    saw terminator line "xyz"
#    EOF         end of file

# Parse up to (and including) the boundary, and dump output.
# Follows the RFC 2046 specification, that the CRLF immediately preceding
# the boundary is part of the boundary, NOT part of the input!
#
# NOTE: while parsing bodies, we take care to remember the EXACT end-of-line
# sequence.  This is because we *may* be handling 'binary' encoded data, and
# in that case we can't just massage \r\n into \n!  Don't worry... if the
# data is styled as '7bit' or '8bit', the "decoder" will massage the CRLF
# for us.  For now, we're just trying to chop up the data stream.

# NBK - Oct 12, 1999
# The CRLF at the end of the current line is considered part
# of the boundary.  I buffer the current line and output the
# last.  I strip the last CRLF when I hit the boundary.

sub read_chunk {
    my ($self, $in, $out, $keep_newline, $normalize_newlines) = @_;

    # If we're parsing a preamble or epilogue, we need to keep the blank line
    # that precedes the boundary line.
    $keep_newline ||= 0;

    $normalize_newlines ||= 0;
    ### Init:
    my %bh = %{$self->{BH}};
    my %th = %{$self->{TH}}; my $thx = keys %th;
    local $_ = $LONGLINE;
    my $maybe;
    my $last = '';
    my $eos  = '';

    ### Determine types:
    my $n_in  = native_handle($in);
    my $n_out = native_handle($out);

    ### Handle efficiently by type:
    if ($n_in) {
	if ($n_out) {            ### native input, native output [fastest]
	    while (<$n_in>) {
		# Normalize line ending
		$_ =~ s/(:?\n\r|\r\n|\r)$/\n/ if $normalize_newlines;
		if (substr($_, 0, 2) eq '--') {
		    ($maybe = $_) =~ s/[ \t\r\n]+\Z//;
		    $bh{$maybe} and do { $eos = $bh{$maybe}; last };
		}
		$thx and $th{$_} and do { $eos = $th{$_}; last };
		print $n_out $last; $last = $_;
	    }
	}
	else {                   ### native input, OO output [slower]
	    while (<$n_in>) {
		# Normalize line ending
		$_ =~ s/(:?\n\r|\r\n|\r)$/\n/ if $normalize_newlines;
		if (substr($_, 0, 2) eq '--') {
		    ($maybe = $_) =~ s/[ \t\r\n]+\Z//;
		    $bh{$maybe} and do { $eos = $bh{$maybe}; last };
		}
		$thx and $th{$_} and do { $eos = $th{$_}; last };
		$out->print($last); $last = $_;
	    }
	}
    }
    else {
	if ($n_out) {            ### OO input, native output [even slower]
	    while (defined($_ = $in->getline)) {
		# Normalize line ending
		$_ =~ s/(:?\n\r|\r\n|\r)$/\n/ if $normalize_newlines;
		if (substr($_, 0, 2) eq '--') {
		    ($maybe = $_) =~ s/[ \t\r\n]+\Z//;
		    $bh{$maybe} and do { $eos = $bh{$maybe}; last };
		}
		$thx and $th{$_} and do { $eos = $th{$_}; last };
		print $n_out $last; $last = $_;
	    }
	}
	else {                   ### OO input, OO output [slowest]
	    while (defined($_ = $in->getline)) {
		# Normalize line ending
		$_ =~ s/(:?\n\r|\r\n|\r)$/\n/ if $normalize_newlines;
		if (substr($_, 0, 2) eq '--') {
		    ($maybe = $_) =~ s/[ \t\r\n]+\Z//;
		    $bh{$maybe} and do { $eos = $bh{$maybe}; last };
		}
		$thx and $th{$_} and do { $eos = $th{$_}; last };
		$out->print($last); $last = $_;
	    }
	}
    }

    # Write out last held line, removing terminating CRLF if ended on bound,
    # unless the line consists only of CRLF and we're wanting to keep the
    # preceding blank line (as when parsing a preamble)
    $last =~ s/[\r\n]+\Z// if ($eos =~ /^(DELIM|CLOSE)/ && !($keep_newline && $last =~ m/^[\r\n]\z/));
    $out->print($last);

    ### Save and return what we finished on:
    ${$self->{EOS}} = ($eos || 'EOF');
    1;
}

#------------------------------
#
# read_lines INHANDLE, \@OUTLINES
#
# I<Instance method.>
# Read lines into the given array.
#
sub read_lines {
    my ($self, $in, $outlines) = @_;

    my $data = '';
    open(my $fh, '>', \$data) or die $!;
    $self->read_chunk($in, $fh);
    @$outlines =  split(/^/, $data);
    close $fh;

    1;
}

1;
__END__

=head1 SEE ALSO

L<MIME::Tools>, L<MIME::Parser>