#!/usr/bin/perl
# $Id: fixperm.pl,v 1.4 2000/04/26 17:18:56 yschoe Exp yschoe $
#
# use the ls-lR file to fix ownership and permission info
# for Redhat distributions. Only the top-level ls-lR file should
# be used, and actually it is all that you need.
#
# usage: `./fixperm.pl --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!
#
# Author: Yoonsuck Choe <yschoe@cs.utexas.edu>
# 
#----------------------------------------
# Configure: filenames and paths
#----------------------------------------
$lsfile = "/cdtmp/yschoe/redhat6.2/ls-lR";
$redhatdir = "/cdtmp/yschoe/redhat6.2";

#----------------------------------------
# Usage 
#----------------------------------------
$usage = <<EOF; 
usage: fixperm.pl [-h] [-f <ls-lR file>] [-d <redhat directory>] [-b] [-v]

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

	-f (or --filename) : the full path of the 'ls-lR' file (*)
	-d (or --directory) : the full path of the Redhat directory (*)
	-h (or --help)	: display this help message
	-b (or --babble) : print correct permission, owner, and full path
		while fixing. Off by default.
	-v (or --verify) : check for missing 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 = $lsfile
			-d = $redhatdir


EOF
$usage .= '$Id: fixperm.pl,v 1.4 2000/04/26 17:18:56 yschoe Exp yschoe $';
$usage .= "\n\n";

#----------------------------------------------------------------------------
# Start main script : no need to modify anything below here
#----------------------------------------------------------------------------

#--------------------
# Get options
#--------------------
use Getopt::Long;
&GetOptions("filename=s","directory\s","help","babble","verify");

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

# Default ls-lR file : give full path
$opt_filename = ($opt_filename)?($opt_filename):$lsfile;

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

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

while (<FP>) {

  chop;

  if (/.*:$/) {
  #--------------------
  # Case 1 : this line is a directory name
  #--------------------
	chop; # chop off trailing character ':'
	$curdir = $_;
	chdir "$opt_directory/$curdir";
	$_ = <FP>; # Skip total size line
  } else {
  #--------------------
  # Case 2 : these are files.
  #--------------------
	if (/[\S]+/) { # do this only if the line is not blank
  		#--------------------
		# 2.1 Get file attributes and check file size and existence
  		#--------------------
		($perm,$links,$owner,$group,$size,$mon,$dat,$timeyear,$fname)
			= split(/[\s]+/);

		$fullpath = "$opt_directory/$curdir/$fname";
		if (-e "$fullpath") {
			@fstat = stat("$fullpath");
			# ignore symbolic links
			if ($fstat[7]!=$size && -f $fullpath && !-l $fullpath) {
				print "error: file size differs "
					."$fstat[7] != $size: $fullpath\n";
				next;
			}
		} else {
			print "error: file does not exist: $fullpath \n";
			next;
		}
		if ($opt_verify) {
			next;
		}

  		#--------------------
		# 2.2 Get permission bits
  		#--------------------
		@permbits = split(//,$perm);
		shift(@permbits); # get rid of type (directory, device, etc)
		
  		#--------------------
		# 2.3 Convert permission to octal form
  		#--------------------
		$permoctal = 0;
		$permprefix = '';
		while($bit=shift(@permbits)) {
			if ($bit ne '-') { # Bit is set
				$permoctal = $permoctal*2 + 1;
			} else { 	   # Bit is not set
				$permoctal = $permoctal*2 + 0;
			}
			if ($bit eq 's') { # suid bit is set
				# BIG assumption: all 's'es occuring
				# in whatever location is regarded as
				# setuid. I found no setgid bits set in
				# the standard Redhat ls-lR files.
				$permprefix = '4';
			}
		}	
		# obtain the octal form 'plus' the setuid prefix, if any.
		$permstr = sprintf("%s%o",$permprefix,$permoctal);	
			 
		#--------------------
		# 2.4 Print info and run chwon and chmod
		#--------------------
		if ($opt_babble) {
			print "$perm $permstr $owner:$group $fullpath\n";
		}
		system "chown $owner:$group $fullpath\n";
		system "chmod $permstr $fullpath\n";
	}
  }
}

close(FP);