compstool

#!/usr/bin/perl -w
#
# compstool -- Tool for verifying the integrity of comps files
# 
# Copyright (C) 2001-2007, Michael Jennings
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies of the Software, its documentation and marketing & publicity
# materials, and acknowledgment shall be given in the documentation, materials
# and software packages that this Software was used.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
# IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# $Id: compstool,v 1.11 2007/02/27 21:29:36 mej Exp $
#

# Include the Perl Modules we need
require POSIX;
require Getopt::Long;
use Mezzanine::Util;

# Print usage information
sub
print_usage_info
{
    print "\n";
    $leader = "$progname $version Usage Information";
    $underbar = $leader;
    $underbar =~ s/./-/g;
    print "$leader\n$underbar\n";
    print "\n";
    print "  Syntax:   compstool [ options ]\n";
    print "\n";
    print "    -h --help                        Show this usage information\n";
    print "    -d --debug                       Turn on debugging\n";
    print "    -v --version                     Show version and copyright\n";
    print "    -D --dir <directory>             Specify \"directory\" as the full path to the CD image\n";
    print "    -a --arch <architecture>         Specify the architecture to check\n";
    print "\n";
    exit(MEZZANINE_SUCCESS);
}

sub
parse_comps_file
{
    my ($comps, $pkgdir, $arch) = @_;
    local (*COMPS);
    my ($line, $pkg, $rpm);
    my (@pkgs, @rpms, @missing, @ignored);

    dprint "Parsing comps file at $comps using package directory $pkgdir\n";
    @rpms = grepdir {$_ =~ /\.rpm$/} $pkgdir;

    open(COMPS, $comps) || &fatal_error("Unable to open comps file ($comps) -- $!\n");
    while (<COMPS>) {
        my $testarch;

        chomp($line = $_);
        next if ($line =~ /^\s*\d\s*$/ || $line =~ /[\{\}]/);
        next if ($line !~ m/^\s*([^:]+:)?\s*(\S+)\s*$/);
        dprint "Examining line:  $line\n";
        if ($1 && $1 !~ /^\(\S+\):$/) {
            ($testarch, $pkg) = ($1, $2);
            $testarch =~ s/:$//;
            dprint "Detected arch test for $pkg:  $testarch\n";
        } else {
            $pkg = $2;
            $testarch = $arch;
            dprint "Package $pkg included regardless.\n";
        }
        if (($testarch =~ /^\!/ && $arch ne substr($testarch, 1, 999)) || ($arch eq $testarch)) {
            dprint "Adding $pkg to package list.\n";
            xpush(@pkgs, $pkg);
        }
    }
    close(COMPS);

    foreach my $pkg (@pkgs) {
        dprint "Looking at comps file package $pkg\n";
        if (!grep($_ =~ /\Q$pkg\E-[^-]+-[^-]+\.[^\.]+\.rpm/, @rpms)) {
            dprint "$pkg is missing\n";
            xpush @missing, $pkg;
        }
    }

    foreach my $rpm (@rpms) {
        my $rpmfile = &basename($rpm);

        dprint "Looking at package file $rpmfile\n";
        ($pkg = $rpmfile) =~ s/-[^-]+-[^-]+\.[^\.]+\.rpm//;
        if (!grep($_ eq $pkg, @pkgs)) {
            dprint "$rpmfile ($pkg) is ignored.\n";
            push @ignored, $pkg;
        }
    }

    if (scalar(@ignored)) {
        print "The following packages are not referenced:  \n   ", join("\n   ", sort(@ignored)), "\n";
    }
    if (scalar(@missing)) {
        eprint "The following packages are missing:  \n   ", join("\n   ", sort(@missing)), "\n";
        return MEZZANINE_MISSING_PKGS;
    } else {
        print "All packages verified.\n";
        return MEZZANINE_SUCCESS;
    }
}

# main() here is basically the same as main() in C
sub
main
{
    my $ret;

    # Set up the basic variables
    $progname = "compstool";
    $version = "1.0";
    &print_usage_info() if (!scalar(@ARGV));
    umask 022;

    # See the Getopt::Long man page for details on the syntax of this line
    @valid_opts = ("h|help", "v|version", "d|debug", "D|dir=s", "a|arch=s");
    Getopt::Long::Configure("no_getopt_compat", "bundling", "no_ignore_case");
    Getopt::Long::GetOptions(@valid_opts);

    # Post-parse the options stuff
    select STDOUT; $| = 1;
    if ($opt_v) {
        # Do not edit this variable.  It is updated automatically by CVS when you commit
        my $rcs_info = 'CVS Revision $Revision: 1.11 $ created on $Date: 2007/02/27 21:29:36 $ by $Author: mej $ ';

        $rcs_info =~ s/\$\s*Revision: (\S+) \$/$1/;
        $rcs_info =~ s/\$\s*Date: (\S+) (\S+) \$/$1 at $2/;
        $rcs_info =~ s/\$\s*Author: (\S+) \$ /$1/;
        print "\n";
	print "$progname $version by Michael Jennings <mej\@eterm.org>\n";
        print "Copyright (c) 2001-2007, Michael Jennings\n";
        print "  ($rcs_info)\n";
        print "\n";
	return MEZZANINE_SUCCESS;
    } elsif ($opt_h) {
	&print_usage_info();   # Never returns
    }

    &debug_set($opt_d);
    $imagedir = ($opt_D ? $opt_D : "");
    $arch = ($opt_a ? $opt_a : "i386");

    # Signal handling
    $SIG{HUP} = 'IGNORE';
    $SIG{INT} = \&handle_signal;
    $SIG{TERM} = \&handle_signal;
    $SIG{QUIT} = \&handle_fatal_signal;
    $SIG{ILL} = \&handle_fatal_signal;
    $SIG{ABRT} = \&handle_fatal_signal;
    $SIG{FPE} = \&handle_fatal_signal;
    $SIG{SEGV} = \&handle_fatal_signal;
    $SIG{BUS} = \&handle_fatal_signal;
    $SIG{TSTP} = \&handle_fatal_signal;
    $SIG{TTIN} = \&handle_fatal_signal;
    $SIG{TTOU} = \&handle_fatal_signal;

    $ret = &parse_comps_file("$imagedir/RedHat/base/comps", "$imagedir/RedHat/RPMS", $arch);

    return $ret;
}

exit &main();