OpenSolaris_b135/cmd/projadd/projmod.pl

#!/usr/perl5/bin/perl -w
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License (the "License").
# You may not use this file except in compliance with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
#
# Copyright 2007 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
#ident	"%Z%%M%	%I%	%E% SMI"
#

require 5.005;
use strict;
use locale;
use Errno;
use Fcntl;
use File::Basename;
use Getopt::Std;
use Getopt::Long qw(:config no_ignore_case bundling);
use POSIX qw(locale_h);
use Sun::Solaris::Utils qw(textdomain gettext);
use Sun::Solaris::Project qw(:ALL :PRIVATE);
use Sun::Solaris::Task qw(:ALL);

#
# Print a usage message and exit.
#
sub usage
{
	my (@msg) = @_;
	my $prog = basename($0);
	my $space = ' ' x length($prog);
	print(STDERR "$prog: @msg\n") if (@msg);
	printf(STDERR gettext(
	    "Usage: %s [-n] [-f filename]\n"), $prog);
	printf(STDERR gettext(
	    "       %s [-n] [-A|-f filename] [-p projid [-o]] [-c comment]\n".
            "       %s [-a|-s|-r] [-U user[,user...]] [-G group[,group...]]\n".
            "       %s [-K name[=value[,value...]]] [-l new_projectname] ".
	    "project\n"), $prog, $space, $space, $space);
	exit(2);
}

#
# Print a list of error messages and exit.
#
sub error
{
	my $exit = $_[0][0];
	my $prog = basename($0) . ': ';
	foreach my $err (@_) {
		my ($e, $fmt, @args) = @$err;
		printf(STDERR $prog . $fmt . "\n", @args);
	}
	exit($exit);
}

#
# Merge an array of users/groups with an existing array.  The array to merge
# is the first argument, an array ref is the second argument.  The third
# argument is the mode which can be one of:
#     add	add all entries in the first arg to the second
#     remove	remove all entries in the first arg from the second
#     replace	replace the second arg by the first
# The resulting array is returned as a reference.
#
sub merge_lists
{
	my ($new, $old, $mode) = @_;
	my @err;

	if ($mode eq 'add') {
		my @merged = @$old;
		my %look = map { $_ => 1 } @$old;
		my @leftover;
		foreach my $e (@$new) {
			if (! exists($look{$e})) {
				push(@merged, $e);
			} else {
				push(@leftover, $e);
			}
		}
		if (@leftover) {
			push(@err,
			    [6, gettext('Project already contains "%s"'),
			    join(',', @leftover)]);
			return (1, \@err);
		}

		return(0, \@merged);

	} elsif ($mode eq 'remove') {

		my %seen;
		my @dups = grep($seen{$_}++ == 1, @$new);
		if (@dups) {
			push(@err, [6, gettext('Duplicate names "%s"'),
			    join(',', @dups)]);
			return (1, \@err);
		}
		my @merged;
		my %look = map { $_ => 0 } @$new;
		foreach my $e (@$old) {
			if (exists($look{$e})) {
				$look{$e}++;
			} else {
				push(@merged, $e);
			}
		}
		my @leftover = grep(! $look{$_}, keys(%look));
		if (@leftover) {
			push(@err, [6,
		            gettext('Project does not contain "%s"'),
			    join(',', @leftover)]);
			return (1, \@err);
		}
		return (0, \@merged);

	} elsif ($mode eq 'replace' || $mode eq 'substitute') {
		return (0, $new);
	}
}

#
# merge_values(ref to listA, ref to listB, mode
#
# Merges the values in listB with the values in listA.  Dups are not
# merged away, but instead are maintained.
#
# modes:
#	add   :	add values in listB to listA
#	remove:	removes first instance of each value in listB from listA
#	
sub merge_values
{

	my ($new, $old, $mode) = @_;
	my $undefined;
	my @merged;
	my $lastmerged;
	my ($oldval, $newval);
	my $found;
	my @err;

	if (!defined($old) && !defined($new)) {
		return (0, $undefined);
	}
					     
	if ($mode eq 'add') {

		if (defined($old)) {
			push(@merged, @$old);
		}
		if (defined($new)) {
			push(@merged, @$new);
		}
		return (0, \@merged);

	} elsif ($mode eq 'remove') {

		$lastmerged = $old;
		foreach $newval (@$new) {
			$found = 0;
			@merged = ();
			foreach $oldval (@$lastmerged) {
				if (!$found &&
				    projent_values_equal($newval, $oldval)) {
					$found = 1;
				} else {
					push(@merged, $oldval);
				}

			}
			if (!$found) {
				push(@err, [6, gettext(
				    'Value "%s" not found'),
				    projent_values2string($newval)]);
			}
			@$lastmerged = @merged;
		}

		if (@err) {
			return (1, \@err);
		} else {
			return (0, \@merged);
		}
	}
}

#
# merge_attribs(listA ref, listB ref, mode)
#
# Merge listB of attribute/values hash refs with listA
# Each hash ref should have keys "name" and "values"
#
# modes:
#     add	For each attribute in listB, add its values to
#	        the matching attribute in listA.  If listA does not
#		contain this attribute, add it.
#
#     remove	For each attribute in listB, remove its values from
#	        the matching attribute in listA.  If all of an
#		attributes values are removed, the attribute is removed.
#		If the attribute in listB has no values, then the attribute
#		and all of it's values are removed from listA
#
#     substitute For each attribute in listB, replace the values of
#	        the matching attribute in listA with its values.  If
#		listA does not contain this attribute, add it.
#
#     replace	Return listB
#
# The resulting array is returned as a reference.
#
sub merge_attribs
{
	my ($new, $old, $mode) = @_;
	my @merged;
	my @err;
	my $ret;
	my $tmp;
	my $newattrib;
	my $oldattrib;
	my $values;
       
	if ($mode eq 'add') {

		my %oldhash;
		push(@merged, @$old);
		%oldhash = map { $_->{'name'} => $_ } @$old;
		foreach $newattrib (@$new) {

			$oldattrib = $oldhash{$newattrib->{'name'}};
			if (defined($oldattrib)) {
				($ret, $tmp) = merge_values(
				    $newattrib->{'values'},
				    $oldattrib->{'values'},
				    $mode);

				if ($ret != 0) {
					push(@err, @$tmp);
				} else {
					$oldattrib->{'values'} = $tmp;
				}
			} else {
				push(@merged, $newattrib);
			}
		}
		if (@err) {
			return (1, \@err);
		} else {
			return (0, \@merged);
		}

	} elsif ($mode eq 'remove') {

		my %seen;
		my @dups = grep($seen{$_}++ == 1, map { $_->{'name'} } @$new);
		if (@dups) {
			push(@err, [6, gettext(
			    'Duplicate Attributes "%s"'),
			     join(',', @dups)]);
			return (1, \@err);
		}
		my %toremove = map { $_->{'name'} => $_ } @$new;

		foreach $oldattrib (@$old) {
			$newattrib = $toremove{$oldattrib->{'name'}};
			if (!defined($newattrib)) {

				push(@merged, $oldattrib);
				
			} else {
				if (defined($newattrib->{'values'})) {
					($ret, $tmp) = merge_values(
					    $newattrib->{'values'},
					    $oldattrib->{'values'},
					    $mode);

					if ($ret != 0) {
						push(@err, @$tmp);
					} else {
						$oldattrib->{'values'} = $tmp;
					}
					if (defined($tmp) && @$tmp) {
						push(@merged, $oldattrib);
					}
				}
				delete $toremove{$oldattrib->{'name'}};
			}
		}
		foreach $tmp (keys(%toremove)) {
			push(@err, [6,
		            gettext('Project does not contain "%s"'),
			    $tmp]);
		}

		if (@err) {
			return (1, \@err);
		} else {	
			return (0, \@merged);
		}	

	} elsif ($mode eq 'substitute') {

		my %oldhash;
		push(@merged, @$old);
		%oldhash = map { $_->{'name'} => $_ } @$old;
		foreach $newattrib (@$new) {

			$oldattrib = $oldhash{$newattrib->{'name'}};
			if (defined($oldattrib)) {

				$oldattrib->{'values'} =
				    $newattrib->{'values'};

			} else {
				push(@merged, $newattrib);
			}
		}
		if (@err) {
			return (1, \@err);
		} else {
			return (0, \@merged);
		}
	
	} elsif ($mode eq 'replace') {
		return (0, $new);
	}
}

#
# Main routine of script.
#
# Set the message locale.
#
setlocale(LC_ALL, '');
textdomain(TEXT_DOMAIN);


# Process command options and do some initial command-line validity checking.
my ($pname, $flags);
$flags = {};
my $modify = 0;

my $projfile;
my $opt_n;
my $opt_c;
my $opt_o;
my $opt_p;
my $opt_l;
my $opt_a;
my $opt_r;
my $opt_s;
my $opt_U;
my $opt_G;
my @opt_K;
my $opt_A;

GetOptions("f=s" => \$projfile,
	   "n"   => \$opt_n,
	   "c=s" => \$opt_c,
	   "o"	 => \$opt_o,
	   "p=s" => \$opt_p,
	   "l=s" => \$opt_l,
	   "s"	 => \$opt_s,
	   "r"	 => \$opt_r,
	   "a"	 => \$opt_a,
	   "U=s" => \$opt_U,
	   "G=s" => \$opt_G,
	   "K=s" => \@opt_K,
  	   "A"	 => \$opt_A) || usage();

usage(gettext('Invalid command-line arguments')) if (@ARGV > 1);

if ($opt_c || $opt_G || $opt_l || $opt_p || $opt_U || @opt_K || $opt_A) {
	$modify = 1;
	if (! defined($ARGV[0])) {
		usage(gettext('No project name specified'));
	}
}

if (!$modify && defined($ARGV[0])) {
	usage(gettext('missing -c, -G, -l, -p, -U, or -K'));
}

if (defined($opt_A) && defined($projfile)) {
	usage(gettext('-A and -f are mutually exclusive'));
}

if (! defined($projfile)) {
	$projfile = &PROJF_PATH;
}

if ($modify && $projfile eq '-') {
	usage(gettext('Cannot modify standard input'));
}

$pname = $ARGV[0];
usage(gettext('-o requires -p projid to be specified'))
    if (defined($opt_o) && ! defined($opt_p));
usage(gettext('-a, -r, and -s are mutually exclusive'))
    if ((defined($opt_a) && (defined($opt_r) || defined($opt_s))) ||
	(defined($opt_r) && (defined($opt_a) || defined($opt_s))) ||
	(defined($opt_s) && (defined($opt_a) || defined($opt_r))));

usage(gettext('-a and -r require -U users or -G groups to be specified'))
    if ((defined($opt_a) || defined($opt_r) || defined($opt_s)) &&
    ! (defined($opt_U) || defined($opt_G) || (@opt_K)));


if (defined($opt_a)) {
	$flags->{mode} = 'add';
} elsif (defined($opt_r)) {
	$flags->{mode} = 'remove';
} elsif (defined($opt_s)) {
	$flags->{mode} = 'substitute';
} else {
	$flags->{mode} = 'replace';
}

# Fabricate an unique temporary filename.
my $tmpprojf = $projfile . ".tmp.$$";

my $pfh;

#
# Read the project file.  sysopen() is used so we can control the file mode.
# Handle special case for standard input.
if ($projfile eq '-') {
	open($pfh, "<&=STDIN") or error( [10,
	    gettext('Cannot open standard input')]);
} elsif (! sysopen($pfh, $projfile, O_RDONLY)) {
	error([10, gettext('Cannot open %s: %s'), $projfile, $!]);
}
my ($mode, $uid, $gid) = (stat($pfh))[2,4,5];


if ($opt_n) {
	$flags->{'validate'} = 'false';
} else {
	$flags->{'validate'} = 'true';
}

$flags->{'res'} = 'true';
$flags->{'dup'} = 'true';

my ($ret, $pf) = projf_read($pfh, $flags);
if ($ret != 0) {
	error(@$pf);
}
close($pfh);
my $err;
my $tmperr;
my $value;

# Find existing record.
my ($proj, $idx);
$idx = 0;

if (defined($pname)) {
	foreach my $r (@$pf) {	
		if ($r->{'name'} eq $pname) {
			$proj = $r;
			last;
		}	
		$idx++;
	}
	error([6, gettext('Project "%s" does not exist'), $pname])
	    if (! $proj);
}
#
# If there are no modification options, simply reading the file, which
# includes parsing and verifying, is sufficient.
#
if (!$modify) {
	exit(0);
}

foreach my $r (@$pf) {
	if ($r->{'name'} eq $pname) {
		$proj = $r;
		last;
	}	
	$idx++;
}

# Update the record as appropriate.
$err = [];

# Set new project name.
if (defined($opt_l)) {

	($ret, $value) = projent_parse_name($opt_l);
	if ($ret != 0) {
		push(@$err, @$value);
	} else {
		$proj->{'name'} = $value;
		if (!defined($opt_n)) {
			($ret, $tmperr) =
			    projent_validate_unique_name($proj, $pf);
			if ($ret != 0) {
				push(@$err, @$tmperr);
			}
		}
	}
}

# Set new project id.
if (defined($opt_p)) {

	($ret, $value) = projent_parse_projid($opt_p);
	if ($ret != 0) {
		push(@$err, @$value);
	} else {
		$proj->{'projid'} = $value;

		# Check for dupicate.
		if ((!defined($opt_n)) && (!defined($opt_o))) {
			($ret, $tmperr) =
			    projent_validate_unique_id($proj, $pf);
			if ($ret != 0) {
				push(@$err, @$tmperr);
			}
		}
	}	
}

# Set new comment.
if (defined($opt_c)) {

	($ret, $value) = projent_parse_comment($opt_c);
	if ($ret != 0) {
		push(@$err, @$value);
	} else {
		$proj->{'comment'} = $value;
	}
}

# Set new users.
if (defined($opt_U)) {

	my @sortlist;
	my $list;
	($ret, $list) = projent_parse_users($opt_U, {'allowspaces' => 1});
	if ($ret != 0) {
		push(@$err, @$list);
	} else {
		($ret, $list) =
		    merge_lists($list, $proj->{'userlist'}, $flags->{mode});
		if ($ret != 0) {
			push(@$err, @$list);
		} else {
			@sortlist = sort(@$list);
			$proj->{'userlist'} = \@sortlist;
		}
	}	
}

# Set new groups.
if (defined($opt_G)) {

	my @sortlist;
	my $list;
	($ret, $list) = projent_parse_groups($opt_G, {'allowspaces' => 1});
	if ($ret != 0) {
		push(@$err, @$list);
	} else {
		($ret, $list) =
		    merge_lists($list, $proj->{'grouplist'}, $flags->{mode});
		if ($ret != 0) {
			push(@$err, @$list);
		} else {
			@sortlist = sort(@$list);
			$proj->{'grouplist'} = \@sortlist;
		}
	}
}

# Set new attributes.
my $attrib;
my @attriblist;

foreach $attrib (@opt_K) {

	my $list;
	($ret, $list) = projent_parse_attributes($attrib, {'allowunits' => 1});
	if ($ret != 0) {
		push(@$err, @$list);
	} else {
		push(@attriblist, @$list);
	}
}

if (@attriblist) {
	my @sortlist;
	my $list;

	($ret, $list) =
	    merge_attribs(\@attriblist, $proj->{'attributelist'},
	    $flags->{mode});
	if ($ret != 0) {
		push(@$err, @$list);
	} else {
		@sortlist =
		    sort { $a->{'name'} cmp $b->{'name'} } @$list;
		$proj->{'attributelist'} = \@sortlist;
	}
}

# Validate all projent fields.
if (!defined($opt_n)) {
	($ret, $tmperr) = projent_validate($proj, $flags);
	if ($ret != 0) {
		push(@$err, @$tmperr);
	}
}
if (@$err) {
	error(@$err);
}

# Write out the project file.
if ($modify) {

	#
	# Mark projent to write based on new values instead of
	# original line.
	#
	$proj->{'modified'} = 'true';
	umask(0000);
	sysopen($pfh, $tmpprojf, O_WRONLY | O_CREAT | O_EXCL, $mode) ||
	    error([10, gettext('Cannot create %s: %s'), $tmpprojf, $!]);
	projf_write($pfh, $pf);
	close($pfh);

	# Update file attributes.
	if (!chown($uid, $gid, $tmpprojf)) {
		unlink($tmpprojf);
		error([10, gettext('Cannot set ownership of %s: %s'),
		    $tmpprojf, $!]);
	}
	if (! rename($tmpprojf, $projfile)) {
		unlink($tmpprojf);
		error([10, gettext('cannot rename %s to %s: %s'),
	            $tmpprojf, $projfile, $!]);
	}

}

if (defined($opt_A)) {
	my $error;

	if (($error = setproject($pname, "root", TASK_FINAL|TASK_PROJ_PURGE)) != 0) {

		if ($error == SETPROJ_ERR_TASK) {
			if ($!{EAGAIN}) {
				error([5, gettext("resource control limit has ".
				     "been reached\n")]);
			} elsif ($!{ESRCH}) {
				error([5, gettext("user \"%s\" is not a member ".
				     "of project \"%s\"\n"), "root", $pname]);
			} elsif ($!{EACCES}) {
				error([5, gettext("the invoking task is final\n"
				     )]);
			} else {
				error([5, gettext("could not join project \"%s".
				     "\"\n"), $pname]);
			}

		} elsif ($error == SETPROJ_ERR_POOL) {
			if ($!{EACCES}) {
				error([5, gettext("no resource pool accepting ".
				     "default bindings exists for project \"%s".
				     "\"\n"), $pname]);
	        	} elsif ($!{ESRCH}) {
				error([5, gettext("specified resource pool ".
				     "does not exist for project \"%s\"\n"),
				     $pname]);
			} else {
				error([5, gettext("could not bind to default ".
				     "resource pool for project \"%s\"\n"),
				     $pname]);
			}

		} else {
			#
			# $error represents the position - within the semi-colon
			# delimited $attribute - that generated the error
			#
			if ($error <= 0) {
				error([5, gettext("setproject failed for ".
				     "project \"%s\"\n"), $pname]);
			} else {
				my ($name, $projid, $comment, $users_ref,
				     $groups_ref, $attr) = getprojbyname($pname);
				my $attribute = ($attr =~
				     /(\S+?)=\S+?(?:;|\z)/g)[$error - 1];

				if (!$attribute) {
					error([5, gettext("warning, resource ".
					     "control assignment failed for ".
					     "project \"%s\" attribute %d\n"),
					     $pname, $error]);
				} else {
					error([5, gettext("warning, %s ".
					     "resource control assignment ".
					     "failed for project \"%s\"\n"),
					     $attribute, $pname]);
				}
			}
		}
	}
}

exit(0);