Re: Bug#622322: popularity-contest: popcon tries to access dpkg internal files and fails with multiarch: same packageso

[Bill Allombert <Bill.Allombert@math.u-bordeaux1.fr>]

On Wed, Apr 20, 2011 at 11:45:08PM +0200, Guillem Jover wrote:
> On Wed, 2011-04-20 at 23:08:51 +0200, Bill Allombert wrote:
> > On Wed, Apr 20, 2011 at 10:51:57PM +0200, Raphael Hertzog wrote:
> > > On Wed, 20 Apr 2011, Bill Allombert wrote:
> > > > On Wed, Apr 20, 2011 at 09:11:59PM +0200, Raphael Hertzog wrote:
> > > > > You can invoke "dpkg -L" less often by giving multiple packages as
> > > > > parameters. Each set of files will be separated by an empty line.
> > > > 
> > > > Good, is that behaviour documented somewhere ?
> > > 
> > > man dpkg-query shows that multiple parameters are allowed, it does not
> > > explain that an empty line is the separator though.
> > 
> > Well, surely we cannot rely on such undocumented behaviour.
> 
>   <http://git.debian.org/?p=dpkg/dpkg.git;a=commitdiff;h=e6b6ff088>

Thanks, please find a popularity-contest script that uses dpkg -L by batch.
The size of the batch is $dpkg_batch_size at the start of the script.

Below are timings on my laptop (with a fast solid-state disk):

Direct access   :  2.214 s
batch of 1  pkg : 31.446 s
batch of 2  pkgs:  5.218 s
batch of 3  pkgs:  2.652 s
batch of 4  pkgs:  2.405 s
batch of 5  pkgs:  2.395 s
batch of 8  pkgs:  2.380 s
batch of 10 pkgs:  2.370 s
batch of >=10 pkgs: about 2.370 s

Please test with multiarch.

Cheers,
-- 
Bill. <ballombe@debian.org>

Imagine a large red swirl here. 

#!/usr/bin/perl -w
#
# Copyright (C) 2003 by Bill Allombert <ballombe@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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# based on a design and a bash/gawk script
#
# Copyright (C) 1998,2000 by Avery Pennarun, for the Debian Project.
# Use, modify, and redistribute modified or unmodified versions in any
# way you wish.

use strict;
use 5.6.0;

my $dpkg_batch_size=10;
my $popcon_conf="/etc/popularity-contest.conf";

my %opts=();

# $popcon_conf is in shell-script format
my $HOSTID = qx(unset MY_HOSTID; . $popcon_conf; echo \$MY_HOSTID );

chomp $HOSTID;

if ( $HOSTID eq "")
{
  print STDERR "You must set MY_HOSTID in $popcon_conf!\n";
  exit 1;
}

if ( $HOSTID eq "d41d8cd98f00b204e9800998ecf8427e")
{
  print STDERR "Warning: MY_HOSTID is the md5sum of the empty file!\n";
  print STDERR "Please change it to the md5sum of a random file in $popcon_conf!\n";
}

if ( $HOSTID !~ /^([a-f0-9]{32})$/)
{
  print STDERR "Error: MY_HOSTID does not match ^([a-f0-9]{32})\$\n";
  print STDERR "Please edit $popcon_conf to use a valid md5sum value\n";
  exit 1;
}

# Architecture.
my $debarch = `dpkg --print-architecture`;
chomp $debarch;

# Popcon release
my $popconver=`dpkg-query --showformat='\${version}' --show popularity-contest`;

# Initialise time computations

my $now = time;
my $daylen = 24 * 60 * 60;
my $monthlen = $daylen * 30;
my $lastmonth = $now - $monthlen;

my %popcon=();

# List all mapped files
my %mapped;
if (opendir(PROC, "/proc"))
{
  my @procfiles = readdir(PROC);
  closedir(PROC);

  foreach (@procfiles)
  {
    -d "/proc/$_" or next;
    m{^[0-9]+$} or next;

    open MAPS, "/proc/$_/maps" or next;
    while (<MAPS>)
    {
      m{(/.*)} or next;
      $mapped{$1} = 1;
    }
    close MAPS;
  }
}

#process the file list of a package
sub proc_pkg
{
  my ($pkg,@list)=@_;
  $popcon{$pkg}=[0,0,$pkg,"<NOFILES>"];
  my $bestatime = undef;
  for (@list)
  {
    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                      $atime,$mtime,$ctime,$blksize,$blocks)
                          = stat;
    if (defined $mapped{$_}) {
      # It's currently being accessed by a process
      $atime = time();
    }
    print STDERR if (!defined($atime));
    if (!defined($bestatime) || $atime >= $bestatime)
    {
      $bestatime=$atime;
      if ($atime < $lastmonth)
      {
        # Not accessed since more than 30 days.
        $popcon{$pkg}=[$atime,$ctime,$pkg,$_,"<OLD>"];
      }
      elsif ($ctime > $lastmonth && $atime-$ctime < $daylen)
      {
        # Installed/upgraded less than a month ago and not used after
        # install/upgrade day.
        $popcon{$pkg}=[$atime,$ctime,$pkg,$_,"<RECENT-CTIME>"];
      }
      else
      {
        # Else we `vote' for the package.
        $popcon{$pkg}=[$atime,$ctime,$pkg,$_];
      }
    }
  }
}

#process a list of packages.
sub proc_pkgs
{
  my (@pkgs)=@_;
  open FILES, "-|", "dpkg -L @pkgs";
  my @list = ();
  my $pkg = shift @pkgs;
  while (<FILES>)
  {
    chop;
    if ($_ eq "")
    {
      proc_pkg($pkg, @list);
      $pkg = shift @pkgs;
      @list = ();
    }
    next unless (
     ( m{/bin/|/sbin/|/lib/.+/|^/usr/games/|\.[ah]$|\.pm$|\.php$|^/boot/System\.map-}
       || defined $mapped{$_} )
       && -f $_);
    push @list, $_;
  }
  proc_pkg($pkg, @list);
  close FILES;
}

# Read dpkg database of installed packages
open PACKAGES, "dpkg-query --show --showformat='\${status} \${package}\\n'|";
my @pkglist = ();
while (<PACKAGES>)
{
  /^.*installed *(.+)$/ or next;
  push @pkglist, $1;
  if (length @pkglist >= $dpkg_batch_size)
  {
    proc_pkgs(@pkglist);
    @pkglist = ();
  }
}
proc_pkgs(@pkglist) if (@pkglist);
close PACKAGES;

# We're not done yet.  Sort the output in reverse by atime, and
# add a header/footer.

print "POPULARITY-CONTEST-0 TIME:",time," ID:$HOSTID ".
    "ARCH:$debarch POPCONVER:$popconver\n";

for (sort { $popcon{$b}[0] <=> $popcon{$a}[0] } keys %popcon)
{
  print join(' ',@{$popcon{$_}}),"\n";
}

print "END-POPULARITY-CONTEST-0 TIME:",time,"\n";