#! /usr/bin/perl
# $Id: debarnacle,v 1.6 2002/05/15 19:41:18 itz Exp $
require 5.6.1;
use DB_File 1.75;
use Fcntl 1.03;
use FileHandle 2.00;
use Cwd 2.04 qw(fastcwd);
use Getopt::Std 1.02;
use File::Glob 0.991 qw(bsd_glob GLOB_QUOTE GLOB_BRACE);
use strict;
no strict qw(refs);
# configuration and command line parsing
sub usage {
print STDERR <<"EOF";
Usage: debarnacle [ -v VERBOSITY | -C CONFIGDIR | -c CACHESIZE | -d | -p | -q | -h ][ ROOT ]
-d: do not process filenames from packages
-p: do not process filenames from plugins
-q: be quiet (overrides -v)
-h: print this summary and exit
EOF
exit 2;
}
our $opt_v = 1;
our $opt_C = '';
our $opt_q = 0;
our $opt_d = 0;
our $opt_p = 0;
our $opt_c = 0;
our $opt_h = 0;
our $root = '/';
getopts('dpqv:C:c:h') or usage;
usage if $opt_h;
scalar(@ARGV) < 2 or usage;
$root = $ARGV[0] if $ARGV[0];
$opt_v = 0 if $opt_q;
# the strange path below gets substituted by make, so the default is
# whatever has been passed to Makefile.PL as $ENV{sysconfdir} (or /etc
# as the default default)
our $pkgconfdir = $opt_C || "//etc///debarnacle";
# a crufty way to get the number of all packages :(
our @dpkg_lists = bsd_glob("/var/lib/dpkg/info/*.list");
if (!$opt_c) {
$DB_BTREE->{cachesize} = 2000 * scalar @dpkg_lists;
} else {
$DB_BTREE->{cachesize} = $opt_c;
}
sub chomped_date {
my $date = `date`;
chomp $date;
return $date;
}
# create a database of files
our $dbname;
$SIG{'INT'} = $SIG{'HUP'} = $SIG{'TERM'} = sub { unlink $dbname if $dbname; exit 1; };
$dbname = `tempfile --directory /var/tmp`;
chomp $dbname;
our %filez;
tie (%filez, 'DB_File', $dbname, O_RDWR|O_CREAT, 0600, $DB_BTREE)
or die "can't tie DB_File: $!";
# read a skip-list
our $fh_prune = FileHandle->new("<$pkgconfdir/prune");
defined $fh_prune or die "can't open $pkgconfdir/prune: $!";
our %prunes = ();
PRUNE:
while (my $prune = $fh_prune->getline()) {
next PRUNE if $prune =~ /^ *\#/;
next PRUNE if $prune =~ /^ *$/;
chomp $prune;
$prunes{$prune} = 1;
}
# enter the current name returned by find() into the database. Stop
# descending into directories present in %prunes.
sub enter_file {
$filez{$File::Find::name} = '?';
$File::Find::prune = 1 if $prunes{$File::Find::name};
}
# translate an absolute pathname into canonical form (resolves symlinks
# in the directory part, but not in the base part). Do it fast: cache
# as much as possible, and exploit form of filenames.
our %canonical_dirs = ();
our $last_dir = '';
our $last_canonical = '';
sub canonical {
my $f = $_[0];
return '/' if $f eq '/.';
$f =~ m:^/((.*)/)?([^/]*)$: ;
my $dir = '/' . ($2 || '');
my $base = $3;
return "/$base" if $dir eq '/';
return "$last_canonical/$base" if $dir eq $last_dir;
$last_dir = $dir;
$last_canonical = $canonical_dirs{$dir};
if (!defined $last_canonical) {
chdir $dir;
$canonical_dirs{$dir} = $last_canonical = fastcwd;
}
return "$last_canonical/$base";
}
# enter an explanation for files in the list referenced by $list. If
# the file wasn't present in the database, mark it as missing.
sub explain {
my ($reason, $list) = @_;
foreach my $f (@{$list}) {
$f = canonical $f;
my $current = $filez{$f};
my $new_val = '!';
$current = $new_val = "?$reason" if !defined $current;
$filez{$f} = $new_val if $current =~ /^\?/;
}
}
# enter all existing files
print STDERR (&chomped_date(), " Listing exisiting files\n") if $opt_v > 0;
find(\&enter_file, $root);
# match additional globs (avoids missing reports about files under pruned directories)
print STDERR (&chomped_date(), " Adding globs\n") if $opt_v > 1;
our $fh_globs = FileHandle->new("<$pkgconfdir/globs");
defined $fh_globs or die "can't open $pkgconfdir/globs: $!";
GLOB_LINE:
while (my $glob_line = $fh_globs->getline()) {
next GLOB_LINE if $glob_line =~ /^\s*\#/ ;
next GLOB_LINE if $glob_line =~ /^\s*$/ ;
chomp $glob_line;
foreach my $f (bsd_glob($glob_line, &GLOB_BRACE|&GLOB_QUOTE)) {
$filez{$f} = '?';
}
}
$fh_globs->close();
# process dpkg's packages
if (!$opt_d) {
print STDERR (&chomped_date(), " Processing files in packages\n") if $opt_v > 0;
foreach my $nextlist (@dpkg_lists) {
my @pkgfiles = ();
$nextlist =~ s:.*/([^/]*)\.list$:$1: ;
print STDERR (&chomped_date(), " Processing package $nextlist\n") if $opt_v > 1;
foreach my $pkgfile qw (list conffiles postinst postrm preinst prerm shlibs md5sums config templates) {
my $fullpkgfile = "/var/lib/dpkg/info/$nextlist.$pkgfile";
push @pkgfiles, $fullpkgfile if -f $fullpkgfile;
}
my $fh_list = FileHandle->new("</var/lib/dpkg/info/$nextlist.list");
defined $fh_list or die "can't list package $nextlist: $!";
while (my $pkgfile = $fh_list->getline()) {
chop $pkgfile;
push @pkgfiles, $pkgfile;
}
$fh_list->close();
&explain("dpkg: $nextlist", \@pkgfiles);
}
}
# process plugins
if (!$opt_p) {
print STDERR (&chomped_date(), " Processing file lists from plugins\n") if $opt_v > 0;
our $dh_plugins = DirHandle->new("$pkgconfdir/plugin.d");
defined $dh_plugins or die "can't open $pkgconfdir/plugin.d: $!";
PLUGIN:
while (my $plugin = $dh_plugins->read()) {
next PLUGIN if $plugin !~ /^[A-Z][-_a-zA-Z0-9]*\.pm$/;
print STDERR (&chomped_date(), " Processing plugin $plugin\n") if $opt_v > 1;
require "$pkgconfdir/plugin.d/$plugin";
$plugin =~ s/\.pm$// ;
my $plug_list = &{"Debian::Debarnacle::${plugin}::get_list"}();
&explain("plugin: $plugin", $plug_list);
}
$dh_plugins->close();
}
# print report
print STDERR (&chomped_date(), " Generating report\n") if $opt_v > 0;
REPORT:
while (my ($name, $expl) = each %filez) {
next REPORT unless $expl =~ /^\?/;
if (length $expl == 1) {
print "$name: unexplained\n";
} else {
print "$name: missing for ";
print substr($expl, 1);
print "\n";
}
}
END { unlink $dbname if $dbname; }
no warnings qw(digit);
our $VERSION = '$Date: 2002/05/15 19:41:18 $ '; $VERSION =~ s|^\$Date:\s*([0-9]{4})/([0-9]{2})/([0-9]{2})\s.*|\1.\2.\3| ;