#!/usr/bin/perl
#
#
# use the ls-lR file to fix ownership and permission info
#
# usage: `./fixmog --help` for more info
# 
# Freely distributable under the Gnu Public License (see http://www.gnu.org
# for details). Comes with no warranty -- use at your own risk!
#
# Original version:
# fixperm.pl,v 1.4 2000/04/26 17:18:56
# Author: Yoonsuck Choe <yschoe@cs.utexas.edu>
#
# Changes: Jon Svejgaard, jon@ace.dk
#	- name changed from fixperm.pl to fixmog in
#	  commemoration of SCO Open Server 5.x
#	- program basename isolated for diagnostics
#	- print diagnostics to STDERR
#	- check for running as root
#	- fixing of broken symbolic links
#	- start in "." default
#	- fixed error in GetOptions call
#	- eliminated chdir to subdirectories ("full" path used anyway)
#	- explicit check for total line rather than
#	  automatic read of next line after dirname line
#	- full handling of both "s" bits and of "t" bit
#	- check for user and group existence in /etc/passwd,group
#	- change calls of "system" to calls of corresponding perl
#	  functions to avoid overhead of forking shell etc.
#	- put perms file(s) in /somedir/whatever for checking by package
#	- add package name as a parameter
#	- "verify" option changed to "check" option
#	- introduced "version" option
#	- fixed incorrect handling of file names containing space
#
# Bugs:
#	- MUST have directory parameter
#	  Well, this isn't a bug, really. But if it's
#	  a requirement that a file produced by "ls -lR"
#	  is all we need to do this, we have to accept it
# 
use Getopt::Long;
#
# Configure: filenames and paths
#
$permsfile = "perms";		# Default permissions file
$defaultdir = ".";		# Default starting directory
$permsdir = "/etc/perms";	# Default repository for perms files
$version = "2.1.a";

#
# Usage 
#
$usage = <<EOF; 
usage: fixmog [-h] [-f <ls-lR file>] [-d <directory>] [-b] [-v] [-p <package>]

	This little Perl script for fixing the permission and 
	ownership info from an 'ls-lR' file.

	-v (or --Version) : prints current version and exits
	-p (or --package) : name of perms 'ls-lR' file in $permsdir
	-f (or --filename) : the full path of the 'ls-lR' file (*)
	-d (or --directory) : the full path of the directory to check(*)
	-h (or --help):	display this help message
	-b (or --babble) : print correct permission, owner, and full path
		while fixing. Off by default.
	-c (or --check) : check for broken files or file size differences.
		Somehow, entries with 'ls-lR.gz' has a lot of minor
		differences. You can skip these by piping the output 	
		Through `| grep -v ls-lR`.
	
		(*) If not specified, default values are used.
		Defaults can be changed by editing the script.
		Current defaults: 
			-f = $permsfile
			-d = $defaultdir
EOF

#----------------------------------------------------------------------------
# Start main script : no need to modify anything below here
#----------------------------------------------------------------------------
#
# Isolate program name
#
$prog=(split(/\//,$0))[-1];

#
# Get options
#
&GetOptions("filename=s","directory=s","package=s","help","babble","check","Version");

if ($opt_Version) {
	print "$prog $version\n";
	exit;
}

if ($opt_help) {
	print STDERR $usage;
	exit;
}

#
# Check userid
#
unless ($> == 0) {
	print STDERR "$prog: error: must run as root\n";
	exit;
}

#
# Default ls-lR file : give full path
#
$opt_filename = ($opt_filename)?($opt_filename):$permsfile;
if ($opt_package) {
	$opt_filename = "$permsdir/$opt_package";
}

#
# Default directory : give full path
#
$opt_directory = ($opt_directory)?($opt_directory):$defaultdir;

if ($opt_babble) {
	print "Running $prog on $opt_filename in $opt_directory at ";
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
	print $year+1900,"-",$mon+1,"-$mday $hour:$min:$sec\n";
}

#
# Build hashes of known usernames,UIDs and groupnames,GIDs
#
while (($name,$pw,$uid)=getpwent) {
	$uids{$name}=$uid;
}
while (($name,$pw,$gid)=getgrent) {
	$gids{$name}=$gid;
}

#
# Open ls-lR file and proceed
#
open(FP,$opt_filename);

#
# Goto start directory
#
chdir "$opt_directory";

while (<FP>) {
	chop;
	if (/.*:$/) {
#
# Case 1 : this line is a directory name
#
		chop; # chop off trailing character ':'
		$curdir = $_;
#		chdir "$opt_directory/$curdir";
		next;
	} elsif (/otal [0-9]+$/) {
#
# Case 2 : total line
#
		next;
	} else {
#
# Case 3 : these are files.
#
		if (/[\S]+/) { # do this only if the line is not blank
#
# 2.1 Get file attributes, check file size, existence
#
			if ($_ =~ /^[cb]/) {
				($perm,$links,$owner,$group,$major,$minor,$mon,$dat,$timeyear,$fname,$delim,$target,@rest) = split(/[\s]+/);
			undef $size;
			} else {
				($perm,$links,$owner,$group,$size,$mon,$dat,$timeyear,$fname,$delim,$target,@rest) = split(/[\s]+/);
			}
			unless ($delim eq "->") {
				foreach $f ($delim,$target,@rest) {
					$fname.=" ".$f if ($f);
				}
			}

#
# 2.1.1 Get permission bits
#
			@permbits = split(//,$perm);
			$type=shift(@permbits); # get type (directory, device, etc)
			$fullpath = "$opt_directory/$curdir/$fname";
			if (-e "$fullpath") {
				@fstat = stat("$fullpath");
#
# ignore symbolic links in size check
#
				if ($fstat[7]!=$size && -f $fullpath && !-l $fullpath) {
					print STDERR "$prog: error: file size differs "
						."$fstat[7] != $size: $fullpath\n";
					next;
				}
			} else {
				if ($type eq "c" || $type eq "b") {
					print STDERR "$prog: warning: $fullpath $delim: missing device node";
					unless ($opt_check) {
						system("mknod $fullpath $type $major $minor");
# print "mknod $fullpath $type $major $minor\n";
						print STDERR "(fixed)";
					}
					print STDERR "\n";
				} elsif ($type eq "l") {
					print STDERR "$prog: warning: $fullpath $delim $target: broken link";
					unless ($opt_check) {
#
# Fix broken link
#
						symlink($target,$fullpath);
						print STDERR "(fixed)";
					}
					print STDERR "\n";
				} else {
					print STDERR "$prog: error: file does not exist: $fullpath \n";
					next;
				}
			}
#
# Check for existing user
#
			unless (defined($uids{$owner})) {
				unless ($missuid{$owner}) {
					$missuid{$owner}++; # warn only once
					print STDERR "$prog: error: user $owner does not exist\n";
				}
				next;
			}
#
# Same for group
#
			unless (defined($gids{$group})) {
				unless ($missgid{$group}) {
					$missgid{$group}++;
					print STDERR "$prog: error: group $group does not exist\n";
				}
				next;
			}
#
# Skip rest if check only
#
			if ($opt_check) {
				next;
			}

#
# 2.2 Construct permissions bit pattern
#
			$permoctal = 0;
			$permprefix = 0;
			$bitcnt=0;
			while($bit=shift(@permbits)) {
				$bitcnt++; # rules setting of suid or sgid bit
				$permoctal *=2;
				$permoctal++ if ($bit ne '-');
				if ($bit eq 's') { # suid/sgid bit is set
					$permprefix += ($bitcnt < 4)?4:2;
				} elsif ($bit eq 't') { # tricky bit set
					$permprefix += 1;
				}
			}	
#
# 2.3 Obtain the octal form plus the setuid prefix.
#
			$permstr = sprintf("%o%o",$permprefix,$permoctal);	
			 
#
# 2.4 Print info and apply chown and chmod
#
			$uid=$uids{$owner};
			$gid=$gids{$group};

			if ($opt_babble) {
				print "$perm $permstr $owner($uid):$group($gid) $fullpath $delim $target\n";
			}
			chown($uid,$gid,$fullpath);
			chmod(oct($permstr),$fullpath);
		}
	}
}

close(FP);