1 #!/usr/perl5/bin/perl -w
5 # The contents of this file are subject to the terms of the
6 # Common Development and Distribution License (the "License").
7 # You may not use this file except in compliance with the License.
9 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10 # or http://www.opensolaris.org/os/licensing.
11 # See the License for the specific language governing permissions
12 # and limitations under the License.
14 # When distributing Covered Code, include this CDDL HEADER in each
15 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16 # If applicable, add the following below this CDDL HEADER, with the
17 # fields enclosed by brackets "[]" replaced with your own identifying
18 # information: Portions Copyright [yyyy] [name of copyright owner]
23 # Copyright 2007 Sun Microsystems, Inc. All rights reserved.
24 # Use is subject to license terms.
26 #ident "%Z%%M% %I% %E% SMI"
36 use Getopt
::Long
qw(:config no_ignore_case bundling);
37 use POSIX
qw(locale_h);
38 use Sun
::Solaris
::Utils
qw(textdomain gettext);
39 use Sun
::Solaris
::Project
qw(:ALL :PRIVATE);
40 use Sun
::Solaris
::Task
qw(:ALL);
43 # Print a usage message and exit.
48 my $prog = basename
($0);
49 my $space = ' ' x
length($prog);
50 print(STDERR
"$prog: @msg\n") if (@msg);
51 printf(STDERR gettext
(
52 "Usage: %s [-n] [-f filename]\n"), $prog);
53 printf(STDERR gettext
(
54 " %s [-n] [-A|-f filename] [-p projid [-o]] [-c comment]\n".
55 " %s [-a|-s|-r] [-U user[,user...]] [-G group[,group...]]\n".
56 " %s [-K name[=value[,value...]]] [-l new_projectname] ".
57 "project\n"), $prog, $space, $space, $space);
62 # Print a list of error messages and exit.
67 my $prog = basename
($0) . ': ';
68 foreach my $err (@_) {
69 my ($e, $fmt, @args) = @
$err;
70 printf(STDERR
$prog . $fmt . "\n", @args);
76 # Merge an array of users/groups with an existing array. The array to merge
77 # is the first argument, an array ref is the second argument. The third
78 # argument is the mode which can be one of:
79 # add add all entries in the first arg to the second
80 # remove remove all entries in the first arg from the second
81 # replace replace the second arg by the first
82 # The resulting array is returned as a reference.
86 my ($new, $old, $mode) = @_;
91 my %look = map { $_ => 1 } @
$old;
93 foreach my $e (@
$new) {
94 if (! exists($look{$e})) {
102 [6, gettext
('Project already contains "%s"'),
103 join(',', @leftover)]);
109 } elsif ($mode eq 'remove') {
112 my @dups = grep($seen{$_}++ == 1, @
$new);
114 push(@err, [6, gettext
('Duplicate names "%s"'),
119 my %look = map { $_ => 0 } @
$new;
120 foreach my $e (@
$old) {
121 if (exists($look{$e})) {
127 my @leftover = grep(! $look{$_}, keys(%look));
130 gettext
('Project does not contain "%s"'),
131 join(',', @leftover)]);
134 return (0, \
@merged);
136 } elsif ($mode eq 'replace' || $mode eq 'substitute') {
142 # merge_values(ref to listA, ref to listB, mode
144 # Merges the values in listB with the values in listA. Dups are not
145 # merged away, but instead are maintained.
148 # add : add values in listB to listA
149 # remove: removes first instance of each value in listB from listA
154 my ($new, $old, $mode) = @_;
158 my ($oldval, $newval);
162 if (!defined($old) && !defined($new)) {
163 return (0, $undefined);
166 if ($mode eq 'add') {
169 push(@merged, @
$old);
172 push(@merged, @
$new);
174 return (0, \
@merged);
176 } elsif ($mode eq 'remove') {
179 foreach $newval (@
$new) {
182 foreach $oldval (@
$lastmerged) {
184 projent_values_equal
($newval, $oldval)) {
187 push(@merged, $oldval);
192 push(@err, [6, gettext
(
193 'Value "%s" not found'),
194 projent_values2string
($newval)]);
196 @
$lastmerged = @merged;
202 return (0, \
@merged);
208 # merge_attribs(listA ref, listB ref, mode)
210 # Merge listB of attribute/values hash refs with listA
211 # Each hash ref should have keys "name" and "values"
214 # add For each attribute in listB, add its values to
215 # the matching attribute in listA. If listA does not
216 # contain this attribute, add it.
218 # remove For each attribute in listB, remove its values from
219 # the matching attribute in listA. If all of an
220 # attributes values are removed, the attribute is removed.
221 # If the attribute in listB has no values, then the attribute
222 # and all of it's values are removed from listA
224 # substitute For each attribute in listB, replace the values of
225 # the matching attribute in listA with its values. If
226 # listA does not contain this attribute, add it.
228 # replace Return listB
230 # The resulting array is returned as a reference.
234 my ($new, $old, $mode) = @_;
243 if ($mode eq 'add') {
246 push(@merged, @
$old);
247 %oldhash = map { $_->{'name'} => $_ } @
$old;
248 foreach $newattrib (@
$new) {
250 $oldattrib = $oldhash{$newattrib->{'name'}};
251 if (defined($oldattrib)) {
252 ($ret, $tmp) = merge_values
(
253 $newattrib->{'values'},
254 $oldattrib->{'values'},
260 $oldattrib->{'values'} = $tmp;
263 push(@merged, $newattrib);
269 return (0, \
@merged);
272 } elsif ($mode eq 'remove') {
275 my @dups = grep($seen{$_}++ == 1, map { $_->{'name'} } @
$new);
277 push(@err, [6, gettext
(
278 'Duplicate Attributes "%s"'),
282 my %toremove = map { $_->{'name'} => $_ } @
$new;
284 foreach $oldattrib (@
$old) {
285 $newattrib = $toremove{$oldattrib->{'name'}};
286 if (!defined($newattrib)) {
288 push(@merged, $oldattrib);
291 if (defined($newattrib->{'values'})) {
292 ($ret, $tmp) = merge_values
(
293 $newattrib->{'values'},
294 $oldattrib->{'values'},
300 $oldattrib->{'values'} = $tmp;
302 if (defined($tmp) && @
$tmp) {
303 push(@merged, $oldattrib);
306 delete $toremove{$oldattrib->{'name'}};
309 foreach $tmp (keys(%toremove)) {
311 gettext
('Project does not contain "%s"'),
318 return (0, \
@merged);
321 } elsif ($mode eq 'substitute') {
324 push(@merged, @
$old);
325 %oldhash = map { $_->{'name'} => $_ } @
$old;
326 foreach $newattrib (@
$new) {
328 $oldattrib = $oldhash{$newattrib->{'name'}};
329 if (defined($oldattrib)) {
331 $oldattrib->{'values'} =
332 $newattrib->{'values'};
335 push(@merged, $newattrib);
341 return (0, \
@merged);
344 } elsif ($mode eq 'replace') {
350 # Main routine of script.
352 # Set the message locale.
354 setlocale
(LC_ALL
, '');
355 textdomain
(TEXT_DOMAIN
);
358 # Process command options and do some initial command-line validity checking.
377 GetOptions
("f=s" => \
$projfile,
389 "A" => \
$opt_A) || usage
();
391 usage
(gettext
('Invalid command-line arguments')) if (@ARGV > 1);
393 if ($opt_c || $opt_G || $opt_l || $opt_p || $opt_U || @opt_K || $opt_A) {
395 if (! defined($ARGV[0])) {
396 usage
(gettext
('No project name specified'));
400 if (!$modify && defined($ARGV[0])) {
401 usage
(gettext
('missing -c, -G, -l, -p, -U, or -K'));
404 if (defined($opt_A) && defined($projfile)) {
405 usage
(gettext
('-A and -f are mutually exclusive'));
408 if (! defined($projfile)) {
409 $projfile = &PROJF_PATH
;
412 if ($modify && $projfile eq '-') {
413 usage
(gettext
('Cannot modify standard input'));
417 usage
(gettext
('-o requires -p projid to be specified'))
418 if (defined($opt_o) && ! defined($opt_p));
419 usage
(gettext
('-a, -r, and -s are mutually exclusive'))
420 if ((defined($opt_a) && (defined($opt_r) || defined($opt_s))) ||
421 (defined($opt_r) && (defined($opt_a) || defined($opt_s))) ||
422 (defined($opt_s) && (defined($opt_a) || defined($opt_r))));
424 usage
(gettext
('-a and -r require -U users or -G groups to be specified'))
425 if ((defined($opt_a) || defined($opt_r) || defined($opt_s)) &&
426 ! (defined($opt_U) || defined($opt_G) || (@opt_K)));
429 if (defined($opt_a)) {
430 $flags->{mode
} = 'add';
431 } elsif (defined($opt_r)) {
432 $flags->{mode
} = 'remove';
433 } elsif (defined($opt_s)) {
434 $flags->{mode
} = 'substitute';
436 $flags->{mode
} = 'replace';
439 # Fabricate an unique temporary filename.
440 my $tmpprojf = $projfile . ".tmp.$$";
445 # Read the project file. sysopen() is used so we can control the file mode.
446 # Handle special case for standard input.
447 if ($projfile eq '-') {
448 open($pfh, "<&=STDIN") or error
( [10,
449 gettext
('Cannot open standard input')]);
450 } elsif (! sysopen($pfh, $projfile, O_RDONLY
)) {
451 error
([10, gettext
('Cannot open %s: %s'), $projfile, $!]);
453 my ($mode, $uid, $gid) = (stat($pfh))[2,4,5];
457 $flags->{'validate'} = 'false';
459 $flags->{'validate'} = 'true';
462 $flags->{'res'} = 'true';
463 $flags->{'dup'} = 'true';
465 my ($ret, $pf) = projf_read
($pfh, $flags);
474 # Find existing record.
478 if (defined($pname)) {
479 foreach my $r (@
$pf) {
480 if ($r->{'name'} eq $pname) {
486 error
([6, gettext
('Project "%s" does not exist'), $pname])
490 # If there are no modification options, simply reading the file, which
491 # includes parsing and verifying, is sufficient.
497 foreach my $r (@
$pf) {
498 if ($r->{'name'} eq $pname) {
505 # Update the record as appropriate.
508 # Set new project name.
509 if (defined($opt_l)) {
511 ($ret, $value) = projent_parse_name
($opt_l);
513 push(@
$err, @
$value);
515 $proj->{'name'} = $value;
516 if (!defined($opt_n)) {
518 projent_validate_unique_name
($proj, $pf);
520 push(@
$err, @
$tmperr);
526 # Set new project id.
527 if (defined($opt_p)) {
529 ($ret, $value) = projent_parse_projid
($opt_p);
531 push(@
$err, @
$value);
533 $proj->{'projid'} = $value;
535 # Check for dupicate.
536 if ((!defined($opt_n)) && (!defined($opt_o))) {
538 projent_validate_unique_id
($proj, $pf);
540 push(@
$err, @
$tmperr);
547 if (defined($opt_c)) {
549 ($ret, $value) = projent_parse_comment
($opt_c);
551 push(@
$err, @
$value);
553 $proj->{'comment'} = $value;
558 if (defined($opt_U)) {
562 ($ret, $list) = projent_parse_users
($opt_U, {'allowspaces' => 1});
567 merge_lists
($list, $proj->{'userlist'}, $flags->{mode
});
571 @sortlist = sort(@
$list);
572 $proj->{'userlist'} = \
@sortlist;
578 if (defined($opt_G)) {
582 ($ret, $list) = projent_parse_groups
($opt_G, {'allowspaces' => 1});
587 merge_lists
($list, $proj->{'grouplist'}, $flags->{mode
});
591 @sortlist = sort(@
$list);
592 $proj->{'grouplist'} = \
@sortlist;
597 # Set new attributes.
601 foreach $attrib (@opt_K) {
604 ($ret, $list) = projent_parse_attributes
($attrib, {'allowunits' => 1});
608 push(@attriblist, @
$list);
617 merge_attribs
(\
@attriblist, $proj->{'attributelist'},
623 sort { $a->{'name'} cmp $b->{'name'} } @
$list;
624 $proj->{'attributelist'} = \
@sortlist;
628 # Validate all projent fields.
629 if (!defined($opt_n)) {
630 ($ret, $tmperr) = projent_validate
($proj, $flags);
632 push(@
$err, @
$tmperr);
639 # Write out the project file.
643 # Mark projent to write based on new values instead of
646 $proj->{'modified'} = 'true';
648 sysopen($pfh, $tmpprojf, O_WRONLY
| O_CREAT
| O_EXCL
, $mode) ||
649 error
([10, gettext
('Cannot create %s: %s'), $tmpprojf, $!]);
650 projf_write
($pfh, $pf);
653 # Update file attributes.
654 if (!chown($uid, $gid, $tmpprojf)) {
656 error
([10, gettext
('Cannot set ownership of %s: %s'),
659 if (! rename($tmpprojf, $projfile)) {
661 error
([10, gettext
('cannot rename %s to %s: %s'),
662 $tmpprojf, $projfile, $!]);
667 if (defined($opt_A)) {
670 if (($error = setproject
($pname, "root", TASK_FINAL
|TASK_PROJ_PURGE
)) != 0) {
672 if ($error == SETPROJ_ERR_TASK
) {
674 error
([5, gettext
("resource control limit has ".
676 } elsif ($!{ESRCH
}) {
677 error
([5, gettext
("user \"%s\" is not a member ".
678 "of project \"%s\"\n"), "root", $pname]);
679 } elsif ($!{EACCES
}) {
680 error
([5, gettext
("the invoking task is final\n"
683 error
([5, gettext
("could not join project \"%s".
687 } elsif ($error == SETPROJ_ERR_POOL
) {
689 error
([5, gettext
("no resource pool accepting ".
690 "default bindings exists for project \"%s".
692 } elsif ($!{ESRCH
}) {
693 error
([5, gettext
("specified resource pool ".
694 "does not exist for project \"%s\"\n"),
697 error
([5, gettext
("could not bind to default ".
698 "resource pool for project \"%s\"\n"),
704 # $error represents the position - within the semi-colon
705 # delimited $attribute - that generated the error
708 error
([5, gettext
("setproject failed for ".
709 "project \"%s\"\n"), $pname]);
711 my ($name, $projid, $comment, $users_ref,
712 $groups_ref, $attr) = getprojbyname
($pname);
713 my $attribute = ($attr =~
714 /(\S+?)=\S+?(?:;|\z)/g)[$error - 1];
717 error
([5, gettext
("warning, resource ".
718 "control assignment failed for ".
719 "project \"%s\" attribute %d\n"),
722 error
([5, gettext
("warning, %s ".
723 "resource control assignment ".
724 "failed for project \"%s\"\n"),
725 $attribute, $pname]);