On 08/23/2011 03:19 PM, Raphael Hertzog wrote:
So it looks ok for me.
Great. Thanks for taking the time to review this. Here's the final
debdiff (equivalent to patch 1 from message #132 plus patches 2-6 from
message #112).
Are you willing to get it uploaded?
Anders
diff -Nru debsums-2.0.48+nmu3/debian/changelog
debsums-2.0.48+nmu4/debian/changelog
--- debsums-2.0.48+nmu3/debian/changelog 2010-11-17 16:47:01.000000000
-0500
+++ debsums-2.0.48+nmu4/debian/changelog 2011-08-23 13:36:28.000000000
-0400
@@ -1,3 +1,14 @@
+debsums (2.0.48+nmu4) unstable; urgency=low
+
+ * Non-maintainer upload.
+ * Use dpkg-query instead of reading /var/lib/dpkg/status directly. We
+ still use /var/lib/dpkg/info directly to find the paths to .md5sums
+ files, but now at least we try to verify our guess by checking that
+ the corresponding .lists file exist. (Closes: #616066)
+ * Add multiarch support.
+
+ -- Anders Kaseorg <ande...@mit.edu> Tue, 16 Aug 2011 23:00:14 -0400
+
debsums (2.0.48+nmu3) unstable; urgency=low
* Non-maintainer upload.
diff -Nru debsums-2.0.48+nmu3/debsums debsums-2.0.48+nmu4/debsums
--- debsums-2.0.48+nmu3/debsums 2010-11-17 16:18:37.000000000 -0500
+++ debsums-2.0.48+nmu4/debsums 2011-08-23 13:36:28.000000000 -0400
@@ -116,6 +116,29 @@
}
}
+sub parse_dpkg {
+ my ($command_cb, $field_names) = @_;
+
+ local $/ = "\n\n"; # Separator that cannot appear in dpkg status format
+ my @command = &$command_cb('--showformat=' .
+ (join '', map {"\${$_}$/"} @$field_names));
+ open DPKG, '-|', @command
+ or die "$self: can't run dpkg-query ($!)\n";
+
+ my @ret;
+ while (!eof DPKG)
+ {
+ my %field = map {$_, scalar <DPKG>} @$field_names;
+ chomp @field{@$field_names};
+ push @ret, \%field;
+ }
+
+ close DPKG or die "$self: @command failed (",
+ $! ? $! : $? >> 8 ? "exit status " . ($? >> 8) : "signal " . ($? & 127),
+ ")\n";
+ return @ret;
+}
+
$root ||= '';
$admindir ||= '/var/lib/dpkg';
my $DPKG = $root . $admindir;
@@ -151,6 +174,8 @@
@debpath = map +(length) ? $_ : '.', split /:/, $debpath, -1 if $debpath;
my $arch;
+chomp ($arch = `/usr/bin/dpkg --print-architecture`);
+
my %generate;
if ($gen_opt)
{
@@ -172,8 +197,6 @@
$generate{missing}++ unless $generate{all} or $generate{missing};
$generate{keep}++ if $generate{nocheck};
- chomp ($arch = `/usr/bin/dpkg --print-architecture`);
-
# ensure generated files are world readable
umask 022;
}
@@ -181,38 +204,31 @@
my %installed;
my %replaced;
{
- open STATUS, "$DPKG/status" or die "$self: can't open $DPKG/status ($!)\n";
- local $/ = '';
-
- while (<STATUS>)
- {
- chomp;
- my %field = map /^(\S+):\s+(.*)/ms, split /\n(?!\s)/;
- next unless exists $field{Package}
- and exists $field{Version}
- and exists $field{Status}
+ for my $fields (parse_dpkg(sub {'dpkg-query', "--admindir=$DPKG", @_,
'--show'},
+ [qw(Package PackageSpec Version Status Conffiles
Replaces)])) {
+ my %field = %$fields;
+ $field{PackageSpec} = $field{Package} if $field{PackageSpec} eq '';
+ next unless $field{PackageSpec} ne ''
+ and $field{Version} ne ''
and $field{Status} =~ /\sinstalled$/;
- $installed{$field{Package}}{Version} = $field{Version};
- $installed{$field{Package}}{Conffiles} = {
+ $installed{$field{PackageSpec}}{Version} = $field{Version};
+ $installed{$field{PackageSpec}}{Conffiles} = {
map m!^\s*/(\S+)\s+([\da-f]+)!, split /\n/, $field{Conffiles}
} if $field{Conffiles};
- next unless exists $field{Replaces};
for (split /,\s*/, $field{Replaces})
{
my ($pack, $ver) = /^(\S+)(?:\s+\(([^)]+)\))?$/;
unless ($pack)
{
- warn "$self: invalid Replaces for $field{Package} '$_'\n";
+ warn "$self: invalid Replaces for $field{PackageSpec} '$_'\n";
next;
}
- push @{$replaced{$pack}{$ver || 'all'}}, $field{Package};
+ push @{$replaced{$pack}{$ver || 'all'}}, $field{PackageSpec};
}
}
-
- close STATUS;
}
my %diversion;
@@ -254,15 +270,33 @@
!system '/usr/bin/dpkg', '--compare-versions', $ver, $op, $testver;
}
+sub md5sums_path
+{
+ # Calling dpkg-query --control-path for every package is too slow,
+ # so we cheat a little bit.
+
+ my ($pack) = @_;
+ if (-e "$DPKG/info/$pack.list") {
+ return "$DPKG/info/$pack.md5sums";
+ } elsif ($pack !~ /:/ and -e "$DPKG/info/$pack:$arch.list") {
+ return "$DPKG/info/$pack:$arch.md5sums";
+ } elsif ($pack =~ /^(.*):/ and -e "$DPKG/info/$1.list") {
+ return "$DPKG/info/$1.md5sums";
+ } else {
+ die "Cannot find md5sums path for $pack\n";
+ }
+}
+
sub is_replaced
{
my ($pack, $path, $sum) = @_;
unless ($installed{$pack}{ReplacedBy})
{
- return 0 unless $replaced{$pack};
+ (my $name = $pack) =~ s/:[^:]*$//;
+ return 0 unless $replaced{$name};
- while (my ($ver, $p) = each %{$replaced{$pack}})
+ while (my ($ver, $p) = each %{$replaced{$name}})
{
next unless $ver eq 'all'
or dpkg_cmp $installed{$pack}{Version}, $ver;
@@ -273,7 +307,7 @@
for my $p (@{$installed{$pack}{ReplacedBy} || []})
{
- open S, "$DPKG/info/$p.md5sums" or next;
+ open S, md5sums_path($p) or next;
while (<S>)
{
if ($_ eq "$sum $path\n")
@@ -414,7 +448,7 @@
my $conffiles;
# looks like a package name
- unless (/[^a-z\d+.-]/ or /\.deb$/)
+ unless (/[^a-z\d+.:-]/ or /\.deb$/)
{
$pack = $_;
unless (exists $installed{$pack})
@@ -438,8 +472,11 @@
{
# look for <pack>_<ver>_<arch>.deb or <pack>_<ver>.deb
# where <ver> may or may not contain an epoch
- if (($deb) = grep -f, map +(glob "$dir/${pack}_$_.deb"),
- map +("${_}_$arch", "${_}_all", $_), @v)
+ my ($debname, $debarch);
+ ($debname, $debarch) = ($pack =~ /^(.*):([^:]*)$/)
+ or ($debname, $debarch) = ($pack, $arch);
+ if (($deb) = grep -f, map +(glob "$dir/${debname}_$_.deb"),
+ map +("${_}_$debarch", "${_}_all", $_), @v)
{
$deb =~ s!^\./+!!;
last;
@@ -460,7 +497,7 @@
}
else
{
- $sums = "$DPKG/info/$pack.md5sums";
+ $sums = md5sums_path($pack);
unless (-f $sums or $config)
{
if ($missing)
@@ -501,17 +538,24 @@
}
my $deb = $_;
- my %field = map /^(\S+):\s+(.*)/ms, split /\n(?!\s)/,
- `dpkg --field '$deb' Package Version Conffiles 2>/dev/null`;
+ my ($fields) = parse_dpkg(sub {'dpkg-deb', @_, '--show', $deb},
+ [qw(Package PackageSpec Version Conffiles)])
+ or do {
+ warn "$self: $deb does not seem to be a valid debian archive\n";
+ $status |= 1;
+ next;
+ };
+ my %field = %$fields;
+ $field{PackageSpec} = $field{Package} if $field{PackageSpec} eq '';
- unless (exists $field{Package} and $field{Version})
+ unless ($field{PackageSpec} ne '' and $field{Version} ne '')
{
warn "$self: $deb does not seem to be a valid debian archive\n";
$status |= 1;
next;
}
- $pack = $field{Package};
+ $pack = $field{PackageSpec};
unless (exists $installed{$pack})
{
warn "$self: package $pack is not installed\n";
@@ -626,7 +670,7 @@
if ($generate{keep})
{
- my $target = "$DPKG/info/$pack.md5sums";
+ my $target = md5sums_path($pack);
copy $sums, $target
or die "$self: can't copy sums to $target ($!)\n";
}
