source: trunk/debathena/debathena/verify/debian/verify_ws.pl @ 25701

#!/usr/bin/perl -w
#
# Workstation "verification" script
#

use strict;
use Getopt::Std;
use File::Basename;
use AptPkg::Config '$_config';
use AptPkg::Cache;

my $logfile = "/var/log/verify_ws.log";
my $verify_dir = "/afs/athena.mit.edu/system/athena10/verify";

($> == 0) || die "You must be root to run this.\n";

our ($opt_d,$opt_s) = (0,'');

getopts('ds:') || die "Usage: $0 [-d]\n";

if ($opt_d) {
    open(LOG, ">&STDOUT") || die "Can't dup stdout";
} else {
    open(LOG, ">>$logfile") || die "Cannot append to logfile: $!";
}

my %MIRRORS_OK = ();
my %COMPONENTS_OK = ();
my %SUITES_OK = ();
my %DA_MIRRORS_OK = ();
my %DA_COMPONENTS_OK = ();
my %DA_SUITES_OK = ();
my %APTKEYS_OK = ();
my %DEBSUMS_MISSING_PKG_OK = ();
my %DEBSUMS_MISSING_FILE_OK = ();
my %DEBSUMS_CHANGED_FILE_OK = ();

my $errors = 0;
my $warns = 0;
my %checks = ('sources' => 1,
              'keys' => 1,
              'debsums' => 1,
              'policy', => 1 );


# Initialize the APT configuration
$_config->init;
my $cache = AptPkg::Cache->new;
my $policy = $cache->policy;

# Basic setup
my $codename = `/usr/bin/lsb_release -sc`;
die "Can't determine codename" unless ($? == 0);
chomp($codename);

if ($opt_s) {
    foreach my $skip (split(',', $opt_s)) {
        die "Can't skip unknown check '$skip'" unless exists($checks{$skip});
        warn("Skipping check '$skip'");
        $checks{$skip} = 0;
    }
}
            
sub debug {
    $opt_d && print LOG "DEBUG: ", @_, "\n";
}

sub error {
    $errors = 1;
    print LOG "ERROR: ", @_, "\n";
}

sub wank {
    $warns = 1;
    print LOG "WARNING: ", @_, "\n";
}

sub loadConfigFile {
    my ($filename, $hashref) = @_;
    open(F, join('/', $verify_dir, $codename, $filename)) || 
        die "Can't open '$filename' file: $!";
    foreach my $line (<F>) {
        next if ($line =~ /^#/);
        next unless ($line =~ /\w/);
        chomp $line;
        $hashref->{$line} = 1;
    }
    close(F);
}
    
sub checkSourcesList {
    my ($filename, $mirrorsok, $suitesok, $componentsok) = @_;
    if (open(SLIST, $filename)) {
        while (<SLIST>) {
            next if /^#/;
            next unless /\w/;
            my ($type, $mirror, $suite, @components) = split(' ', $_);
            error($filename, ":", $., " Unknown first field ($type)") unless 
                ($type =~ /^deb(-src){0,1}$/);
            $mirror =~ s|/+$||g;
            error($filename, ":", $., " Unknown mirror ($mirror)") unless
                exists($mirrorsok->{$mirror});
            error($filename, ":", $., " Unknown suite ($suite)") unless
                exists($suitesok->{$suite});
            foreach my $c (@components) {
                error($filename, ":", $., " Unknown component ($c)") unless
                    exists($componentsok->{$c});
            }
        }
        close(SLIST);
    } else {
        error("Couldn't open file ($filename): $!");
    }
}           

sub checkAptSources {
    my $sourceslist = join('', $_config->get('Dir'),
                           $_config->get('Dir::Etc'),
                           $_config->get('Dir::Etc::sourcelist'));
    
    wank("sources.list ($sourceslist) looks funny") unless 
        ((-f $sourceslist) && ($sourceslist eq "/etc/apt/sources.list"));
    
    
    my $sourceslistd = join('', $_config->get('Dir'),
                            $_config->get('Dir::Etc'),
                            $_config->get('Dir::Etc::sourceparts'));
    
    wank("sources.list.d ($sourceslistd) looks funny") unless 
        ((-d $sourceslistd ) && ($sourceslistd eq "/etc/apt/sources.list.d"));

    debug("Looking at sources.list ($sourceslist)");
    checkSourcesList($sourceslist, \%MIRRORS_OK, \%SUITES_OK, \%COMPONENTS_OK);
    
    foreach my $file (glob '/etc/apt/sources.list.d/*.list') {
        debug("Looking at $file");
        if (basename($file) eq "debathena.list") {
            checkSourcesList($file, 
                             \%DA_MIRRORS_OK,
                             { $codename => 1 },
                             \%DA_COMPONENTS_OK);
        } elsif (basename($file) eq "debathena.clusterinfo.list") {
            checkSourcesList($file,
                             \%DA_MIRRORS_OK,
                             \%DA_SUITES_OK,
                             \%DA_COMPONENTS_OK);
        } else {
            error("Unknown additional sources.list file ($file)");
        }
    }
}

sub checkAptKeys {
    debug("Checking apt keys...");
    my $apt_keys = qx'/usr/bin/apt-key finger';
    die "Can't run apt-key" unless ($? == 0);
    $apt_keys =~ s/^.*?\n(?=pub)//s;
    foreach my $k (split(/\n\n/, $apt_keys)) {
        if ($k =~ /^\s+Key fingerprint = (.*)\nuid\s+(\S.*)$/m) {
            error("Unknown fingerprint ($1) for key ($2)") unless exists($APTKEYS_OK{$1});
        }
    }
}
        
sub debsums {
    debug("Running debsums");
    # Bad-ideas: Since debsums is itself written in Perl...
    open(DEBSUMS, "/usr/bin/debsums -as 2>&1 |") || die "Can't run debsums";
    foreach my $sum (<DEBSUMS>) {
        chomp $sum;
        if ($sum =~ /^debsums: no md5sums for (\S+)/) {
            error("$sum") unless exists($DEBSUMS_MISSING_PKG_OK{$1});
        } elsif ($sum =~ /^debsums: changed file (\S+)/) {
            error("$sum") unless exists($DEBSUMS_CHANGED_FILE_OK{$1});
        } elsif ($sum =~ /^debsums: missing file (\S+)/) {
            error("$sum") unless exists($DEBSUMS_MISSING_FILE_OK{$1});
        } else {
            error("Unexpected debsums output: $sum");
        }
    }
    close(DEBSUMS);
}

sub checkPackage {
    my $pkgname = shift;
    debug("Checking package $pkgname");
    my $pkg = $cache->{$pkgname};
    unless ($pkg) {
        error("Can't find $pkgname in cache");
        return 0;
    }
#    use Data::Dumper;
#    $Data::Dumper::Maxdepth = 2;
#    print Dumper($pkg);
#    exit;
    if ($pkg->{CurrentState} ne 'Installed') {
        if ($pkg->{CurrentState} eq 'ConfigFiles') {
            wank("Package $pkgname still has config files");
        } elsif ($pkg->{CurrentState} eq 'NotInstalled') {
            wank("Package $pkgname should have been autoremoved.");
        } else {
            error("Package $pkgname in weird state " . $pkg->{CurrentState});
        }
        return 0;
    }
    my $currver = '';
    if ($pkg->{CurrentVer}) {
        $currver = $pkg->{CurrentVer}{VerStr};
    }
    my $fromrepo = 0;
    foreach my $file (@{$pkg->{CurrentVer}{FileList}}) {
        next if ($file->{File}->{IndexType} ne 'Debian Package Index');
        if ($file->{File}->{Origin} =~ /^(Ubuntu|Debathena)$/) {
            $fromrepo = 1;
        }
    }
    if ($pkgname =~ /^linux-(headers|image)-/) {
        wank("Old kernel package ($pkgname) needs cleanup!");
    } else {
        error("$pkgname ($currver) cannot be installed from a repository!") unless ($fromrepo);
    }
}
        
sub checkInstallability {
    debug("Checking installability of installed packages");
    # Todo: multiarch
    my %seen = ();
    # Seriously, why can't I do this natively?
    open(PKGLIST, '/usr/bin/dpkg-query -W -f \'${Package}\n\' |') || die "Can't run dpkg-query";
    while (<PKGLIST>) {
        chomp;
        next if exists($seen{$_});
        $seen{$_} = 1;
        checkPackage($_);
    }
    close(PKGLIST);
}

# __main__

defined($ENV{'APT_CONFIG'}) && wank("APT_CONFIG is defined and shouldn't be");

print LOG "Workstation verification beginning at ", 
    scalar(localtime()), "\n";

# Load configuration from AFS
foreach ('', '-updates', '-security') {
    $SUITES_OK{join('', $codename, $_)} = 1;
}
$DA_SUITES_OK{$codename} = 1;
if (-s "/var/run/athena-clusterinfo.sh") {
    my $apt_release = qx'. /var/run/athena-clusterinfo.sh && echo -n $APT_RELEASE';
    if ($apt_release !~ /^(production|proposed|development)$/) {
        error("Unknown APT_RELEASE value ($apt_release)");
    } elsif ($apt_release ne "production") {
        $DA_SUITES_OK{join('', $codename, '-', $apt_release)} = 1;
        if ($apt_release eq "development") {
            $DA_SUITES_OK{join('', $codename, '-', 'proposed')} = 1;
        }
    }
} else {
    warn("No clusterinfo!");
}
loadConfigFile('mirrors', \%MIRRORS_OK);
loadConfigFile('components', \%COMPONENTS_OK);
loadConfigFile('debathena-mirrors', \%DA_MIRRORS_OK);
loadConfigFile('debathena-components', \%DA_COMPONENTS_OK);
loadConfigFile('aptkeys', \%APTKEYS_OK);
loadConfigFile('debsums-missing-packages', \%DEBSUMS_MISSING_PKG_OK);
loadConfigFile('debsums-missing-files', \%DEBSUMS_MISSING_FILE_OK);
loadConfigFile('debsums-changed-files', \%DEBSUMS_CHANGED_FILE_OK);

$checks{'keys'} && checkAptKeys();
$checks{'sources'} && checkAptSources();
$checks{'debsums'} && debsums();
$checks{'policy'} && checkInstallability();
close(LOG);
if ($errors) {
    exit 1;
}
if ($warns) {
    exit 2;
}
exit 0;