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
|
# Copyright © 2007 Raphaël Hertzog <hertzog@debian.org>
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
package Dpkg::Cdata;
use strict;
use warnings;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(syntaxerr);
use Dpkg::Fields qw(capit);;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(parsecdata);
=head1 NAME
Dpkg::Cdata - parse and manipulate a block of RFC822-like fields
=head1 DESCRIPTION
The Dpkg::Cdata module exports one function 'parsecdata' that reads a
block of data (usually a block following the debian/control format)
=head1 FUNCTIONS
=over 4
=item $obj = Dpkg::Cdata::parsecdata($input, $file, %options)
$input is a filehandle, $file is the name of the file corresponding to
$input. %options can contain two parameters: allow_pgp=>1 allows the parser
to extrac the block of a data in a PGP-signed message (defaults to 0),
and allow_duplicate=>1 ask the parser to not fail when it detects
duplicate fields.
The return value is a reference to a tied hash (Dpkg::Fields::Object) that
can be used to access the various fields.
=cut
sub parsecdata {
my ($input, $file, %options) = @_;
$options{allow_pgp} = 0 unless exists $options{allow_pgp};
$options{allow_duplicate} = 0 unless exists $options{allow_duplicate};
my $paraborder = 1;
my $fields = undef;
my $cf = ''; # Current field
my $expect_pgp_sig = 0;
while (<$input>) {
s/\s*\n$//;
next if (m/^$/ and $paraborder);
next if (m/^#/);
$paraborder = 0;
if (m/^(\S+?)\s*:\s*(.*)$/) {
unless (defined $fields) {
my %f;
tie %f, "Dpkg::Fields::Object";
$fields = \%f;
}
if (exists $fields->{$1}) {
unless ($options{allow_duplicate}) {
syntaxerr($file, sprintf(_g("duplicate field %s found"), capit($1)));
}
}
$fields->{$1} = $2;
$cf = $1;
} elsif (m/^\s+\S/) {
length($cf) || syntaxerr($file, _g("continued value line not in field"));
$fields->{$cf} .= "\n$_";
} elsif (m/^-----BEGIN PGP SIGNED MESSAGE/) {
$expect_pgp_sig = 1;
if ($options{allow_pgp}) {
# Skip PGP headers
while (<$input>) {
last if m/^$/;
}
} else {
syntaxerr($file, _g("PGP signature not allowed here"));
}
} elsif (m/^$/) {
if ($expect_pgp_sig) {
# Skip empty lines
$_ = <$input> while defined($_) && $_ =~ /^\s*$/;
length($_) ||
syntaxerr($file, _g("expected PGP signature, found EOF after blank line"));
s/\n$//;
m/^-----BEGIN PGP SIGNATURE/ ||
syntaxerr($file,
sprintf(_g("expected PGP signature, found something else \`%s'"), $_));
# Skip PGP signature
while (<$input>) {
last if m/^-----END PGP SIGNATURE/;
}
length($_) ||
syntaxerr($file, _g("unfinished PGP signature"));
}
last; # Finished parsing one block
} else {
syntaxerr($file, _g("line with unknown format (not field-colon-value)"));
}
}
return $fields;
}
=back
=cut
1;
|
