#!/usr/bin/perl -w

use strict;
use warnings;
#use diagnostics;

#######################################################################
# Name: comparepkg
# 
# Purpose: Compares the permissions/ownership of files listed in
# Slackware's MANIFEST file with the files on the system. Prints message
# if permissions/ownerships don't match.
#
# Uses: If you've made a major error with chmod -R as root, or you want
# to check for 'sane' permission for security reasons, this script will
# be helpful.
#
# Usage: perl scriptname.pl < MANIFEST
#        Type perldoc ./scriptname.pl for documentation.
#
# Author: Mark Hill <comparepkg at mark dot ukfsn dot org>
#
# License: Distribute under the same terms as Perl itself
#
# Last modified: $Date: 2004/05/26 21:32:45 $
#
# Version: 0.0.5
#
# Changelog:
#
# 0.0.6:
# Fixed to skip over new 'hard-link' entries in MANIFEST that are
# created by tar 1.14 onwards.
#
# 0.0.5:
# Added --skip-ttys and --skip-bindirs options. (The perldoc has the
# info on them.)
#
# 0.0.4: 
# Added error checking for getpwuid and getgrgid etc. 
# Added extra checks for uid/gid hashes.
# 
# 0.0.3: 
# First release
#######################################################################

## Get command-line options
use Getopt::Long;

my ($help_opt, $debug_opt, $perms_opt, $user_opt, $group_opt, $all_opt, 
	$skipttys_opt, $skipbindirs_opt ) = undef;
GetOptions ('help' => \$help_opt,
			'debug' => \$debug_opt,
			'permissions' => \$perms_opt,
			'perm' => \$perms_opt,
			'user' => \$user_opt,
			'group' => \$group_opt,
			'skip-ttys' => \$skipttys_opt,
			'skip-bindirs' => \$skipbindirs_opt);

unless (defined $perms_opt or defined $user_opt or defined $group_opt) {
	$all_opt=1;
}


if ($help_opt) {
	help();
	exit;
}


# These are the hashes used to cache uid/gid and username/groupname
# look-ups
my %user_table if defined $user_opt or defined $all_opt;
my %group_table if defined $group_opt or defined $all_opt;


while (<>) {
	next if $_ =~ /^\+/;  #
	next if $_ =~ /^\|/;  #->Skip over the title areas and blank lines
	next if $_ =~ /^\s/;  #  in the file.
	next if $_ =~ /^h/;   #->Skip over "hard link" entries created
						  #  by tar 1.14 onwards.

	chomp;

	my @line = split;
	# @line elements: perms[0] owner/group[1] size[2] date[3] time[4] filename[5]; 

	if (defined $line[5] && -e "/$line[5]") {
		# if file listed on this line exists...

		stat("/$line[5]"); # Get info about this file

		## skip-ttys option
		next if (defined $skipttys_opt and $line[5]=~/dev\/tty*/);

		## permissions compare
		if (defined $line[0]) {
			if (defined $perms_opt or defined $all_opt) {
				check_file_perms($line[0],$line[5]);
			}
		} else {
			die "Error with perms: $!";
			# $line[0] shouldn't be undef so die
		}

		## owner/group compare
		if (defined $line[1]) {
			my @user_and_group = split(/\//, $line[1]); 
			# split the "user/group" line

			if (defined $user_opt or defined $all_opt) {
				user_compare($user_and_group[0],$line[5]);
			}


			if (defined $group_opt or defined $all_opt) {
				next if defined $skipbindirs_opt and $line[5] eq 'bin/';
				next if defined $skipbindirs_opt and $line[5] eq 'sbin/';
				next if defined $skipbindirs_opt and $line[5] eq 'usr/bin/';
				next if defined $skipbindirs_opt and $line[5] eq 'usr/sbin/';
				group_compare($user_and_group[1],$line[5]);
			}

		} else {
			die "No owner/group could be found: $!";
			# if $line[1] is undef there's something very wrong
		}
	}

}


sub check_file_perms {
	## compare file permissons
	#
	# This sub compares the perms the file has in MANIFEST with perms
	# the file has on the system

	my $perms = shift;
	my $filename = shift;

	my $system_file_perms = (stat(_))[2];

	$system_file_perms = sprintf "%04o", $system_file_perms & 07777;
	# remove file mode and leave permissions

	my $manifest_file_perms = sprintf "%04o", lsmode($perms) & 07777;

	if ( $manifest_file_perms ne $system_file_perms) {
		printf "File Permissions: /%s is %04u but %04u in MANIFEST\n", 
		$filename, $system_file_perms, $manifest_file_perms;
	}


}

sub user_compare {
	## compare uid ownership 

	my $username = shift;
	my $filename = shift;

	my $system_file_uid = (stat(_))[4];

	my $system_file_username;
	my $manifest_uid;

	# Look up usernames/uids in %user_table
	while (my ($key, $value) = each(%user_table)) {
		if (defined $value and $value == $system_file_uid) {
			$system_file_username = $key;
		}
		if (defined $key and $key eq $username) {
			$manifest_uid = $value
		}
	}

	unless (defined $system_file_username) {
		print "*** Getting name for uid $system_file_uid\n" if $debug_opt;
		$system_file_username = getpwuid($system_file_uid) or 
			$system_file_username = "unknown user";
		$user_table{$system_file_username} = $system_file_uid;
	}

	unless (defined $manifest_uid) {
		print "*** Getting uid for $username\n" if $debug_opt;
		$manifest_uid = getpwnam($username);
		unless (defined $manifest_uid) {
			$manifest_uid = "-1";
		}
		$user_table{$username} = $manifest_uid;
	}

	unless ($manifest_uid == $system_file_uid) {
		printf "User Ownership: /%s is uid %u (%s) on system but uid %d (%s) in MANIFEST\n", 
		$filename, $system_file_uid, $system_file_username, $manifest_uid, $username;
	}

}

sub group_compare {
	## compare group ownership
	 
	my $groupname = shift;
	my $filename = shift;

	my $system_file_gid = (stat(_))[5];

	my $system_file_groupname;
	my $manifest_gid;
	
	while (my ($key, $value) = each(%group_table)) {
		if (defined $value and $value == $system_file_gid) {
			$system_file_groupname = $key;
		}
		if (defined $key and $key eq $groupname) {
			$manifest_gid = $value;
		}
	}

	unless (defined $system_file_groupname) {
		print "### getting group for gid $system_file_gid\n" if $debug_opt;
		$system_file_groupname = getgrgid($system_file_gid) 
			or $system_file_groupname = "unknown group";
		$group_table{$system_file_groupname} = $system_file_gid;
	}
	
	unless (defined $manifest_gid) {
		print "### getting gid for group $groupname\n" if $debug_opt;
		$manifest_gid = getgrnam($groupname);
		unless (defined $manifest_gid) {
			$manifest_gid = "-1";
		}
		$group_table{$groupname} = $manifest_gid;
	}


	unless ($manifest_gid == $system_file_gid) {
		#printf "Group ownership: /%s is gid %u on system but is gid %u in MANIFEST\n", 
		#$filename, $system_file_gid, $manifest_gid;
		printf "Group Ownership: /%s is gid %u (%s) on system but gid %d (%s) in MANIFEST\n", 
		$filename, $system_file_gid, $system_file_groupname, $manifest_gid, $groupname;
	}

}

sub lsmode {
# This sub nabbed from Stat::lsMode
#
# Copyright 1998 M-J. Dominus 
# (mjd-perl-lsmode@plover.com)
#
# Distributed under the same terms as Perl itself
#
# This sub converts ls -l like permissons to their octal
# equivalent

	my @perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
	my %smerp = map {$perms[$_] => $_} (0 .. $#perms);
	my @ftype = ('', qw(p c ? d ? b ? - ? l ? s ? ? ?));
	my %typef = map {$ftype[$_] => $_} (0 .. $#ftype);

	my $lsmode = shift;
	my ($type, $user, $group, $other);
	my $ld;

	if (length($lsmode) == 9) { 
		($user, $group, $other) = unpack "A3 A3 A3", $lsmode;
		$ld = 0;
	} elsif (length($lsmode) == 10) {
		($type, $user, $group, $other) = unpack "A1 A3 A3 A3", $lsmode;
		$ld = $typef{$type} 
			or die("Mode `$lsmode' begins with unrecognized character `$type'");
		$ld = sprintf "%01o", $ld; 
	} else {
		die "Unrecognizable mode `$lsmode'";
	}

	# Fix sticky bit?
	if ($other =~ /s$/i) {
		die "Mode `$lsmode' may not end with `s'; aborting";
	}

	my $octperm = '';
	my $setuid = 0;
	foreach my $perm ($user, $group, $other) {
		# LOD
		$setuid = $setuid * 2 + ($perm =~ s/([st])$/($1 eq lc $1)?'x':'-'/ie);
		$octperm .= $smerp{$perm};
	}

	my $perm = oct(sprintf "0$ld$setuid$octperm"); # MH: best to leave this conversion
	$perm;
}

sub help {
	print <<END;

$0 [options] < [slackware manifest file]

Options: 

	--help            brief help message
	--perm            compare file permissions
	--user            compare user ownership
	--group           compare group ownership
	--skip-ttys       don't check /dev/tty* devices
	--skip-bindirs    don't check bin dir group ownerships


Type 'perldoc /path/to/this/script' for full documentation

END

}

__END__

=head1 NAME 

comparepkg - compare attributes of files on the system with their
listing in Slackware's MANIFEST file

=head1 SYNOPSIS 

comparepkg [options] < [slackware manifest file]

Options: 

	--help            brief help message
	--perm            compare file permissions
	--user            compare user ownership
	--group           compare group ownership
	--skip-ttys       don't check /dev/tty* devices
	--skip-bindirs    don't check bin dir group ownerships

=head1 DESCRIPTION

comparepkg takes input from a decompressed MANIFEST file and compares
listed files with files found on the system. 

If a file listed in MANIFEST is found on the system, checkpkg compares
the file attributes listed in MANIFEST with the file found on the
system. If there are any differences between the two sets of attributes,
they are printed to STDOUT. By default, checkpkg will report differences
in permissions, user ownerships and group ownerships.

As the default output can sometimes be very long, the --perm, --user and
--group options exist to limit checking and reporting to file
permissions, user ownership or group ownership respectively.

=head1 NOTES

/dev/tty* ownerships and permissions change depend on who is using them
or who has used them last, so messages about them are usually best
ignored. If you don't want to check the /dev/tty* devices use the
--skip-ttys option.

Common 'bin' directories like /usr/bin/ are sometimes assigned to the
root group in packages when they should be assigned to the bin group.
This is a "bug" of sorts in the affected packages but isn't really
something to worry about. The --skip-bindirs option will skip the
checking of group ownerships for the affected directories. (The dirs
that will be skipped are /bin, /sbin, /usr/bin/ and /usr/sbin.)

For best results, use the most up-to-date MANIFEST file for your system.

=head1 AUTHORS

Mark Hill <comparepkg at mark dot ukfsn dot org>

lsmode sub-routine written by M-J. Dominus (mjd-perl-lsmode at
plover.com) (c) 1998. lsmode is part of the Stat::lsmode module.

=cut