The following commit has been merged in the master branch:
commit 7602026aff2452f6d723a87146340f4ed3e3d863
Author: Guillem Jover <[email protected]>
Date: Wed Jul 1 09:17:47 2009 +0200
dpkg-scansources: Switch to use Dpkg::Cdata
Use our modules instead of duplicating the .dsc parsing code. As a
side effect it now handles properly bogus files.
diff --git a/debian/changelog b/debian/changelog
index b8a07d9..905344d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,8 @@ dpkg (1.15.4) UNRELEASED; urgency=low
when the package didn't have such field.
* Do not take into account Revision and Package_Revision fields in dpkg-name
as they have been handled already by “dpkg-deb -I”.
+ * Switch dpkg-scansources to use Dpkg::Cdata instead of duplicating the
+ .dsc parsing code. As a side effect it now handles properly bogus files.
[ Updated dpkg translations ]
* French (Christian Perrier).
diff --git a/scripts/dpkg-scansources.pl b/scripts/dpkg-scansources.pl
index 51ef9ec..6d60fc3 100755
--- a/scripts/dpkg-scansources.pl
+++ b/scripts/dpkg-scansources.pl
@@ -2,6 +2,7 @@
#
# Copyright © 1999 Roderick Schertler
# Copyright © 2002 Wichert Akkerman <[email protected]>
+# Copyright © 2006-2009 Guillem Jover <[email protected]>
#
# 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
@@ -30,6 +31,7 @@ use warnings;
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Cdata;
use Dpkg::Checksums;
textdomain("dpkg-dev");
@@ -219,135 +221,34 @@ sub load_src_override {
close SRC_OVERRIDE or syserr(_g("error closing source override file"));
}
-# Given FILENAME (for error reporting) and STRING, drop the PGP info
-# from the string and undo the encoding (if present) and return it.
-
-sub de_pgp {
- my ($file, $s) = @_;
- if ($s =~ s/^-----BEGIN PGP SIGNED MESSAGE-----.*?\n\n//s) {
- unless ($s =~ s/\n
- -----BEGIN\040PGP\040SIGNATURE-----\n
- .*?\n
- -----END\040PGP\040SIGNATURE-----\n
- //xs) {
- warning(_g("%s has PGP start token but not end token"), $file);
- return;
- }
- $s =~ s/^- //mg;
- }
- return $s;
-}
-
-# Load DSC-FILE and return its size, MD5 and translated (de-PGPed)
-# contents.
+# Given PREFIX and DSC-FILE, process the file and returns the fields.
-sub read_dsc {
- my $file = shift;
- my ($size, $nread, $contents);
-
- unless (open FILE, $file) {
- warning(_g("can't read %s: %s"), $file, $!);
- return;
- }
+sub process_dsc {
+ my ($prefix, $file) = @_;
+ my ($source, @binary, $priority, $section, $maintainer_override,
+ $dir);
- $contents = '';
- do {
- $nread = read FILE, $contents, 16*1024, length $contents;
- unless (defined $nread) {
- warning(_g("error reading from %s: %s"), $file, $!);
- return;
- }
- } while $nread > 0;
+ # Parse ‘.dsc’ file.
+ open(CDATA, '<', $file) || syserr(_g("cannot open %s"), $file);
+ my $fields = parsecdata(\*CDATA,
+ sprintf(_g("source control file %s"), $file),
+ allow_pgp => 1);
+ error(_g("parsing an empty file %s"), $file) unless (defined $fields);
+ close(CDATA) || syserr(_g("cannot close %s"), $file);
# Get checksums
+ my $size;
my $sums = {};
getchecksums($file, $sums, \$size);
- unless (close FILE) {
- warning(_g("error closing %s: %s"), $file, $!);
- return;
- }
-
- $contents = de_pgp $file, $contents;
- return unless defined $contents;
+ $source = $fields->{Source};
+ @binary = split /\s*,\s*/, $fields->{Binary};
- return $size, $sums, $contents;
-}
-
-# Given PREFIX and DSC-FILE, process the file and returning the source
-# package name and index record.
-
-sub process_dsc {
- my ($prefix, $file) = @_;
- my ($source, @binary, $priority, $section, $maintainer_override,
- $dir, $dir_field, $dsc_field_start);
+ error(_g("no binary packages specified in %s"), $file) unless (@binary);
- my ($size, $sums, $contents) = read_dsc $file or return;
-
- # Allow blank lines at the end of a file, because the other programs
- # do.
- $contents =~ s/\n\n+\Z/\n/;
-
- if ($contents =~ /^\n/ || $contents =~ /\n\n/) {
- warning(_g("%s invalid (contains blank line)"), $file);
- return;
- }
-
- # Take the $contents and create a list of (possibly multi-line)
- # fields. Fields can be continued by starting the next line with
- # white space. The tricky part is I don't want to modify the data
- # at all, so I can't just collapse continued fields.
- #
- # Implementation is to start from the last line and work backwards
- # to the second. If this line starts with space, append it to the
- # previous line and undef it. When done drop the undef entries.
- my @line = split /\n/, $contents;
- for (my $i = $#line; $i > 0; $i--) {
- if ($line[$i] =~ /^\s/) {
- $line[$i-1] .= "\n$line[$i]";
- $line[$i] = undef;
- }
- }
- my @field = map { "$_\n" } grep { defined } @line;
-
- # Extract information from the record.
- for my $orig_field (@field) {
- my $s = $orig_field;
- $s =~ s/\s+$//;
- $s =~ s/\n\s+/ /g;
- unless ($s =~ s/^([^:\s]+):\s*//) {
- warning(_g("invalid field in %s: %s"), $file, $orig_field);
- return;
- }
- my ($key, $val) = (lc $1, $s);
-
- # $source
- if ($key eq 'source') {
- if (defined $source) {
- warning(_g("duplicate source field in %s"), $file);
- return;
- }
- if ($val =~ /\s/) {
- warning(_g("invalid source field in %s"), $file);
- return;
- }
- $source = $val;
- next;
- }
-
- # @binary
- if ($key eq 'binary') {
- if (@binary) {
- warning(_g("duplicate binary field in %s"), $file);
- return;
- }
- @binary = split /\s*,\s*/, $val;
- unless (@binary) {
- warning(_g("no binary packages specified in %s"), $file);
- return;
- }
- }
- }
+ # Rename the source field to package.
+ $fields->{Package} = $fields->{Source};
+ delete $fields->{Source};
# The priority for the source package is the highest priority of the
# binary packages it produces.
@@ -360,6 +261,7 @@ sub process_dsc {
$priority = $priority_override
? $priority_override->[O_PRIORITY]
: undef;
+ $fields->{Priority} = $priority if defined $priority;
# For the section override, first check for a record from the source
# override file, else use the regular override file.
@@ -367,106 +269,49 @@ sub process_dsc {
$section = $section_override
? $section_override->[O_SECTION]
: undef;
+ $fields->{Section} = $section if defined $section;
# For the maintainer override, use the override record for the first
- # binary.
+ # binary. Modify the maintainer if necessary.
$maintainer_override = $Override{$binary[0]};
+ if ($maintainer_override && defined $maintainer_override->[O_MAINT_TO]) {
+ if (!defined $maintainer_override->[O_MAINT_FROM] ||
+ grep { $fields->{Maintainer} eq $_ }
+ @{ $maintainer_override->[O_MAINT_FROM] }) {
+ $fields->{Maintainer} = $maintainer_override->[O_MAINT_TO];
+ }
+ }
# A directory field will be inserted just before the files field.
$dir = ($file =~ s-(.*)/--) ? $1 : '';
$dir = "$prefix$dir";
$dir =~ s-/+$--;
$dir = '.' if $dir eq '';
- $dir_field .= "Directory: $dir\n";
+ $fields->{Directory} = $dir;
# The files field will get an entry for the .dsc file itself.
- my %listing;
foreach my $alg (@check_supported) {
if ($alg eq "md5") {
- $listing{$alg} = "Files:\n $sums->{$alg} $size $file\n";
+ $fields->{Files} =~ s/^\n/\n $sums->{$alg} $size $file\n/;
} else {
- $listing{$alg} = "Checksum-" . ucfirst($alg) .
- ":\n $sums->{$alg} $size $file\n";
+ my $name = "Checksums-" . ucfirst($alg);
+ $fields->{$name} =~ s/^\n/\n $sums->{$alg} $size $file\n/
+ if defined $fields->{$name};
}
}
- # Loop through @field, doing nececessary processing and building up
- # @new_field.
- my @new_field;
- for (@field) {
- # Rename the source field to package.
- s/^Source:/Package:/i;
-
- # Override the user's priority field.
- if (/^Priority:/i && defined $priority) {
- $_ = "Priority: $priority\n";
- undef $priority;
- }
-
- # Override the user's section field.
- if (/^Section:/i && defined $section) {
- $_ = "Section: $section\n";
- undef $section;
- }
-
- # Insert the directory line just before the files entry, and add
- # the dsc file to the files list.
- if (defined $dir_field && s/^Files:\s*//i) {
- push @new_field, $dir_field;
- $dir_field = undef;
- $_ = " $_" if length;
- $_ = "$listing{md5}$_";
- }
-
- if (/Checksums-(.*):/i) {
- my $alg = lc($1);
- s/Checksums-([^:]*):\s*//i;
- $_ = " $_" if length;
- $_ = "$listing{$alg}$_";
- }
-
- # Modify the maintainer if necessary.
- if ($maintainer_override
- && defined $maintainer_override->[O_MAINT_TO]
- && /^Maintainer:\s*(.*)\n/is) {
- my $maintainer = $1;
- $maintainer =~ s/\n\s+/ /g;
- if (!defined $maintainer_override->[O_MAINT_FROM]
- || grep { $maintainer eq $_ }
- @{ $maintainer_override->[O_MAINT_FROM] }){
- $_ = "Maintainer: $maintainer_override->[O_MAINT_TO]\n";
- }
- }
- }
- continue {
- push @new_field, $_ if defined $_;
- }
-
- # If there was no files entry, add one.
- if (defined $dir_field) {
- push @new_field, $dir_field;
- push @new_field, $dsc_field_start;
- }
-
- # Add the section field if it didn't override one the user supplied.
- if (defined $section) {
- # If the record starts with a package field put it after that,
- # otherwise put it first.
- my $pos = $new_field[0] =~ /^Package:/i ? 1 : 0;
- splice @new_field, $pos, 0, "Section: $section\n";
- }
-
- # Add the priority field if it didn't override one the user supplied.
- if (defined $priority) {
- # If the record starts with a package field put it after that,
- # otherwise put it first.
- my $pos = $new_field[0] =~ /^Package:/i ? 1 : 0;
- splice @new_field, $pos, 0, "Priority: $priority\n";
- }
-
- return $source, join '', @new_field, "\n";
+ return $fields;
}
+# FIXME: Try to reuse from Dpkg::Source::Package
+use Dpkg::Deps qw(@src_dep_fields);
+my @src_fields = (qw(Format Package Binary Architecture Version Origin
+ Maintainer Uploaders Dm-Upload-Allowed Homepage
+ Standards-Version Vcs-Browser Vcs-Arch Vcs-Bzr
+ Vcs-Cvs Vcs-Darcs Vcs-Git Vcs-Hg Vcs-Mtn Vcs-Svn),
+ @src_dep_fields,
+ qw(Directory Files Checksums-Md5 Checksums-Sha1
Checksums-Sha256));
+
sub main {
my (@out);
@@ -485,18 +330,36 @@ sub main {
while (<FIND>) {
chomp;
s-^\./+--;
- my ($source, $out) = process_dsc $prefix, $_ or next;
+
+ my $fields;
+
+ # FIXME: Fix it instead to not die on syntax and general errors?
+ eval {
+ $fields = process_dsc($prefix, $_);
+ };
+ if ($@) {
+ warn $@;
+ next;
+ }
+
+ tied(%{$fields})->set_field_importance(@src_fields);
if ($No_sort) {
- print $out;
+ tied(%{$fields})->output(\*STDOUT);
+ print "\n";
}
else {
- push @out, [$source, $out];
+ push @out, $fields;
}
}
close FIND or error(close_msg, 'find');
if (@out) {
- print map { $_->[1] } sort { $a->[0] cmp $b->[0] } @out;
+ map {
+ tied(%{$_})->output(\*STDOUT);
+ print "\n";
+ } sort {
+ $a->{Package} cmp $b->{Package}
+ } @out;
}
return 0;
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
