This should address your comments so far.  A new patch series is
attached (and also available in the same Git repository).

On 07/29/2011 06:01 AM, Raphael Hertzog wrote:
PackageSpec is not supported in the current dpkg version so you can't
really use it until my branch gets merged and a new dpkg uploaded.
Or you should at least be able to deal with the case where it returns an
empty value.

Fixed both cases by falling back to Package if PackageSpec is empty.

And I don't really get the output format... why 2 \n after each field
value?

I just needed a separator that’s guaranteed not to otherwise appear in
the output.  Added a comment to that effect.

That's quite some code duplicated. It would probably be worth to factorize
the code.

Done.

Anders
>From efa322fa8ddbca14501ebf07f2b9fd6a6ffdca61 Mon Sep 17 00:00:00 2001
From: Anders Kaseorg <ande...@mit.edu>
Date: Fri, 8 Jul 2011 02:52:22 -0400
Subject: [PATCH 1/6] Read and write .md5sums files at multiarch paths when
 needed

Signed-off-by: Anders Kaseorg <ande...@mit.edu>
---
 debsums |   21 ++++++++++++++++-----
 1 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/debsums b/debsums
index 855fbf7..5693287 100755
--- a/debsums
+++ b/debsums
@@ -151,6 +151,8 @@ my @debpath = '.';
 @debpath = map +(length) ? $_ : '.', split /:/, $debpath, -1 if $debpath;
 
 my $arch;
+chomp ($arch = `/usr/bin/dpkg --print-architecture`);
+
 my %generate;
 if ($gen_opt)
 {
@@ -172,8 +174,6 @@ if ($gen_opt)
     $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;
 }
@@ -254,6 +254,17 @@ sub dpkg_cmp
     !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 ($path) = @_;
+    return "$DPKG/info/$path.md5sums" if -e "$DPKG/info/$path.list";
+    return "$DPKG/info/$path:$arch.md5sums" if $path !~ /:/ and -e "$DPKG/info/$path:$arch.list";
+    die "Cannot find md5sums path for $path\n";
+}
+
 sub is_replaced
 {
     my ($pack, $path, $sum) = @_;
@@ -273,7 +284,7 @@ sub is_replaced
 
     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")
@@ -460,7 +471,7 @@ for (@ARGV)
 	}
 	else
 	{
-	    $sums = "$DPKG/info/$pack.md5sums";
+	    $sums = md5sums_path($pack);
 	    unless (-f $sums or $config)
 	    {
 		if ($missing)
@@ -626,7 +637,7 @@ for (@ARGV)
 
 	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";
 	}
-- 
1.7.6

>From 73e52cbc6b6506774b2d29e6ffc54b0707d3d012 Mon Sep 17 00:00:00 2001
From: Anders Kaseorg <ande...@mit.edu>
Date: Thu, 7 Jul 2011 21:04:03 -0400
Subject: [PATCH 2/6] Use dpkg-query instead of reading /var/lib/dpkg/status

Signed-off-by: Anders Kaseorg <ande...@mit.edu>
---
 debsums |   41 ++++++++++++++++++++++++++++-------------
 1 files changed, 28 insertions(+), 13 deletions(-)

diff --git a/debsums b/debsums
index 5693287..a17541e 100755
--- a/debsums
+++ b/debsums
@@ -116,6 +116,29 @@ sub warn_or_die {
   }
 }
 
+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;
@@ -181,16 +204,11 @@ if ($gen_opt)
 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 Version Status Conffiles Replaces)])) {
+	my %field = %$fields;
+	next unless $field{Package} ne ''
+		and $field{Version} ne ''
 		and $field{Status} =~ /\sinstalled$/;
 
 	$installed{$field{Package}}{Version} = $field{Version};
@@ -198,7 +216,6 @@ my %replaced;
 	    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+\(([^)]+)\))?$/;
@@ -211,8 +228,6 @@ my %replaced;
 	    push @{$replaced{$pack}{$ver || 'all'}}, $field{Package};
 	}
     }
-
-    close STATUS;
 }
 
 my %diversion;
-- 
1.7.6

>From 7ea81439885b3f2904078ef4b5da28e1f17ccca5 Mon Sep 17 00:00:00 2001
From: Anders Kaseorg <ande...@mit.edu>
Date: Fri, 8 Jul 2011 00:58:47 -0400
Subject: [PATCH 3/6] Use dpkg-deb instead of dpkg --field

Signed-off-by: Anders Kaseorg <ande...@mit.edu>
---
 debsums |   12 +++++++++---
 1 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/debsums b/debsums
index a17541e..858b918 100755
--- a/debsums
+++ b/debsums
@@ -527,10 +527,16 @@ for (@ARGV)
 	}
 
 	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 Version Conffiles)])
+	  or do {
+	    warn "$self: $deb does not seem to be a valid debian archive\n";
+	    $status |= 1;
+	    next;
+	};
+	my %field = %$fields;
 
-	unless (exists $field{Package} and $field{Version})
+	unless ($field{Package} ne '' and $field{Version} ne '')
 	{
 	    warn "$self: $deb does not seem to be a valid debian archive\n";
 	    $status |= 1;
-- 
1.7.6

>From 73fd19a333c152c110dbd3cd9ba93fd0f28dc2a5 Mon Sep 17 00:00:00 2001
From: Anders Kaseorg <ande...@mit.edu>
Date: Fri, 8 Jul 2011 00:45:40 -0400
Subject: [PATCH 4/6] Keep track of packages by package specifier instead of
 name

Signed-off-by: Anders Kaseorg <ande...@mit.edu>
---
 debsums |   20 +++++++++++---------
 1 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/debsums b/debsums
index 858b918..7161dd6 100755
--- a/debsums
+++ b/debsums
@@ -205,14 +205,15 @@ my %installed;
 my %replaced;
 {
     for my $fields (parse_dpkg(sub {'dpkg-query', "--admindir=$DPKG", @_, '--show'},
-			       [qw(Package Version Status Conffiles Replaces)])) {
+			       [qw(Package PackageSpec Version Status Conffiles Replaces)])) {
 	my %field = %$fields;
-	next unless $field{Package} ne ''
+	$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};
 
@@ -221,11 +222,11 @@ my %replaced;
 	    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};
 	}
     }
 }
@@ -528,22 +529,23 @@ for (@ARGV)
 
 	my $deb = $_;
 	my ($fields) = parse_dpkg(sub {'dpkg-deb', @_, '--show', $deb},
-				  [qw(Package Version Conffiles)])
+				  [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 ($field{Package} ne '' and $field{Version} ne '')
+	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";
-- 
1.7.6

>From 8f37c02063c6c9778fabcfdcac6ac3ffddeb14fc Mon Sep 17 00:00:00 2001
From: Anders Kaseorg <ande...@mit.edu>
Date: Fri, 8 Jul 2011 00:45:40 -0400
Subject: [PATCH 5/6] Support foreign multiarch packages

Signed-off-by: Anders Kaseorg <ande...@mit.edu>
---
 debsums |   14 +++++++++-----
 1 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/debsums b/debsums
index 7161dd6..6e74cae 100755
--- a/debsums
+++ b/debsums
@@ -287,9 +287,10 @@ sub is_replaced
 
     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;
@@ -441,7 +442,7 @@ for (@ARGV)
     my $conffiles;
 
     # looks like a package name
-    unless (/[^a-z\d+.-]/ or /\.deb$/)
+    unless (/[^a-z\d+.:-]/ or /\.deb$/)
     {
 	$pack = $_;
 	unless (exists $installed{$pack})
@@ -465,8 +466,11 @@ for (@ARGV)
 	    {
 		# 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;
-- 
1.7.6

>From 6a6ba53351c45522ee9a0fceadb3d54326e1f8be Mon Sep 17 00:00:00 2001
From: Anders Kaseorg <ande...@mit.edu>
Date: Tue, 16 Aug 2011 23:00:25 -0400
Subject: [PATCH 6/6] Debian version 2.0.48+nmu4

Signed-off-by: Anders Kaseorg <ande...@mit.edu>
---
 debian/changelog |   11 +++++++++++
 1 files changed, 11 insertions(+), 0 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 90fe8cb..b145234 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -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.
-- 
1.7.6

Reply via email to