#!/usr/bin/perl
# packagelint v0.1
#
# Checks the permissions of a given package against a known good source.
#
# Shane Celis <shane@gnufoo.org>
# Licensed under the GNU General Public License

use strict;

use Getopt::Std;

my %opts;
getopts('hvg:', \%opts);

if (@ARGV != 1 || exists $opts{h}) {
    print STDERR "usage: packagelint [-hv] [-g goldenbom] <package.pkg>\n";
    print STDERR "      -h show help (this)\n";
    print STDERR "      -v be verbose\n";
    print STDERR "      -g use this bom as the authorative set of permissions\n";
    print STDERR "packagelint checks a package's permissions against a known good source.\n";
    exit 2;
}

my $verbose = exists $opts{v};
my $pkg = shift;
my $bom = "$pkg/Contents/Archive.bom";
my $goldenbom = $opts{g} || "/Library/Receipts/BaseSystem.pkg/Contents/Archive.bom";

my @golden_entries;
my $error = 0;
@golden_entries = readbom($goldenbom);

print "goldenbom: $goldenbom\n" if $verbose;
print "otherbom: $bom\n\n" if $verbose;

# Compare the bom against the goldenbom's contents.
foreach my $entry (readbom($bom)) {
    my %map = parse_entry($entry);
    my $path = $map{path};
    
    my @matches = grep(/\s$path$/, @golden_entries);
    if (@matches == 0) {
        print STDERR "warning: no authorative permissions for path $path\n" if $verbose;
        #$error++;
    } elsif (@matches > 1) {
        print STDERR "warning: found more than one entry in goldenbom for path $path\n";
        print STDERR @matches, "\n";
        $error++;
    } else {
        if (compare_entries($matches[0], $entry) == 0) {
            print "checked: $entry" if $verbose;
        } else {
            $error++;
        }
    }
}

exit $error;

##############
#
# subroutines
#
##############

# Returns an array of bom entries.
# @entries = readbom("./Archive.bom");
sub readbom($) {
    my $bomfile = shift;
    my @entries;
    open(BOM, "lsbom -p mUGF $bomfile |") || die "Cannot open bom: $!\n";
    while (my $line = <BOM>) {
        next if ($line =~ /^\s*$/);  # skip blank lines
        next if ($line !~ /^4[01]/); # skip everything that's not a directory
        next if ($line =~ /\.app/);  # skip all the apps' internal directories
        
        $line =~ s/^\d\d//; # Strip off the first two digits.
        # Those digits identify what kind of file it is.  Is it a
        # directory or a plain file, or some other special device.

        push(@entries, $line);
    }
    close(BOM);
    return @entries;
}

# Compares two bom entries and reports any problems.  Returns 0 for
# success: they are equal.  Returns > 0 for failure: they are not
# equal.
#
# $err = compare_entries(golden, regular)
sub compare_entries($$) {
    my %golden = parse_entry(shift);
    my %regular = parse_entry(shift);
    my $err = 0;
    foreach my $key (qw(perm user group path)) {
        if ($golden{$key} ne $regular{$key}) {
            print STDERR "error: expected $key \"$golden{$key}\" for file $regular{path}; it had \"$regular{$key}\" instead.\n";
            $err++;
        } 
    }
    return $err;
}

# Parses an entry into a hashmap with the following keys: perm, user,
# group, and path.
#
# %map = parse_entry("775    root    admin   \".\"");
sub parse_entry($) {
    my $entry = shift;
    my %map;
    if ($entry =~ /(\d+)\s+(\S+)\s+(\S+)\s+(\S+)/) {
        $map{perm} = $1;
        $map{user} = $2;
        $map{group} = $3;
        $map{path} = $4;
    } else {
        print STDERR "warning: unable to parse entry \"$entry\"\n";
    }
    return %map;
}