#!/usr/bin/perl -w

# $Id: debsums.in,v 1.3 2002/04/14 09:51:32 bod Exp $

#
#  Check installed files against package md5sums or debs.
#

use strict;
use File::Find 'find';
use File::Temp 'tempdir';
use File::Path 'rmtree';
use File::Copy 'copy';
use Getopt::Long qw/:config bundling/;
use Digest::MD5;

(my $self = $0) =~ s!.*/!!;
my $version = <<EOT;
$self 2.0.2

Copyright (c) 2002  Brendan O'Dea <bod\@debian.org>
This is free software, licensed under the terms of the GNU General Public
License.  There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.

Written by Brendan O'Dea <bod\@debian.org>, based on a program by
Christoph Lameter <clameter\@debian.org> and Petr Cech <cech\@debian.org>.
EOT

my $help = <<EOT;
$self checks the MD5 sums of installed debian packages.

Usage: $self [OPTIONS] [PACKAGE|DEB] ...

Options:
 -a, --all                    check configuration files (normally excluded)
 -c, --changed                report changed files (implies -s)
 -l, --list-missing           list packages which don't have an md5sums file
 -s, --silent                 only report errors
 -m, --md5sums=FILE           read list of deb checksums from FILE
 -r, --root=DIR               root directory to check (default /)
 -d, --admindir=DIR           dpkg admin directory (default /var/lib/dpkg)
 -p, --deb-path=DIR[:DIR...]  search path for debs
 -g, --generate=[all][,keep[,nocheck]]
 			      generate md5sums from deb contents
     --help                   print this help, then exit
     --version                print version number, then exit
EOT

my $gen_opt;
GetOptions (
    'a|all'		=> \my $all,
    'c|changed'		=> \my $changed,
    'l|list-missing'    => \my $missing,
    's|silent'		=> \my $silent,
    'm|md5sums=s'	=> \my $md5sums,
    'r|root=s'		=> \my $root,
    'd|admindir=s'	=> \my $admindir,
    'p|deb-path=s'	=> \my $debpath,
    'generate=s'	=> \$gen_opt,
    g			=> sub { $gen_opt = 'missing' },
    help		=> sub { print $help; exit },
    version		=> sub { print $version; exit },
) or die "Try `$self --help' for more information.\n";

$root ||= '';
$admindir ||= '/var/lib/dpkg';
my $DPKG = $root . $admindir;

$silent++ if $changed;

my @debpath = '.';
@debpath = map +(length) ? $_ : '.', split /:/, $debpath, -1 if $debpath;

my %generate;
if ($gen_opt)
{
    for (split /,/, $gen_opt)
    {
	if (/^(missing|all|keep|nocheck)$/)
	{
	    $generate{$1}++;
	}
	else
	{
	    die "$self: invalid --generate value `$_'\n";
	}
    }

    die "$self: --generate values `all' and `missing' are mutually exclusive\n"
	if $generate{all} and $generate{missing};

    $generate{missing}++ unless $generate{all} or $generate{missing};
    $generate{keep}++    if $generate{nocheck};
}

my %installed;
{
    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}
		and $field{Status} =~ /\binstalled$/;

	$installed{$field{Package}}{Version} = $field{Version};
	$installed{$field{Package}}{Conffiles} = {
	    map m!^\s*/(.*)\s+(.*)!, split /\n/, $field{Conffiles}
	} if $field{Conffiles};
    }

    close STATUS;
}

my %diversion;
for (`/usr/sbin/dpkg-divert --list`)
{
    my ($by) = /^(local) diversion/ ? $1 : / by (\S+)$/;
    $diversion{$1} = [$2, $by]
	if m!diversion of /(.*) to /(.*?)\s!;
}

my %debsum;
if ($md5sums)
{
    open F, $md5sums or die "$self: can't open sums file `$md5sums' ($!)\n";
    while (<F>)
    {
	my ($sum, $deb) = split;
	$debsum{$deb} = $sum;
    }
}

my $digest = Digest::MD5->new;
my $tmp;
my $status = 0;

@ARGV = sort keys %installed unless @ARGV;

{
    my $width = ($ENV{COLUMNS} || 80) - 3;
    sub check
    {
	my ($pack, $path, $sum) = @_;

	$path = $diversion{$path}[0] if exists $diversion{$path}
	    and $diversion{$path}[1] ne $pack;

	unless (open F, "$root/$path")
	{
	    warn "$self: can't open $pack file $path ($!)\n";
	    return 0;
	}

	$digest->addfile(\*F);
	close F;

	unless ($digest->hexdigest eq $sum)
	{
	    if ($changed)
	    {
		print $path, "\n";
		return 1;
	    }

	    if ($silent)
	    {
		warn "$self: checksum mismatch $pack file $path\n";
	    }
	    else
	    {
		printf "%-*s FAILED\n", $width - 4, $path;
	    }

	    return 0;
	}

	printf "%-*s OK\n", $width, $path unless $silent;
	1;
    }
}

for (@ARGV)
{
    my $sums;
    my $pack;
    my $conffiles;

    # looks like a package name
    unless (/[^a-z\d+.-]/)
    {
	$pack = $_;
	unless (exists $installed{$pack})
	{
	    warn "$self: package $pack is not installed\n";
	    $status = 1;
	    next;
	}

	my $v = $installed{$pack}{Version};
	$v =~ s/:/%3a/g;
	my $deb;
	if (%generate)
	{
	    for (@debpath)
	    {
		if (($deb) = glob "$_/${pack}_${v}_*.deb")
		{
		    $deb =~ s!^\./+!!;
		    last;
		}
	    }
	}

	if ($generate{all})
	{
	    unless ($deb)
	    {
		warn "$self: no deb available for $pack\n";
		$status = 1;
		next;
	    }

	    $_ = $deb;
	}
	else
	{
	    $sums = "$DPKG/info/$pack.md5sums";
	    unless (-f $sums)
	    {
		if ($missing)
		{
		    print "$pack\n";
		    next;
		}

		unless ($generate{missing})
		{
		    warn "$self: no md5sums for $pack\n";
		    next;
		}

		unless ($deb)
		{
		    warn "$self: no md5sums for $pack and no deb available\n"
			unless $generate{nocheck} and $silent;

		    next;
		}

		undef $sums;
		$_ = $deb;
	    }
	}

	next if $missing;
    }

    unless ($sums)
    {
	unless (-f and /\.deb/)
	{
	    warn "$self: invalid package name `$_'\n";
	    $status = 1;
	    next;
	}

	my $deb = $_;
	my %field = map /^(\S+):\s+(.*)/ms, split /\n(?!\s)/,
	    `dpkg --field '$deb' Package Version Conffiles 2>/dev/null`;

	unless (exists $field{Package} and $field{Version})
	{
	    warn "$self: $deb does not seem to be a valid debian archive\n";
	    $status = 1;
	    next;
	}

	$pack = $field{Package};
	unless (exists $installed{$pack})
	{
	    warn "$self: package $pack is not installed\n";
	    $status = 1;
	    next;
	}

	unless ($installed{$pack}{Version} eq $field{Version})
	{
	    warn "$self: package $pack version $field{Version} !=",
		" installed version $installed{$pack}{Version}\n";

	    $status = 1;
	    next;
	}

	if ($md5sums)
	{
	    if (exists $debsum{$deb})
	    {
		open F, $deb or die "$self: can't open $deb ($!)\n";
		$digest->addfile(\*F);
		close F;

		unless ($digest->hexdigest eq $debsum{$deb})
		{
		    warn "$self: checksum missmatch for $deb; not checked\n";
		    $status = 1;
		    next;
		}
	    }
	    else
	    {
		warn "$self: no checksum available for $deb\n";
	    }
	}

	unless ($tmp)
	{
	    my $catch = sub { exit 1 };
	    $SIG{$_} = $catch for qw/HUP INT QUIT TERM/;

	    $tmp = tempdir CLEANUP => 1
		or die "$self: can't create temporary directory ($!)\n";
	}

	my $control = "$tmp/DEBIAN";
	$sums = "$control/md5sums";
	rmtree $control if -d $control;

	system 'dpkg', '--control', $deb, $control
	    and die "$self: can't extract control info from $deb\n";
	
	if ($missing)
	{
	    print "$deb\n" unless -s $sums;
	    next;
	}

	my %conf;
	if (open F, "$control/conffiles")
	{
	    while (<F>)
	    {
		chomp;
		$conf{$1}++ if m!^/?(.+)!;
	    }

	    close F;
	}

	if (!-s $sums)
	{
	    unless (%generate)
	    {
		warn "$self: no md5sums in $deb\n";
		next;
	    }

	    my $unpacked = "$tmp/$pack";
	    print "Generating missing md5sums for $deb..." unless $silent;
	    system 'dpkg', '--extract', $deb, $unpacked
		and die "$self: can't unpack $deb\n";
	    
	    $conffiles = {};
	    open SUMS, ">$sums" or die "$self: can't create $sums ($!)\n";
	    my $skip = (length $unpacked) + 1;

	    find sub {
		return if -l or ! -f;
		open F, $_ or die "$self: can't open $_ ($!)\n";
		$digest->addfile(\*F);
		close F;
		my $md5 = $digest->hexdigest;
		my $path = substr $File::Find::name, $skip;
		if (delete $conf{$path})
		{
		    $conffiles->{$path} = $md5;
		}
		else
		{
		    print SUMS "$md5  $path\n";
		}
	    }, $unpacked;

	    close SUMS;
	    rmtree $unpacked;

	    print "done.\n" unless $silent;

	    warn "$self: extra conffiles listed in $deb: (",
		(join ', ', keys %conf), ")\n" if %conf;
	}

	if ($generate{keep})
	{
	    my $target = "$DPKG/info/$pack.md5sums";
	    copy $sums, $target
		or die "$self: can't copy sums to $target ($!)\n";
	}
    }

    next if $generate{nocheck};

    $conffiles = $installed{$pack}{Conffiles} || {}
	unless $conffiles;

    open SUMS, $sums or die "$self: can't open $sums ($!)\n";
    while (<SUMS>)
    {
	chomp;
	my ($sum, $path) = split ' ', $_, 2;
	unless ($path and $sum =~ /^[0-9a-f]{32}$/)
	{
	    warn "$self: invalid line ($.) in md5sums for $pack: $_\n";
	    next;
	}

	next if exists $conffiles->{$path};
	$status = 1 unless check $pack, $path, $sum;
    }

    close SUMS;

    next unless $all and %$conffiles;
    while (my ($path, $sum) = each %$conffiles)
    {
	$status = 1 unless check $pack, $path, $sum;
    }
}

exit $status;
