#!/usr/bin/perl
# DocumentId:	$Id: emuga-target.pl 1585 2003-01-24 08:10:10Z ola $
# Author:	$Author: ola $
# Date:		$Date: 2003-01-24 09:10:10 +0100 (fre, 24 jan 2003) $
# Version:	$Revision: 1.5 $
# Summary:
#	This script handles the structure modifications to allow you to
#	have a read and write group at the same time. This is possible
#	by using a extra directory and by symlinking.

###############################################################################
# Some things to know.
#
# Structure style:
# [.readgroup/]targetname
# symbolic target ->
#
# Only the ones before the last specified (in order read, write) have
# to have a .group directory. The reason why browse was removed is that
# that is not possible to set in a general way, and because read but not
# browse is not possible to perform if we use symbolic links to the
# target.
###############################################################################

###############################################################################
############################# USES ############################################
# Changes:
#	2002-02-11 Ola Lundqvist <opal@debian.org>
#		Wrote the uses.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#		Added File::Copy for copy and move functions.
#		Added File::Basename for baseDir handling.
#		Added File::Find for find function.
###############################################################################

use File::Path qw(mkpath);
use OpaL::action qw(pdebug action
		    setDebugLevel setQuitLevel
		    setErrorHandler);
use OpaL::read qw(readfile readcommand);
use File::Copy;
use File::Basename;
use File::Find;

###############################################################################
########################### DEFAULTS ##########################################
# Changes:
#	2002-02-11 Ola Lundqvist <opal@debian.org>
#		Started writing it.
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#		Quite complete.
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#		Removed option for browse.
###############################################################################

%setGroup = ();
#%setGroup =
#    (read => "",
#     write => "");
%setGroupIndex =
    (write => ["read", "write"],
     read => ["read"]);
$recursive = 1;
$sgidChange = 1;
$fixMode = 0;
$printPerms = 1;
$niceMode = 1;

###############################################################################
######################### PREPARATIONS ########################################
# Description:
#	Fix for bug in opalmod.
# Changes:
#	2002-02-11 Ola Lundqvist <opal@debian.org>
#		Wrote the uses.
###############################################################################

setErrorHandler(undef);

###############################################################################
############################# HELP ############################################
# Changes:
#	2002-02-11 Ola Lundqvist <opal@debian.org>
#		Started writing it.
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#		Quite complete.
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#		Removed option for browse.
#		Added information about which ones that are not implemented.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#		Now these are implemented --fix, -R, -n, -N.
#	2002-02-15 Ola Lundqvist <opal@debian.org>
#		Now these are implemented -s and -S.
#		Decided not to implement the -Q, -q options.
###############################################################################

$help = "
emuga-target [options] target [ [options] target [...] ]

options:
  --dl nr | --debug-level nr
	Debug level (for debugging).
  --ql nr | --quit-level nr
	Quit level (for debugging).
  -N	Not nice (chown, chgrp for all groups).
  -n    Nice (chown, chgrp only for the group owning the target), default.
  -R	Do not run chmod, chgrp recursively.
  -S	Do not change the sgid bit, see -s below.
  -s	Change the sgid bit for the writegroup (default). This affects
	recursive changes for writegroup and also recursive changes when
        it is removed or replaced with a readgroup.
  -r readgroup
        The group defined here is the one that should have read
	permission on the target (and possibly subtargets).
  -w writegroup
	The group that should have write permission to the target
	(and possibly subtargets).
  --fix
	Fix problems that can be fixed automaticly (defult no).
  --help
	Print this help.

target:
  The target is a file or directory. To make it really usable directories are
  preferred.
    
  If no read or write-group is specified it only prints the old
  permissions of the target(s).  

Observe that the created directory structure makes an AND operation of the
read and write access. The write permission implies read access but you
can restrict read access by not adding the user to the read group if you want
to do that (the effect is that you will probably not get write access either).

Setting a empty (\"\") read or write group will unset that group. Note that
there is no way to unset a group. You have to specify new permissions.

";

###############################################################################
############################# ARGS ############################################
# Desctiption:
#	The actual script. It handles all arguments in order.
# Changes:
#	2002-02-11 Ola Lundqvist <opal@debian.org>
#		Started writing it.
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#		Quite complete.
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#		Removed option for browse.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#		Added option --fix, -R, -n, -N,  -s and -S.
###############################################################################

while ($_ = shift @ARGV) {
    if (/^--/) {
	if (/^--dl$/ || /^--debug-level$/) {
	    setDebugLevel(shift @ARGV);
	}
	elsif (/^--ql$/ || /^--quit-level$/) {
	    setQuitLevel(shift @ARGV);
	}
	elsif (/^--help$/) {
            print($help);
	    exit 0;
	}
	elsif (/^--fix$/) {
	    $fix = 1;
	}
	else {
            pdebug(3, "Unknown option $_.");
	}
    }
    elsif (/^-$/) {
	pdebug(3, "Unknown option '-'.");
    }
    elsif (/^-/) {
	s/^\-//;
	my $t = $_;
	foreach (split //, $t) {
	    if (/r/) {
		$setGroup{read} = shift @ARGV;
		checkGroup($setGroup{read});
		pdebug(5, "setread = $setGroup{read}");
	    }
	    elsif (/w/) {
		$setGroup{write} = shift @ARGV;
		checkGroup($setGroup{write});
		pdebug(5, "setwrite = $setGroup{write}");
	    }
            elsif (/R/) {
		$recursive = 0;
	    }
	    elsif (/S/) {
		$sgidChange = 0;
	    }
	    elsif (/s/) {
		$sgidChange = 1;
	    }
	    elsif (/N/) {
		$niceMode = 0;
	    }
	    elsif (/n/) {
		$niceMode = 1;
	    }
	}
    }
    else {
	pdebug(5, "setGroup = ".stringHash(%setGroup)."\n");
	s/\/$//;
	if (-e $_) {
	    $baseDir = dirname($_);
	    $baseDir .= "/" if ($baseDir ne "");
	    pdebug(5, "baseDir = $baseDir");
	    pdebug(5, "target  = ".basename($_));
	    handleTarget(basename($_));
	}
	else {
	    pdebug(3, "Target $_ does not exist.");
	}
    }
}

###############################################################################
# Name:		relative
# Arguments:	target
# Returns:	$baseDir/target
# Changes:
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#		Wrote it.
###############################################################################
sub relative($) {
    my ($target) = @_;
    return "$baseDir$target";
}

###############################################################################
# Name:		handleTarget
# Arguments:	target to handle
# Desctiption:  Handles a specified target as it is supposed to.
# Status: NOT DONE, NOT TESTED.
# Changes:
#	2002-02-11 Ola Lundqvist <opal@debian.org>
#		Started writing it.
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#		A initial version that could check a symbolic link.
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#		Started to handle more than a link. Had to change it some.
#		Especially because I was beginning with the new style.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#		Use relative now.

###############################################################################
sub handleTarget($) {
    my ($target) = @_;
    pdebug(5, "======= HANDLE TARGET $target =====");
    my $permTarget = $target;
    if (-l relative($target)) {
	pdebug(5, "Target $target is a symbolic link.");
	$permTarget = readlink relative($target);
	pdebug(5, "Points to $permTarget.");
    }
    my %oldSetGroup = permHash($permTarget, $target);
    pdebug(5, "oldGroups = ".stringHash(%oldSetGroup));
    pdebug(5, "oldDirs = ".stringHash(permissionTarget($target, %oldSetGroup)));
    pdebug(5, "newGroups = ".stringHash(%setGroup));
    # Now calculate the difference between the two hashes.
    # Now change stuff.
    if (! changeTarget($target, $permTarget,
		       \%setGroup, \%oldSetGroup)) {
	# No change, print it?
	my $middle = "";
	foreach $tmp (@{$setGroupIndex{"write"}}) {
	    if ($oldSetGroup{$tmp} ne "") {
		print ("$middle$tmp=$oldSetGroup{$tmp}");
		$middle = " ";
	    }
	}
	print(": ".relative($target)."\n");
    }
}

###############################################################################
# Name:		changeTarget
# Arguments:	symbolic target
#		old permission target
#		new permission hash
#		old permission hash
# Status:	NOT DONE, NOT FULLY TESTED
# Changes:
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#               Wrote beginning of it.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Continued the work. It can do everything except the recursive
#		chmod operation.
#	2002-02-15 Ola Lundqvist <opal@debian.org>
#		Final work for the recursion. Just some debugging here.
###############################################################################
sub changeTarget {
    my $symbolicTarget = shift;
    my $oldPermTarget = shift;
    my $nph = shift;
    my %newPH = %$nph;
    my $oph = shift;
    my %oldPH = %$oph;
    my %diff = permissionDiff(\%newPH, \%oldPH);
    pdebug(5, "diff = ".stringHash(%diff));
    # No changes return false.
    return 0 if (! %diff);
    return 0 if (! %newPH);

    my %newTargets = permissionTarget($symbolicTarget, %newPH);
    my %oldTargets = permissionTarget($symbolicTarget, %oldPH);
    pdebug(5, "targets = ".stringHash(%newTargets));
    my $old = fullTarget(%oldTargets);
    $old = $oldPermTarget if ($old eq "");
    my $new = fullTarget(%newTargets);

    # Some cases...
    if ($newPH{"read"} ne "" && $newPH{"write"} ne "") {
	# Create and or fix permissions of the extra dir.
	handleExtraReadDir($newTargets{'read'}, $newPH{'read'});

	# If old read dir != this read dir move the last target.
	if ($newTargets{'read'} ne $oldTargets{'read'}) {
	    # move from $old to $new.
	    moveAndMaybeClean($old, $new);
	    if ($symbolicTarget ne $new) {
		if (-l relative($symbolicTarget)) {
		    action(! unlink(relative($symbolicTarget)),
			   "Remove old symlink $symbolicTarget, to be able to create a new one.");
		}
		pdebug(2, "Internal or permission failure, $symbolicTarget should not exist here.") if (-e relative($symbolicTarget));
		action(! symlink($new, relative($symbolicTarget)),
		       "Creates a symbolic link $symbolicTarget => $new.",
		       2);
	    }
	}
    }
    # If the old one had both read and write group (but not the new one).
    elsif ($oldPH{"read"} ne "" && $oldPH{"write"} ne "") {
	if (-l relative($symbolicTarget)) {
	    action(! unlink(relative($symbolicTarget)),
		   "Remove old symlink $symbolicTarget, to be able to create a new one.");
	}
	pdebug(2, "Internal or permission failure, $symbolicTarget should not exist here.") if (-e relative($symbolicTarget));
	moveAndMaybeClean($old, $new);
    }

    # Needed in the recursive section below.
    my $operation = "";
    if ($newPH{'write'} ne "" && $oldPH{'write'} eq "") {
	$operation = "write";
    }
    elsif ($newPH{'read'} ne "" && $oldPH{'write'} ne "") {
	$operation = "read";
    }
    elsif ($newPH{'read'} ne "" && $oldPH{'read'} eq "") {
	$operation = "read";
    }
    # Changes in write always generate a recur...
    #  -> no write (remove sgid and write, change group to readgroup?)
    # else, change group and add write and sgid.
    if ($recursive && defined $diff{'write'}) {
	my $group = "";
	pdebug(5, "new = $new");
	pdebug(5, "new1 = $newTargets{'read'}");
	pdebug(5, "new2 = $newTargets{'write'}");
	if ($newTargets{'read'} eq $new) {
	    $group = $newPH{'read'};
	}
	elsif ($newTargets{'write'} eq $new) {
	    $group = $newPH{'write'};
	}
	else {
	    pdebug(2, "Internal error.");
	}	
	pdebug(5, "Recursive replace group to $group with operation $operation.");
	if ($niceMode) {
	    my $ogroup = getTargetGroup($new);
	    pdebug(5, "Nice mode, replace only $ogroup (".relative($new).")");
	    find sub {
		my $targ = $_;
		my $tgroup = getGroup($targ);
		pdebug(5, "niceMode! $File::Find::name, $_, $tgroup");
		if ($tgroup eq $ogroup) {
		    changeGroup($group, $targ);
		    modifyPermission($operation, $targ)
			if ($operation ne "");
		}
	    }, relative($new);
	}
	else {
	    pdebug(5, "No nice mode.");
	    find sub {
		pdebug(5, "No niceMode! $File::Find::name, $_");
		my $targ = $_;
		changeGroup($group, $targ);
		modifyPermission($operation, $targ)
		    if ($operation ne "");
	    }, relative($new);
	}
	# Check permission.
	testThenChangePermission('read', $new, 5, 1)
	    if ($operation eq "read");
    }
    # Do not run it recursively.
    else {
	pdebug(5, "Other permissions.");
	if ($newTargets{'read'} eq $new) {
	    # Check permission.
	    testThenChangePermission('read', $new, 5, 1);
	    # Check group.
	    testThenChangeGroup($newPH{'read'}, $new, 5, 1);
	}
	elsif ($newTargets{'write'} eq $new) {
	    # Check permission.
	    testThenChangePermission('write', $new, 5, 1);
	    # Check group.
	    testThenChangeGroup($newPH{'write'}, $new, 5, 1);
	}
    }

    # Changes have (hopefully) been made, return true.
    return 1;
}

###############################################################################
# Name:		handleExtraReadDir
# Arguments:	target to handle.
#		the group who should own it.
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it using code from handleTarget. Almost all code was
#		new today though.
###############################################################################
sub handleExtraReadDir($$) {
    my ($target, $setGroup) = @_;
    my $tmpTarget = relative($target);
    if (! -d $tmpTarget) {
	# Create dir with proper mode.
	action(! mkdir($tmpTarget, 0750),
	       "Create $tmpTarget for read permissions.",
	       2);
	# Give group access.
	changeTargetGroup($setGroup, $target);
    }
    else {
	# Check permission.
	testThenChangePermission('read', $target);
	# Check group.
	testThenChangeGroup($setGroup, $target);
    }
}

###############################################################################
########################### CHANGE FUNCTIONS ##################################
###############################################################################

###############################################################################
# Name:		modifyPermission
# Arguments:	operation (read, write).
#		target
# Note:		May fail hard.
# Uses:		$sgidChange
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
#	2002-02-15 Ola Lundqvist <opal@debian.org>
#		Final work for the recursion. Just some debugging here.
#		Implemented the -s and -S options.
###############################################################################
sub modifyPermission($$) {
    my ($operation, $target) = @_;
    my $mode = (stat($target))[2]; # mode = 2
    my $smode = sprintf("%o", $mode);
    pdebug(5, "Mode $smode found for $target.");
    if ($operation eq "write") {
	pdebug(5, sprintf("Write mode, %o", $mode));
	$mode |= 00001 if (-d $target);
	$mode |= 02000 if (-d $target && $sgidChange);
	pdebug(5, sprintf("Write mode dir, %o", $mode)) if (-d $target);
	$mode |=  0064;
	pdebug(5, sprintf("Write mode write, %o", $mode));
    }
    elsif ($operation eq "read") {
	pdebug(5, sprintf("Read mode, %o", $mode));
	$mode &= (07777 ^ 02000) if (-d $target && $sgidChange);
	pdebug(5, sprintf("Read mode read, %o", $mode));
	$mode &=  (0777 ^ 0020);
	pdebug(5, sprintf("Read mode read, %o", $mode));
    }
    $smode = sprintf("%o", $mode);
    pdebug(5, "Permission modified to $smode $target");
    action(! chmod($mode, $target),
	   "Change mode to $smode for $target.",
	   3);
}

###############################################################################
# Name:		moveAndMaybeClean
# Arguments:	old target
#		new target
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2003-01-20 Ola Lundqvist <opal@debian.org>
#		Made sure that moving is correct of old is symbolic link.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub moveAndMaybeClean($$) {
    my ($o, $n) = @_;
    my $old = relative($o);
    my $new = relative($n);
    if ($new =~ /\//) {
	my $tnew = $n;
	$tnew =~ s/\/.*//;
	$tnew = relative($tnew);
	if (! -d "$tnew" ) {
	    action(! mkdir($tnew, 0770),
		   "Create $tnew for read permissions.",
		   2);
	}
    }
    my $mvold = $old;
    if (-l $mvold) {
	$mvold = relative(readlink $mvold);
    }
    if ($mvold != $new) {
	action(! move($mvold, $new),
	       "Move $mvold to $new.",
	       2);
    }
    if ($old =~ /\//) {
	$old =~ s|/[^/]+$||;
	pdebug(5, "Trying to clean $old.");
	if (rmdir $old) {
	    pdebug(4, "Cleaned permission directory $old.");
	}
    }
}

###############################################################################
# Name:		thestThenChangeGroup
# Arguments:	group to change to
#		target to change
#		Optional debug level for the warnings (default = 3).
#		Optional fix flag (overrides global $fix).
# Uses:		global variable $fix
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub testThenChangeGroup($$;$$) {
    my ($setGroup, $target, $level, $tmpFix) = @_;
    $level = 3 if ($level eq "");
    $tmpFix = $fix if ($tmpFix eq "");
    my $tmpTarget = relative($target);
    my $group = getTargetGroup($target);
    if ($group ne $setGroup) {
	if ($tmpFix) {
	    pdebug($level, "Wrong group $group (should be $setGroup) for $tmpTarget, fixing.");
	    changeTargetGroup($setGroup, $target);
	}
	else {
	    pdebug($level, "Wrong group $group (should be $setGroup) for $tmpTarget. Fix manualy or use the option --fix.");
	}
    }
}

###############################################################################
# Name:		changeGroup
# Arguments:	group to change to
#		target to change
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub changeGroup($$) {
    my ($group, $target) = @_;
    my $gid = getgrnam($group);
    pdebug(5, "Gid for $group is $gid.");
    action(! chown(-1, $gid, $target),
	   "Change group for $target to $group.",
	   2);
}

###############################################################################
# Name:		changeTargetGroup
# Arguments:	group to change to
#		target to change
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub changeTargetGroup($$) {
    my ($group, $target) = @_;
    my $tmpTarget = relative($target);
    changeGroup($group, $tmpTarget);
}

###############################################################################
# Name:		thestThenChangePermission
# Arguments:	permission to change to ('read', 'write').
#		target to change
#		Optional debug level for the warnings (default = 3).
#		Optional fix flag (overrides global $fix).
# Uses:		Global variable $fix.
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub testThenChangePermission($$;$$) {
    my ($setPerm, $target, $level, $tmpFix) = @_;
    $level = 3 if ($level eq "");
    $tmpFix = $fix if ($tmpFix eq "");
    my $tmpTarget = relative($target);
    my $right = getTargetGroupRight($target);
    if ($right ne $setPerm) {
	# if strange and fix, fix it.
	if ($tmpFix) {
	    pdebug($level, "Wrong permission $right (should be read) for $tmpTarget, fixing.");
	    changeTargetPermission($setPerm, $target);
	}
	# if strange and not fix, warn.
	else {
	    pdebug($level, "Wrong permission $right for $tmpTarget. Fix manualy or use the option --fix.");
	}
    }
}

###############################################################################
# Name:		changePermission
# Arguments:	permission to change to ('read', 'write').
#		target to change
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub changePermission($$) {
    my ($sperm, $target) = @_;
    my $mode = "";
    $mode = 0750 if ($sperm eq "read");
    $mode = 0775 if ($sperm eq "write");
    pdebug(2, "Internal failure, unknown mode $smode.")
	if ($mode eq "");
    action(! chmod($mode, $target),
	   "Changing mode for $target.",
	   2);
}

###############################################################################
# Name:		changeTargetPermission
# Arguments:	permission to change to ('read', 'write').
#		target to change
# Note:		May fail hard.
# Status:	TESTED, DONE
# Changes:	
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub changeTargetPermission($$) {
    my ($sperm, $target) = @_;
    my $tmpTarget = relative($target);
    changePermission($sperm, $tmpTarget);
}

###############################################################################
########################### TARGET FUNCTIONS ##################################
###############################################################################



###############################################################################
# Name:		fullTarget
# Arguments:	permissionTarget hash.
# Returns:	The longest path of the ones in permissionTarget.
# Status:	TESTED, DONE
# Changes:
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#               Wrote it.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Now returns unknown hash value if no else is found.
###############################################################################
sub fullTarget(%) {
    my (%hash, $target) = @_;
    pdebug(5, "fullTarget! hash = ".stringHash(%hash).", target = $target.");
    return $hash{"write"} if ($hash{"write"} ne "");
    return $hash{"read"} if ($hash{"read"} ne "");
    return $hash{'unknown'};
}

###############################################################################
# Name:		permissionTarget
# Arguments:	The target name.
#		permission hash holding the groups.
# Returns:	Hash of target names for read and write.
# Status:	TESTED, NOT FINISHED
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub permissionTarget($%) {
    my ($target, %hash) = @_;
    my %ret = ();
    my $permKey, $setKey;
    # This code have to be modified if you extend with more permissions
    # than just read and write.
    if ($hash{"read"} ne "") {
	if ($hash{"write"} ne "") {
	    $ret{"read"}  = ".$hash{'read'}";
	    $ret{"write"} = ".$hash{'read'}/$target";
	}
	else {
	    $ret{"read"} = $target;
	}
    }
    else {
	$ret{"write"} = $target;
    }
    return %ret;
}

###############################################################################
# Name:		permHash
# Arguments:	Permission target (target or what a link points to).
#		Symbolic target (the target user specified.
# Returns:	A hash of permissions as keys with corresponding group
#		as values.
# Status:       TESTED, DONE
# Changes:
#	2002-02-11 Ola Lundqvist <opal@debian.org>
#		Started the writing.
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#		Wrote a working one (for old style).
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#		Rewrote it to allow permission reading for new style.
###############################################################################
sub permHash($$) {
    my ($permTarget, $symbolicTarget) = @_;
    pdebug(5, "permHash! permTarget = $permTarget");
    pdebug(5, "permHash! symbolicTarget = $symbolicTarget");
    # What to return.
    my %ret = ();
    # Used in foreach.
    my $target = "";
    # For foreach.
    my $middle = "";
    my $tmp;
    foreach $tmp (split /\//, $permTarget) {
	$target .= "$middle$tmp";
	# Check mode.
	my $right = getTargetGroupRight($target);
	if (! defined $right) {
	    my $tmp = 3;
	    # There is a error (not a warning) if the target is created
	    # by the script itself (earlier).
	    $tmp = 2 if ($target =~ /\//);
	    pdebug($tmp, "Unknown permissison for target $target!");
	}
	# Check group.
	else {
	    my $group = getTargetGroup($target);
	    pdebug(2, "Group $group extracted from $target do not exist!")
		if (! defined $group);
	    pdebug(5, "$group found in $target.");
	    # Check for double.
	    pdebug(2, "$right permission for $target is already defined for $ret{$right}.")
		if (defined $ret{$right});
	    # Checks done, we have group and right.
	    $ret{$right} = $group;
	}
	# End foreach. This is important for $target eval.
	$middle = "/";
    } 
    return minimalizePermHash(%ret);
}

###############################################################################
# Name:		permissionDiff
# Arguments:	Reference to hash1
#		Reference to hash2
# Return:	A hash with the difference.
#		changedkey => [value1, value2]
# Status:	TESTED, DONE
# Changes:
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub permissionDiff {
    my $hash01 = shift;
    my %hash1 = %$hash01;
    my $hash02 = shift;
    my %hash2 = %$hash02;
    my %ret = ();
    pdebug(5, "hash1 = ".stringHash(%hash1));
    pdebug(5, "hash2 = ".stringHash(%hash2));
    my @keys1 = keys %hash1;
    my @keys2 = keys %hash2;
    foreach my $tmp (@keys1, @keys2) {
	if ($hash1{$tmp} ne $hash2 {$tmp}) {
	    $ret{$tmp} = [ $hash1{$tmp}, $hash2{$tmp} ];
	}
    }
    return %ret;
}

###############################################################################
# Name:		minimalizePermHash
# Argument:	A hash of permissions and corresponding groups.
# Returns:	A hash that have unnecessary items in it.
# Status:	TESTED, DONE
# Changes:
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub minimalizePermHash(%) {
    my (%ret) = @_;
    my $tmp;
    # Undef all empty values.
    foreach $tmp (@{$setGroupIndex{"write"}}) {
	undef ($ret{$tmp}) if ($ret{$tmp} eq "");
    }
    # Write implies read so it is not necessary.
    undef ($ret{"read"}) if ($ret{"read"} eq $ret{"write"});
    return %ret;
}

###############################################################################
####################### GET PERMISSION FUNCTIUONS #############################
###############################################################################

###############################################################################
# Name:		getTargetGroup
# Arguments:	target	- the permission target (file, dir or socket).
# Author:	Ola Lundqvist <opal@debian.org>
# Returns:	The group name for the target, undef if it do not exist.
# Status:	TESTED, DONE
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Made it use getGroup and added the relative.
###############################################################################
sub getTargetGroup($) {
    my ($target) = @_;
    return getGroup(relative($target));
}


###############################################################################
# Name:		getGroup
# Arguments:	target	- the permission target (file, dir or socket).
# Author:	Ola Lundqvist <opal@debian.org>
# Returns:	The group name for the target, undef if it do not exist.
# Status:	NOT FULLY TESTED, DONE
# Changes:
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#               Wrote it using the same code as the code from getTargetGroup.
###############################################################################
sub getGroup($) {
    my ($target) = @_;
    if (-l $target) {
	pdebug(5, "Symlink found, read what it points to.");
	$target = readlink $target;
    }
    return getgrgid((stat($target))[5]); # gid = 5
}

###############################################################################
# Name:		getTargetGroupRight
# Argument:	target to get the group permission from.
# Returns:	read, write or undef.
# Status:	TESTED, DONE.
# Changes:
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	2002-02-14 Ola Lundqvist <opal@debian.org>
#		Use relative now.
#	2002-02-15 Ola Lundqvist <opal@debian.org>
#		Final work for the recursion. Just some debugging here.
###############################################################################
sub getTargetGroupRight($) {
    my ($target) = @_;
    my $smode = sprintf("%o", (stat(relative($target)))[2]); # mode = 2
    pdebug(5, "Mode $smode found for $target.");
    return "read" if ($smode =~ /0750$/);
    return "write" if ($smode =~ /0775$/);
    return "write" if ($smode =~ /2775$/);
    return undef;
}

###############################################################################
############################ CHECK FUNCTIONS ##################################
###############################################################################

###############################################################################
# Name:		checkWriteTarget
# Changes:	
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub checkWriteTarget($$) {
    my ($permTarget, $symbolicTarget) = @_;
    my $writeTarget = $permTarget;
    $writeTarget =~ s|.*/([^/]+)$|$1|;
    pdebug(2, "Target link $permTarget do not match $symbolicTarget, fix it.")
	if ($writeTarget !~ $symbolicTarget);
    my $right = getTargetGroupRight($symbolicTarget);
    pdebug(2, "Unknown permission for $symbolicTarget")
	if (! defined $right);
    if ($right !~ /^write$/) {
	pdebug(3, "No write mode for $permTarget.");
    }
}

###############################################################################
# Name:		checkGroup
# Argument:	A group to check.
# Description:	Checks a group if it exist in the group information file.
# Changes:
#	2002-02-13 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub checkGroup($) {
    my ($g) = @_;
    return if ($g eq "");
    my $t = getgrnam($g);
    pdebug(2, "Group $g does not exist.") if ($t eq "");
}


###############################################################################
################### GENERAL LIST AND HASH FUNCTIONS ###########################
###############################################################################



###############################################################################
# Name:		nonEmptyHashKeys
# Arguments:	hash
# Returns:	List of keys for non empty hash values.
# Status:	TESTED, DONE
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub nonEmptyHashKeys(%) {
    my (%hash) = @_;
    my @ret = ();
    my $tmp;
    foreach $tmp (keys %hash) {
	push @ret, $tmp if ($hash{$tmp} ne "");
    }
    return @ret;
}

###############################################################################
# Name:		stringHashKeys
# Arguments:	hash
# Returns:	String representing the keys of a hash.
# Status:	TESTED, DONE
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub stringHashKeys(%) {
    my (%hash) = @_;
    return stringList(keys %hash);
}

###############################################################################
# Name:		stringNonEmptyHashKeys
# Arguments:	hash
# Returns:	String representing the keys for non empty values of a hash.
# Status:	TESTED, DONE
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub stringNonEmptyHashKeys(%) {
    my (%hash) = @_;
    return stringList(nonEmptyHashKeys(%hash));
}

###############################################################################
# Name:		stringHashValues
# Arguments:	hash
# Returns:	String representing the values of a hash.
# Status:	TESTED, DONE
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub stringHashValues(%) {
    my (%hash) = @_;
    return stringList(values %hash);
}

###############################################################################
# Name:		stringList
# Arguments:	list
# Returns:	String representing a list.
# Status:	TESTED, DONE
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub stringList(@) {
    my $tmp;
    my $middle = "";
    my $ret = "(";
    foreach $tmp (@_) {
	$ret .= "$middle$tmp";
	$middle = ", ";
    }
    return "$ret)";
}

###############################################################################
# Name:		stringHashKeys
# Arguments:	hash
# Returns:	String representing a hash.
# Status:	TESTED, DONE
# Changes:
#	2002-02-12 Ola Lundqvist <opal@debian.org>
#               Wrote it.
###############################################################################
sub stringHash(%) {
    my (%hash) = @_;
    my $tmp;
    my $middle = "";
    my $ret = "";
    $ret = "(";
    foreach $tmp (keys %hash) {
	$ret .= "$middle$tmp => $hash{$tmp}";
	$middle = ", ";
    }
    return "$ret)";
}

=head1 NAME

emuga-groupgen - Generate group information.

=head1 USAGE

emuga-target [options] target [ [options] target [...] ]

=head1 DESCRIPTION

Emuga target can help you to set up a target (directory or file) so that two
groups have inpact on the permissions for it. You can specify one read group
and one write group.

=head1 OPTIONS

  --dl nr | --debug-level nr
	Debug level (for debugging).
  --ql nr | --quit-level nr
	Quit level (for debugging).
  -N	Not nice (chown, chgrp for all groups).
  -n    Nice (chown, chgrp only for the group owning the target), default.
  -R	Do not run chmod, chgrp recursively.
  -S	Do not change the sgid bit, see -s below.
  -s	Change the sgid bit for the writegroup (default). This affects
	recursive changes for writegroup and also recursive changes when
        it is removed or replaced with a readgroup.
  -r readgroup
        The group defined here is the one that should have read
	permission on the target (and possibly subtargets).
  -w writegroup
	The group that should have write permission to the target
	(and possibly subtargets).
  --fix
	Fix problems that can be fixed automaticly (defult no).
  --help
	Print this help.

target:
  The target is a file or directory. To make it really usable directories are
  preferred.
    
  If no read or write-group is specified it only prints the old
  permissions of the target(s).  

Observe that the created directory structure makes an AND operation of the
read and write access. The write permission implies read access but you
can restrict read access by not adding the user to the read group if you want
to do that (the effect is that you will probably not get write access either).

Setting a empty ("") read or write group will unset that group. Note that
there is no way to unset a group. You have to specify new permissions.

=head1 AUTHOR

Ola Lundqvist <opal@debian.org>

=head1 SEE ALSO

emuga-grougen(1)

=cut
