Home | History | Annotate | Download | only in Project
      1 # CDDL HEADER START
      2 #
      3 # The contents of this file are subject to the terms of the
      4 # Common Development and Distribution License (the "License").
      5 # You may not use this file except in compliance with the License.
      6 #
      7 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
      8 # or http://www.opensolaris.org/os/licensing.
      9 # See the License for the specific language governing permissions
     10 # and limitations under the License.
     11 #
     12 # When distributing Covered Code, include this CDDL HEADER in each
     13 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
     14 # If applicable, add the following below this CDDL HEADER, with the
     15 # fields enclosed by brackets "[]" replaced with your own identifying
     16 # information: Portions Copyright [yyyy] [name of copyright owner]
     17 #
     18 # CDDL HEADER END
     19 #
     20 
     21 #
     22 # Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
     23 # Use is subject to license terms.
     24 #
     25 
     26 #
     27 # Project.pm provides the bootstrap for the Sun::Solaris::Project module, and
     28 # also functions for reading, validating and writing out project(4) format
     29 # files.
     30 #
     31 ################################################################################
     32 require 5.8.4;
     33 
     34 use strict;
     35 use warnings;
     36 use locale;
     37 use Errno;
     38 use Fcntl;
     39 use File::Basename;
     40 use POSIX qw(locale_h limits_h);
     41 
     42 package Sun::Solaris::Project;
     43 
     44 our $VERSION = '1.9';
     45 
     46 use XSLoader;
     47 XSLoader::load(__PACKAGE__, $VERSION);
     48 
     49 our (@EXPORT_OK, %EXPORT_TAGS);
     50 my @constants = qw(MAXPROJID PROJNAME_MAX PROJF_PATH PROJECT_BUFSZ
     51     SETPROJ_ERR_TASK SETPROJ_ERR_POOL);
     52 my @syscalls = qw(getprojid);
     53 my @libcalls = qw(setproject activeprojects getprojent setprojent endprojent
     54     getprojbyname getprojbyid getdefaultproj fgetprojent inproj
     55     getprojidbyname);
     56 my @private = qw(projf_read projf_write projf_validate projent_parse
     57 		 projent_parse_name projent_validate_unique_name
     58 		 projent_parse_projid projent_validate_unique_id
     59 		 projent_parse_comment
     60 		 projent_parse_users
     61 		 projent_parse_groups
     62 		 projent_parse_attributes
     63 		 projent_validate projent_validate_projid
     64 		 projent_values_equal projent_values2string);
     65 
     66 @EXPORT_OK = (@constants, @syscalls, @libcalls, @private);
     67 %EXPORT_TAGS = (CONSTANTS => \@constants, SYSCALLS => \@syscalls,
     68     LIBCALLS => \@libcalls, PRIVATE => \@private, ALL => \@EXPORT_OK);
     69 
     70 use base qw(Exporter);
     71 use Sun::Solaris::Utils qw(gettext);
     72 
     73 #
     74 # Set up default rules for validating rctls.
     75 # These rules are not global-flag specific, but instead
     76 # are the total set of allowable values on all rctls.
     77 #
     78 use Config;
     79 our $MaxNum = &RCTL_MAX_VALUE;
     80 our %RctlRules;
     81 
     82 my %rules;
     83 our %SigNo;
     84 my $j;
     85 my $name;
     86 foreach $name (split(' ', $Config{sig_name})) {
     87 	$SigNo{$name} = $j;
     88 	$j++;
     89 }
     90 %rules = (
     91     'privs' 	=> [ qw(basic privileged priv) ],
     92     'actions'	=> [ qw(none deny sig) ],
     93     'signals'	=> [ qw(ABRT XRES HUP STOP TERM KILL XFSZ XCPU),
     94 		     $SigNo{'ABRT'},
     95 		     $SigNo{'XRES'},
     96 		     $SigNo{'HUP'},
     97 		     $SigNo{'STOP'},
     98 		     $SigNo{'TERM'},
     99 		     $SigNo{'KILL'},
    100 		     $SigNo{'XFSZ'},
    101 		     $SigNo{'XCPU'} ],
    102     'max'	=> $MaxNum
    103 );
    104 	       
    105 $RctlRules{'__DEFAULT__'} = \%rules;
    106 
    107 #
    108 # projf_combine_errors(errorA, errorlistB)
    109 #
    110 # Concatenates a single error with a list of errors.  Each error in the new
    111 # list will have a status matching the status of errorA.
    112 #
    113 # Example:
    114 # 
    115 #	projf_combine_errors(
    116 #	    [ 5, "Error on line %d, 10 ],
    117 #	    [ [ 3, "Invalid Value %s", "foo" ],
    118 #	      [ 6, "Duplicate Value %s", "bar" ]
    119 #	    ]);
    120 #
    121 # would return the list ref:
    122 #
    123 #	[ [ 5, "Error on line %d: Invalid Value %s", 10, "foo" ],
    124 #	  [ 5, "Error on line %d: Duplicate Value %s", 10, "bar" ]
    125 #	]
    126 #
    127 # This function is used when a fuction wants to add more information to
    128 # a list of errors returned by another function.
    129 #
    130 sub projf_combine_errors
    131 {
    132 
    133 	my ($error1, $errorlist)  = @_;
    134 	my $error2;
    135 
    136 	my $newerror;
    137 	my @newerrorlist;
    138 
    139 	my ($err1, $fmt1, @args1);
    140 	my ($err2, $fmt2, @args2);
    141 
    142 	($err1, $fmt1, @args1) = @$error1;
    143 	foreach $error2 (@$errorlist) {
    144 
    145 		($err2, $fmt2, @args2) = @$error2;
    146 		$newerror = [ $err1, $fmt1 . ', ' . $fmt2, @args1, @args2];
    147 		push(@newerrorlist, $newerror);
    148 	}
    149 	return (\@newerrorlist);
    150 }
    151 
    152 #
    153 # projf_read(filename, flags)
    154 #
    155 # Reads and parses a project(4) file, and returns a list of projent hashes.
    156 #
    157 # Inputs:
    158 #	filename - file to read
    159 #	flags	 - hash ref of flags
    160 #
    161 # If flags contains key "validate", the project file entries will also be
    162 # validated for run-time correctness  If so, the flags ref is forwarded to
    163 # projf_validate().
    164 #
    165 # Return Value:
    166 #
    167 # Returns a ref to a list of projent hashes.  See projent_parse() for a
    168 # description of a projent hash.
    169 #
    170 sub projf_read
    171 {
    172 
    173 	my ($fh, $flags) = @_;
    174 	my @projents;
    175 	my $projent;
    176 	my $linenum = 0;
    177 	my ($projname, $projid, $comment, $users, $groups, $attributes);
    178 	my ($ret, $ref);
    179 	my @errs;
    180 
    181 	my ($line, $origline, $next, @projf);
    182 	while (defined($line = <$fh>)) {
    183 
    184 		$linenum++;
    185 		$origline = $line;
    186 
    187 		# Remove any line continuations and trailing newline.
    188 		$line =~ s/\\\n//g;
    189 		chomp($line);
    190 
    191 
    192 		if (length($line) > (&PROJECT_BUFSZ - 2)) {
    193 			push(@errs, 
    194 			    [5,
    195 			      gettext('Parse error on line %d, line too long'),
    196 			    $linenum]);
    197 
    198 		}
    199 
    200 		($ret, $ref) = projent_parse($line, {});
    201 		if ($ret != 0) {
    202 			$ref = projf_combine_errors(
    203 			    [5, gettext('Parse error on line %d'), $linenum],
    204 			    $ref);
    205 			push(@errs, @$ref);
    206 			next;
    207 		}
    208 
    209 		$projent = $ref;
    210 
    211 		#
    212 		# Cache original line to save original format if it is
    213 		# not changed.
    214 		#
    215 		$projent->{'line'} = $origline;
    216 		$projent->{'modified'} = 'false';
    217 		$projent->{'linenum'} = $linenum;
    218 
    219 		push(@projents, $projent);
    220 	}
    221 
    222 	if (defined($flags->{'validate'}) && ($flags->{'validate'} eq 'true')) {
    223 		($ret, $ref) = projf_validate(\@projents, $flags);
    224 		if ($ret != 0) {
    225 			push(@errs, @$ref);
    226 		}	
    227 	}	
    228 
    229 	if (@errs) {
    230 		return (1, \@errs);
    231 		
    232 	} else {
    233 		return (0, \@projents);
    234 	}
    235 }	
    236 
    237 #
    238 # projf_write(filehandle, projent list)
    239 # 
    240 # Write a list of projent hashes to a file handle.
    241 # projent's with key "modified" => false will be
    242 # written using the "line" key.  projent's with
    243 # key "modified" => "true" will be written by
    244 # constructing a new line based on their "name"
    245 # "projid", "comment", "userlist", "grouplist"
    246 # and "attributelist" keys.
    247 #
    248 sub projf_write
    249 {
    250 	my ($fh, $projents) = @_;
    251 	my $projent;
    252 	my $string;
    253 
    254 	foreach $projent (@$projents) {
    255 
    256 		if ($projent->{'modified'} eq 'false') {
    257 			$string = $projent->{'line'};
    258 		} else {
    259 			$string = projent_2string($projent) . "\n";
    260 		}
    261 		print $fh "$string";
    262 	}
    263 }
    264 
    265 #
    266 # projent_parse(line)
    267 #
    268 # Functions for parsing the project file lines into projent hashes.
    269 #
    270 # Returns a number and a ref, one of:
    271 #
    272 # 	(0, ref to projent hash)
    273 #	(non-zero, ref to list of errors)
    274 #
    275 #	Flag can be:
    276 #		allowspaces: allow spaces between user and group names.
    277 #		allowunits : allow units (K, M, etc), on rctl values.
    278 #
    279 # A projent hash contains the keys:
    280 #
    281 #	"name"		- string name of project
    282 #	"projid"	- numeric id of project
    283 #	"comment"	- comment string
    284 #	"users"		- , seperated user list string
    285 #	"userlist"	- list ref to list of user name strings
    286 #	"groups"	- , seperated group list string
    287 #	"grouplist" 	- list ref to liset of group name strings
    288 #	"attributes"	- ; seperated attribute list string
    289 #	"attributelist" - list ref to list of attribute refs
    290 #		          (see projent_parse_attributes() for attribute ref)
    291 #
    292 sub projent_parse
    293 {
    294 
    295 	my ($line, $flags) = @_;
    296 	my $projent = {};
    297 	my ($ret, $ref);
    298 	my @errs;
    299 	my ($projname, $projid, $comment, $users, $groups, $attributes);
    300 
    301 	#
    302 	# Split fields of project line.  split() is not used because
    303 	# we must enforce that there are 6 fields.
    304 	#
    305 	($projname, $projid, $comment, $users, $groups, $attributes) =
    306 	    $line =~
    307 	    /^([^:]*):([^:]*):([^:]*):([^:]*):([^:]*):([^:]*)$/;
    308 
    309 	# If there is not a complete match, nothing will be defined;
    310 	if (!defined($projname)) {
    311 		push(@errs, [5, gettext(
    312 		    'Incorrect number of fields.  Should have 5 ":"\'s.')]);
    313 
    314 		# Get as many fields as we can.
    315 		($projname, $projid, $comment, $users, $groups, $attributes) =
    316 		    split(/:/, $line);
    317 	}
    318 
    319 	if (defined($projname)) {
    320 		$projent->{'name'} = $projname;
    321 		($ret, $ref) = projent_parse_name($projname);
    322 		if ($ret != 0) {
    323 			push(@errs, @$ref);
    324 		}
    325 	}
    326 	if (defined($projid)) {
    327 		$projent->{'projid'} = $projid;
    328 		($ret, $ref) = projent_parse_projid($projid);
    329 		if ($ret != 0) {
    330 			push(@errs, @$ref);
    331 		}
    332 	}
    333 	if (defined($comment)) {
    334 		$projent->{'comment'} = $comment;
    335 		($ret, $ref) = projent_parse_comment($comment);
    336 		if ($ret != 0) {
    337 			push(@errs, @$ref);
    338 		}
    339 	}
    340 	if (defined($users)) {
    341 		$projent->{'users'} = $users;
    342 		($ret, $ref) = projent_parse_users($users, $flags);
    343 		if ($ret != 0) {
    344 			push(@errs, @$ref);
    345 		} else {
    346 			$projent->{'userlist'} = $ref;
    347 		}
    348 	}
    349 	if (defined($groups)) {
    350 		$projent->{'groups'} = $groups;
    351 		($ret, $ref) = projent_parse_groups($groups, $flags);
    352 		if ($ret != 0) {
    353 			push(@errs, @$ref);
    354 		} else {
    355 			$projent->{'grouplist'} = $ref;
    356 		}
    357 	}
    358 	if (defined($attributes)) {
    359 		$projent->{'attributes'} = $attributes;
    360 		($ret, $ref) = projent_parse_attributes($attributes, $flags);
    361 		if ($ret != 0) {
    362 			push(@errs, @$ref);
    363 		} else {
    364 			$projent->{'attributelist'} = $ref;
    365 		}
    366 	}
    367 
    368 	if (@errs) {
    369 		return (1, \@errs);
    370 
    371 	} else {
    372 		return (0, $projent);
    373 	}
    374 }
    375 
    376 #
    377 # Project name syntax checking.
    378 #
    379 sub projent_parse_name
    380 {
    381 	my @err;
    382 	my ($projname) = @_;
    383 
    384 	if (!($projname =~ /^[[:alpha:]][[:alnum:]_.-]*$/)) {
    385 		push(@err, ([3, gettext(
    386 		    'Invalid project name "%s", contains invalid characters'),
    387 		    $projname]));
    388 		return (1, \@err);
    389 	}
    390 	if (length($projname) > &PROJNAME_MAX) {
    391 		push(@err, ([3, gettext(
    392 		    'Invalid project name "%s", name too long'),
    393 		    $projname]));
    394 		return (1, \@err);
    395 	}
    396 	return (0, $projname);
    397 }
    398 
    399 #
    400 # Projid syntax checking.
    401 #
    402 sub projent_parse_projid
    403 {
    404 	my @err;
    405 	my ($projid) = @_;
    406 
    407 	# verify projid is a positive number, and less than UID_MAX
    408 	if (!($projid =~ /^\d+$/)) {
    409 		push(@err, [3, gettext('Invalid projid "%s"'),
    410 		    $projid]);
    411 		return (1, \@err);
    412 
    413 	} elsif ($projid > POSIX::INT_MAX) {
    414 		push(@err, [3, gettext('Invalid projid "%s": must be <= '.
    415 		    POSIX::INT_MAX),
    416 		    $projid]);
    417 		return (1, \@err);
    418 
    419 	} else {
    420 		return (0, $projid);
    421 	}
    422 }
    423 
    424 #
    425 # Project comment syntax checking.
    426 #
    427 sub projent_parse_comment
    428 {
    429 	my ($comment) = @_;
    430 
    431 	# no restrictions on comments
    432 	return (0, $comment);
    433 }
    434 
    435 #
    436 # projent_parse_users(string, flags)
    437 #
    438 # Parses "," seperated list of users, and returns list ref to a list of
    439 # user names.  If flags contains key "allowspaces", then spaces are
    440 # allowed between user names and ","'s.
    441 #
    442 sub projent_parse_users
    443 {
    444 	my ($users, $flags) = @_;
    445 	my @err;
    446 	my $user;
    447 	my $pattern;
    448 	my @userlist;
    449 
    450 	if (exists($flags->{'allowspaces'})) {
    451 		$pattern = '\s*,\s*';
    452 	} else {
    453 		$pattern = ',';
    454 	}	
    455 	@userlist = split(/$pattern/, $users);
    456 
    457 	# Return empty list if there are no users.
    458 	if (!(@userlist)) {
    459 		return (0, \@userlist);
    460 	}
    461 
    462 	# Verify each user name is the correct format for a valid user name.
    463 	foreach $user (@userlist) {
    464 
    465 		# Allow for wildcards.
    466 		if ($user eq '*' || $user eq '!*') {
    467 			next;
    468 		}
    469 
    470 		# Allow for ! operator, usernames must begin with alpha-num,
    471 		# and contain alpha-num, '_', digits, '.', or '-'.
    472 		if (!($user =~ /^!?[[:alpha:]][[:alnum:]_.-]*$/)) {
    473 			push(@err, [3, gettext('Invalid user name "%s"'),
    474 			    $user]);
    475 			next;
    476 		}
    477 	}
    478 	if (@err) {
    479 		return (1,\ @err);
    480 	} else {
    481 		return (0, \@userlist);
    482 	}
    483 }
    484 
    485 #
    486 # projent_parse_groups(string, flags)
    487 #
    488 # Parses "," seperated list of groups, and returns list ref to a list of
    489 # groups names.  If flags contains key "allowspaces", then spaces are
    490 # allowed between group names and ","'s.
    491 #
    492 sub projent_parse_groups
    493 {
    494 	my ($groups, $flags) = @_;
    495 	my @err;
    496 	my $group;
    497 	my $pattern;
    498 
    499 	my @grouplist; 
    500 
    501 	if (exists($flags->{'allowspaces'})) {
    502 		$pattern = '\s*,\s*';
    503 	} else {
    504 		$pattern = ',';
    505 	}	
    506 	@grouplist = split(/$pattern/, $groups);
    507 
    508 	# Return empty list if there are no groups.
    509 	if (!(@grouplist)) {
    510 		return (0, \@grouplist);
    511 	}
    512 
    513 	# Verify each group is the correct format for a valid group name.
    514 	foreach $group (@grouplist) {
    515 
    516 		# Allow for wildcards.
    517 		if ($group eq '*' || $group eq '!*') {
    518 			next;
    519 		}
    520 			
    521 		# Allow for ! operator, groupnames can contain only alpha
    522 		# characters and digits.
    523 		if (!($group =~ /^!?[[:alnum:]]+$/)) {
    524 			push(@err, [3, gettext('Invalid group name "%s"'),
    525 			    $group]);
    526 			next;
    527 		}
    528 	}
    529 
    530 	if (@err) {
    531 		return (1,\ @err);
    532 	} else {
    533 		return (0, \@grouplist);
    534 	}
    535 }
    536 
    537 #
    538 # projent_tokenize_attribute_values(values)
    539 #
    540 # Values is the right hand side of a name=values attribute/values pair.
    541 # This function splits the values string into a list of tokens.  Tokens are
    542 # valid string values and the characters ( ) , 
    543 #
    544 sub projent_tokenize_attribute_values
    545 {
    546 	#
    547 	# This seperates the attribute string into higher level tokens
    548 	# for parsing.
    549 	#
    550 	my $prev;
    551 	my $cur;
    552 	my $next;
    553 	my $token;
    554 	my @tokens;
    555 	my @newtokens;
    556 	my @err;
    557 
    558 	# Seperate tokens delimited by "(", ")", and ",".
    559 	@tokens = split(/([,()])/, $_[0], -1);
    560 
    561 	# Get rid of blanks
    562 	@newtokens = grep($_ ne '', @tokens);
    563 
    564 	foreach $token (@newtokens) {
    565 		if (!($token =~ /^[(),]$/ ||
    566 		      $token =~ /^[[:alnum:]_.\/=+-]*$/)) {
    567 			push(@err, [3, gettext(
    568 			    'Invalid Character at or near "%s"'), $token]);
    569 		}
    570 	}
    571 	if (@err) {
    572 		return (1, \@err);
    573 	} else {
    574 		return (0, \@newtokens);
    575 	}
    576 }
    577 
    578 #
    579 # projent_parse_attribute_values(values)
    580 #
    581 # Values is the right hand side of a name=values attribute/values pair.
    582 # This function parses the values string into a list of values.  Each value
    583 # can be either a scalar value, or a ref to another list of values.
    584 # A ref to the list of values is returned.
    585 # 
    586 sub projent_parse_attribute_values
    587 {
    588 	#
    589 	# For some reason attribute values can be lists of values and
    590 	# sublists, which are scoped using ()'s.  All values and sublists
    591 	# are delimited by ","'s.  Empty values are lists are permitted.
    592 	
    593 	# This function returns a reference to a list of values, each of
    594 	# which can be a scalar value, or a reference to a sublist.  Sublists
    595 	# can contain both scalar values and references to furthur sublists.
    596 	#
    597 	my ($values) = @_;
    598 	my $tokens;
    599 	my @usedtokens;
    600 	my $token;
    601 	my $prev = '';
    602 	my $parendepth = 0;
    603 	my @valuestack;
    604 	my @err;
    605 	my ($ret, $ref);
    606 	my $line;
    607 
    608 	push (@valuestack, []);
    609 
    610 	($ret, $ref) = projent_tokenize_attribute_values($values);
    611 	if ($ret != 0) {
    612 		return ($ret, $ref);
    613 	}
    614 	$tokens = $ref;
    615 
    616 	foreach $token (@$tokens) {
    617 		
    618 		push(@usedtokens, $token);
    619 
    620 		if ($token eq ',') {
    621 
    622 			if ($prev eq ',' || $prev eq '(' ||
    623 			    $prev eq '') {
    624 				push(@{$valuestack[$#valuestack]}, '');
    625 			}
    626 			$prev = ',';
    627 			next;
    628 		}
    629 		if ($token eq '(') {
    630 
    631 			if (!($prev eq '(' || $prev eq ',' ||
    632 			      $prev eq '')) {
    633 
    634 				$line = join('', @usedtokens);
    635 				push(@err, [3, gettext(
    636 				    '"%s" <- "(" unexpected'),
    637 				    $line]);
    638 
    639 				return (1, \@err);
    640 			}
    641 				    
    642 			$parendepth++;
    643 			my $arrayref = [];
    644 			push(@{$valuestack[$#valuestack]}, $arrayref);
    645 			push(@valuestack, $arrayref);
    646 
    647 			$prev = '(';
    648 			next;
    649 		}
    650 		if ($token eq ')') {
    651 
    652 			if ($parendepth <= 0) {
    653 
    654 				$line = join('', @usedtokens);
    655 				push(@err, [3, gettext(
    656 				    '"%s" <- ")" unexpected'),
    657 				    $line]);
    658 
    659 				return (1, \@err);
    660 			}
    661 
    662 			if ($prev eq ',' || $prev eq '(') {
    663 				push(@{$valuestack[$#valuestack]}, '');
    664 			}
    665 			$parendepth--;
    666 			pop @valuestack;
    667 
    668 			$prev = ')';
    669 			next;
    670 		}
    671 
    672 		if (!($prev eq ',' || $prev eq '(' || $prev eq '')) {
    673 			$line = join('', @usedtokens);
    674 			push(@err, [3, gettext(
    675 			    '"%s" <- "%s" unexpected'),
    676 			    $line, $token]);
    677 
    678 			return (1, \@err);
    679 		}
    680 				
    681 		push(@{$valuestack[$#valuestack]}, $token);
    682 		$prev = $token;
    683 		next;
    684 	}
    685 
    686 	if ($parendepth != 0) {
    687 		push(@err, [3, gettext(
    688 		    '"%s" <- ")" missing'),
    689 		    $values]);
    690 		return (1, \@err);
    691 	}
    692 	
    693 	if ($prev eq ',' || $prev eq '') {
    694 		push(@{$valuestack[$#valuestack]}, '');
    695 	}
    696 
    697 	return (0, $valuestack[0]);
    698 }
    699 
    700 #
    701 # projent_parse_attribute("name=values", $flags)
    702 #
    703 # $flags is a hash ref.
    704 # Valid flags keys:
    705 #	'allowunits' - allows numeric values to be scaled on certain attributes
    706 #
    707 # Returns a hash ref with keys:
    708 #
    709 #	"name" 		- name of attribute
    710 #	"values"	- ref to list of values.
    711 #			  Each value can be a scalar value, or a ref to
    712 #			  a sub-list of values.
    713 #
    714 sub projent_parse_attribute
    715 {
    716 	my ($string, $flags) = @_;
    717 	my $attribute = {};
    718 	my ($name, $stock, $values);
    719 	my ($ret, $ref);
    720 	my @err;
    721 	my $scale;
    722 	my $num;
    723 	my $modifier;
    724 	my $unit;
    725 	my $tuple;
    726 	my $rules;
    727 	my $rctlmax;
    728 	my $rctlflags;
    729 
    730 	# pattern for matching stock symbols.
    731 	my $stockp = '[[:upper:]]{1,5}(?:.[[:upper:]]{1,5})?,';
    732 	# Match attribute with no value.
    733 	($name, $stock) = $string =~
    734 	    /^(($stockp)?[[:alpha:]][[:alnum:]_.-]*)$/;
    735 	if ($name) {
    736 		$attribute->{'name'} = $name;
    737 		return (0, $attribute);
    738 	}
    739 
    740 	# Match attribute with value list.
    741 	($name, $stock, $values) = $string =~
    742 	    /^(($stockp)?[[:alpha:]][[:alnum:]_.-]*)=(.*)$/;
    743 	if ($name) {
    744 		$attribute->{'name'} = $name;
    745 
    746 		if (!defined($values)) {
    747 			$values = '';
    748 		}
    749 
    750 		($ret, $ref) = projent_parse_attribute_values($values);
    751 		if ($ret != 0) {
    752 			$ref = projf_combine_errors(
    753 			    [3,
    754 			    gettext('Invalid value on attribute "%s"'),
    755 			    $name], $ref);
    756 			push(@err, @$ref);
    757 			return ($ret, \@err)
    758 		}
    759 
    760 		# Scale attributes than can be scaled.
    761 		if (exists($flags->{"allowunits"})) {
    762 
    763 			if ($name eq 'rcap.max-rss' &&
    764 			    defined($ref->[0]) && !ref($ref->[0])) {
    765 				$scale = 'bytes';
    766 				
    767 				($num, $modifier, $unit) =
    768 				    projent_val2num($ref->[0], $scale);
    769 					
    770 				if (!defined($num)) {
    771 
    772 					if (defined($unit)) {
    773 						push(@err, [3, gettext(
    774 						    'rcap.max-rss has invalid '.
    775 						    'unit "%s"'), $unit]);
    776 					} else {
    777 						push(@err, [3, gettext(
    778 						    'rcap.max-rss has invalid '.
    779 						    'value "%s"'), $ref->[0]]);
    780 					}
    781 				} elsif ($num eq "OVERFLOW") {
    782 					push(@err, [3, gettext( 'rcap.max-rss value '.
    783 				            '"%s" exceeds maximum value "%s"'),
    784 					    $ref->[0], $MaxNum]);
    785 				} else {
    786 					$ref->[0] = $num;
    787 				} 
    788 			}
    789 			# Check hashed cache of rctl rules.
    790 			$rules = $RctlRules{$name};
    791 			if (!defined($rules)) {
    792 				#
    793 				# See if this is an resource control name, if so
    794 				# cache rules.
    795 				#
    796 				($rctlmax, $rctlflags) = rctl_get_info($name);
    797 				if (defined($rctlmax)) {
    798 					$rules = proj_getrctlrules(
    799 					    $rctlmax, $rctlflags);
    800 					if (defined($rules)) {
    801 						$RctlRules{$name} = $rules;
    802 					} else {
    803 						$RctlRules{$name} =
    804 						    "NOT AN RCTL";
    805 					}
    806 				}	
    807 			}
    808 
    809 			# Scale values if this is an rctl.
    810 			if (defined ($rules) && ref($rules)) {
    811 				$flags->{'type'} = $rules->{'type'};
    812 				foreach $tuple (@$ref) {
    813 
    814 					# Skip if tuple this is not a list.
    815 					if (!ref($tuple)) {
    816 						next;
    817 					}
    818 					# Skip if second element is not scalar.
    819 					if (!defined($tuple->[1]) ||
    820 					     ref($tuple->[1])) {
    821 						next;
    822 					}
    823 					($num, $modifier, $unit) =
    824 					    projent_val2num($tuple->[1],
    825 					        $flags->{'type'});
    826 					
    827 					if (!defined($num)) {
    828 
    829 						if (defined($unit)) {
    830 							push(@err, [3, gettext(
    831 							    'rctl %s has '.
    832 							    'invalid unit '.
    833 							    '"%s"'),$name,
    834 							    $unit]);
    835 						} else {
    836 							push(@err, [3, gettext(
    837 							    'rctl %s has '.
    838 							    'invalid value '.
    839 						            '"%s"'), $name,
    840 							    $tuple->[1]]);
    841 						}
    842 					} elsif ($num eq "OVERFLOW") {
    843 						push(@err, [3, gettext(
    844 					            'rctl %s value "%s" '.
    845 						    'exceeds maximum value "%s"'),
    846 					             $name, $tuple->[1], $MaxNum]);
    847 					} else {
    848 						$tuple->[1] = $num;
    849 					} 
    850 				}
    851 			}
    852 		}
    853 		$attribute->{'values'} = $ref;
    854 		if (@err) {
    855 			return (1, \@err);
    856 		} else {
    857 			return (0, $attribute);
    858 		}
    859 
    860 	} else {
    861 		# Attribute did not match name[=value,value...]
    862 		push(@err, [3, gettext('Invalid attribute "%s"'), $string]);
    863 		return (1, \@err);
    864 	}
    865 }
    866 
    867 #
    868 # projent_parse_attributes("; seperated list of name=values pairs");
    869 #
    870 # Returns a list of attribute references, as returned by
    871 # projent_parse_attribute().
    872 #
    873 sub projent_parse_attributes
    874 {
    875 	my ($attributes, $flags) = @_;
    876 	my @attributelist;
    877 	my @attributestrings;
    878 	my $attributestring;
    879 	my $attribute;
    880 	my ($ret, $ref);
    881 	my @errs;
    882 
    883 	# Split up attributes by ";"'s.
    884 	@attributestrings = split(/;/, $attributes);
    885 
    886 	# If no attributes, return empty list.
    887 	if (!@attributestrings) {
    888 		return (0, \@attributelist);
    889 	}
    890 
    891 	foreach $attributestring (@attributestrings) {
    892 
    893 		($ret, $ref) = projent_parse_attribute($attributestring,
    894 		    $flags);
    895 		if ($ret != 0) {
    896 			push(@errs, @$ref);
    897 		} else {
    898 			push(@attributelist, $ref);
    899 		}
    900 	}
    901 
    902 	if (@errs) {
    903 		return (1, \@errs);
    904 	} else {
    905 		return (0, \@attributelist);
    906 	}
    907 
    908 }
    909 
    910 #
    911 # projent_values_equal(list A, list B)
    912 #
    913 # Given two references to lists of attribute values (as returned by
    914 # projent_parse_attribute_values()), returns 1 if they are identical
    915 # lists or 0 if they are not.
    916 #
    917 # XXX sub projent_values_equal;
    918 sub projent_values_equal
    919 {
    920 	my ($x, $y) = @_;
    921 
    922 	my $itema;
    923 	my $itemb;
    924 	my $index = 0;
    925 
    926 	if (ref($x) && ref($y)) {
    927 
    928 		if (scalar(@$x) != scalar(@$y)) {
    929 			return (0);
    930 		} else {
    931 			foreach $itema (@$x) {
    932 				
    933 				$itemb = $y->[$index++];
    934 				
    935 				if (!projent_values_equal($itema, $itemb)) {
    936 					return (0);
    937 				}
    938 			}
    939 			return (1);
    940 		}
    941 	} elsif ((!ref($x) && (!ref($y)))) {
    942 		return ($x eq $y);
    943 	} else {
    944 		return (0);
    945 	}
    946 }
    947 
    948 #
    949 # Converts a list of values to a , seperated string, enclosing sublists
    950 # in ()'s.
    951 #
    952 sub projent_values2string
    953 {
    954 	my ($values) = @_;
    955 	my $string;
    956 	my $value;
    957 	my @valuelist;
    958 
    959 	if (!defined($values)) {
    960 		return ('');
    961 	}
    962 	if (!ref($values)) {
    963 		return ($values);
    964 	}
    965 	foreach $value (@$values) {
    966 	    
    967                 if (ref($value)) {
    968 			push(@valuelist,
    969                             '(' . projent_values2string($value) . ')');
    970                 } else {
    971 			push(@valuelist, $value);
    972 		}
    973         }
    974 
    975 	$string = join(',', @valuelist)	;
    976 	if (!defined($string)) {
    977 		$string = '';
    978 	}	
    979         return ($string);
    980 }
    981 
    982 #
    983 # Converts a ref to an attribute hash with keys "name", and "values" to
    984 # a string in the form "name=value,value...".
    985 #
    986 sub projent_attribute2string
    987 {
    988 	my ($attribute) = @_;
    989 	my $string;
    990 
    991 	$string = $attribute->{'name'};
    992 
    993 	if (ref($attribute->{'values'}) && @{$attribute->{'values'}}) {
    994 		$string = $string . '=' .
    995 		    projent_values2string(($attribute->{'values'}));
    996 	}	
    997 	return ($string);				 
    998 }
    999 
   1000 #
   1001 # Converts a ref to a projent hash (as returned by projent_parse()) to
   1002 # a project(4) database entry line.
   1003 #
   1004 sub projent_2string
   1005 {
   1006 	my ($projent) = @_;
   1007 	my @attributestrings;
   1008 	my $attribute;
   1009 
   1010 	foreach $attribute (@{$projent->{'attributelist'}}) {
   1011 		push(@attributestrings, projent_attribute2string($attribute));
   1012 	}
   1013 	return (join(':', ($projent->{'name'},
   1014 			   $projent->{'projid'},
   1015 			   $projent->{'comment'},
   1016 			   join(',', @{$projent->{'userlist'}}),
   1017 			   join(',', @{$projent->{'grouplist'}}),
   1018 			   join(';', @attributestrings))));
   1019 }
   1020 
   1021 #
   1022 # projf_validate(ref to list of projents hashes, flags)
   1023 #
   1024 # For each projent hash ref in the list, checks that users, groups, and pools
   1025 # exists, and that known attributes are valid.  Attributes matching rctl names
   1026 # are verified to have valid values given that rctl's global flags and max
   1027 # value.
   1028 #
   1029 # Valid flag keys:
   1030 #
   1031 #	"res" 	- allow reserved project ids 0-99
   1032 #	"dup"   - allow duplicate project ids
   1033 #
   1034 sub projf_validate
   1035 {
   1036 	my ($projents, $flags) = @_;
   1037 	my $projent;
   1038 	my $ret;
   1039 	my $ref;
   1040 	my @err;
   1041 	my %idhash;
   1042 	my %namehash;
   1043 	my %seenids;
   1044 	my %seennames;
   1045 	
   1046 	# check for unique project names
   1047 	foreach $projent (@$projents) {
   1048 
   1049 		my @lineerr;
   1050 
   1051 		$seennames{$projent->{'name'}}++;
   1052 		$seenids{$projent->{'projid'}}++;
   1053 
   1054 		if ($seennames{$projent->{'name'}} > 1) {
   1055 			push(@lineerr, [4, gettext(
   1056 			    'Duplicate project name "%s"'),
   1057 			    $projent->{'name'}]);
   1058 		}
   1059 
   1060 		if (!defined($flags->{'dup'})) {
   1061 			if ($seenids{$projent->{'projid'}} > 1) {
   1062 				push(@lineerr, [4, gettext(
   1063 				    'Duplicate projid "%s"'),
   1064 				    $projent->{'projid'}]);
   1065 			}
   1066 		}
   1067 		($ret, $ref) = projent_validate($projent, $flags);
   1068 		if ($ret != 0) {
   1069 			push(@lineerr, @$ref);
   1070 		}
   1071 
   1072 		if (@lineerr) {
   1073 			
   1074 			$ref = projf_combine_errors([5, gettext(
   1075 			    'Validation error on line %d'),
   1076 			    $projent->{'linenum'}], \@lineerr);
   1077 			push(@err, @$ref);
   1078 		}
   1079 	}
   1080 	if (@err) {
   1081 		return (1, \@err);
   1082 	} else {
   1083 		return (0, $projents);
   1084 	}
   1085 }
   1086 
   1087 #
   1088 # projent_validate_unique_id(
   1089 #     ref to projent hash, ref to list of projent hashes)
   1090 #
   1091 # Verifies that projid of the projent hash only exists once in the list of
   1092 # projent hashes.
   1093 #
   1094 sub projent_validate_unique_id
   1095 {
   1096 	my ($projent, $projf, $idhash) = @_;
   1097 	my @err;
   1098 	my $ret = 0;
   1099 	my $projid = $projent->{'projid'};
   1100 
   1101 	if (scalar(grep($_->{'projid'} eq $projid, @$projf)) > 1) {
   1102 		$ret = 1;
   1103 		push(@err, [4, gettext('Duplicate projid "%s"'),
   1104 		    $projid]);
   1105 	}
   1106 
   1107 	return ($ret, \@err);
   1108 }
   1109 
   1110 #
   1111 # projent_validate_unique_id(
   1112 #     ref to projent hash, ref to list of projent hashes)
   1113 #
   1114 # Verifies that project name of the projent hash only exists once in the list
   1115 # of projent hashes.
   1116 #
   1117 # If the seconds argument is a hash ref, it is treated 
   1118 #
   1119 sub projent_validate_unique_name
   1120 {
   1121 	my ($projent, $projf, $namehash) = @_;
   1122 	my $ret = 0;
   1123 	my @err;
   1124 	my $pname = $projent->{'name'};
   1125 
   1126 	if (scalar(grep($_->{'name'} eq $pname, @$projf)) > 1) {
   1127 		$ret = 1;
   1128 		push(@err,
   1129 		     [9, gettext('Duplicate project name "%s"'), $pname]);
   1130 	}
   1131 
   1132 	return ($ret, \@err);
   1133 }
   1134 
   1135 #
   1136 # projent_validate(ref to projents hash, flags)
   1137 #
   1138 # Checks that users, groups, and pools exists, and that known attributes
   1139 # are valid.  Attributes matching rctl names are verified to have valid
   1140 # values given that rctl's global flags and max value.
   1141 #
   1142 # Valid flag keys:
   1143 #
   1144 #	"allowspaces" 	- user and group list are allowed to contain whitespace
   1145 #	"res" 		- allow reserved project ids 0-99
   1146 #
   1147 sub projent_validate
   1148 {
   1149 	my ($projent, $flags) = @_;
   1150 	my $ret = 0;
   1151 	my $ref;
   1152 	my @err;
   1153 
   1154 	($ret, $ref) =
   1155 	    projent_validate_name($projent->{'name'}, $flags);
   1156 	if ($ret != 0) {
   1157 		push(@err, @$ref);
   1158 	} 
   1159 	($ret, $ref) =
   1160 	    projent_validate_projid($projent->{'projid'}, $flags);
   1161 	if ($ret != 0) {
   1162 		push(@err, @$ref);
   1163 	} 
   1164 	($ret, $ref) =
   1165 	    projent_validate_comment($projent->{'comment'}, $flags);
   1166 	if ($ret != 0) {
   1167 		push(@err, @$ref);
   1168 	}
   1169 	($ret, $ref) =
   1170 	    projent_validate_users($projent->{'userlist'}, $flags);
   1171 	if ($ret != 0) {
   1172 		push(@err, @$ref);
   1173 	}
   1174 	($ret, $ref) =
   1175 	    projent_validate_groups($projent->{'grouplist'}, $flags);
   1176 	if ($ret != 0) {
   1177 		push(@err, @$ref);
   1178 	}
   1179 	($ret, $ref) = projent_validate_attributes(
   1180 	    $projent->{'attributelist'}, $flags);
   1181 	if ($ret != 0) {	
   1182 		push(@err, @$ref);
   1183 	}	
   1184 
   1185 	my $string = projent_2string($projent);
   1186 	if (length($string) > (&PROJECT_BUFSZ - 2)) {
   1187 		push(@err, [3, gettext('projent line too long')]);
   1188 	}
   1189 
   1190 	if (@err) {
   1191 		return (1, \@err);
   1192 	} else {
   1193 		return (0, $projent);
   1194 	}
   1195 }
   1196 
   1197 #
   1198 # projent_validate_name(name, flags)
   1199 #
   1200 # does nothing, as any parse-able project name is valid
   1201 #
   1202 sub projent_validate_name
   1203 {
   1204 	my ($name, $flags) = @_;
   1205 	my @err;
   1206 
   1207 	return (0, \@err);
   1208 	
   1209 }
   1210 
   1211 #
   1212 # projent_validate_projid(projid, flags)
   1213 #
   1214 # Validates that projid is within the valid range of numbers.
   1215 # Valid flag keys:
   1216 #	"res"	- allow reserved projid's 0-99
   1217 #
   1218 sub projent_validate_projid
   1219 {
   1220 	my ($projid, $flags) = @_;	
   1221 	my @err;
   1222 	my $ret = 0;
   1223 	my $minprojid;
   1224 
   1225 	if (defined($flags->{'res'})) {
   1226 		$minprojid = 0;
   1227 	} else {
   1228 		$minprojid = 100;
   1229 	}
   1230 
   1231 	if ($projid < $minprojid) {
   1232 
   1233 		$ret = 1;
   1234 		push(@err, [3, gettext('Invalid projid "%s": '.
   1235 		    'must be >= 100'),
   1236 		    $projid]);
   1237 
   1238 	}
   1239 
   1240 	return ($ret, \@err);
   1241 }
   1242 
   1243 #
   1244 # projent_validate_comment(name, flags)
   1245 #
   1246 # Does nothing, as any parse-able comment is valid.
   1247 #
   1248 sub projent_validate_comment
   1249 {
   1250 	my ($comment, $flags) = @_;
   1251 	my @err;
   1252 
   1253 	return (0, \@err);
   1254 }
   1255 
   1256 #
   1257 # projent_validate_users(ref to list of user names, flags)
   1258 #
   1259 # Verifies that each username is either a valid glob, such
   1260 # as * or !*, or is an existing user.  flags is unused.
   1261 # Also validates that there are no duplicates.
   1262 #
   1263 sub projent_validate_users
   1264 {
   1265 	my ($users, $flags) = @_;
   1266 	my @err;
   1267 	my $ret = 0;
   1268 	my $user;
   1269 	my $username;
   1270 
   1271 	foreach $user (@$users) {
   1272 
   1273 		if ($user eq '*' || $user eq '!*') {
   1274 			next;
   1275 		}
   1276 		$username = $user;
   1277 		$username =~ s/^!//;
   1278 
   1279 		if (!defined(getpwnam($username))) {
   1280 			$ret = 1;
   1281 			push(@err, [6,
   1282 			    gettext('User "%s" does not exist'),
   1283 			    $username]);
   1284 		}
   1285 	}
   1286 
   1287 	my %seen;
   1288         my @dups = grep($seen{$_}++ == 1, @$users);
   1289 	if (@dups) {
   1290 		$ret = 1;
   1291 		push(@err, [3, gettext('Duplicate user names "%s"'),
   1292 		    join(',', @dups)]);
   1293 	}
   1294 	return ($ret, \@err)
   1295 }
   1296 
   1297 #
   1298 # projent_validate_groups(ref to list of group names, flags)
   1299 #
   1300 # Verifies that each groupname is either a valid glob, such
   1301 # as * or !*, or is an existing group.  flags is unused.
   1302 # Also validates that there are no duplicates.
   1303 #
   1304 sub projent_validate_groups
   1305 {
   1306 	my ($groups, $flags) = @_;
   1307 	my @err;
   1308 	my $ret = 0;
   1309 	my $group;
   1310 	my $groupname;
   1311 
   1312 	foreach $group (@$groups) {
   1313 
   1314 		if ($group eq '*' || $group eq '!*') {
   1315 			next;
   1316 		}
   1317 
   1318 		$groupname = $group;
   1319 		$groupname =~ s/^!//;
   1320 
   1321 		if (!defined(getgrnam($groupname))) {
   1322 			$ret = 1;
   1323 			push(@err, [6,
   1324 			    gettext('Group "%s" does not exist'),
   1325 			    $groupname]);
   1326 		}
   1327 	}
   1328 
   1329 	my %seen;
   1330         my @dups = grep($seen{$_}++ == 1, @$groups);
   1331 	if (@dups) {
   1332 		$ret = 1;
   1333 		push(@err, [3, gettext('Duplicate group names "%s"'),
   1334 		    join(',', @dups)]);
   1335 	}
   1336 
   1337 	return ($ret, \@err)
   1338 }
   1339 
   1340 #
   1341 # projent_validate_attribute(attribute hash ref, flags)
   1342 #
   1343 # Verifies that if the attribute's name is a known attribute or
   1344 # resource control, that it contains a valid value.
   1345 # flags is unused.
   1346 #
   1347 sub projent_validate_attribute
   1348 {
   1349 	my ($attribute, $flags) = @_;
   1350 	my $name = $attribute->{'name'};
   1351 	my $values = $attribute->{'values'};
   1352 	my $value;
   1353 	my @errs;
   1354 	my $ret = 0;
   1355 	my $result;
   1356 	my $ref;
   1357 
   1358 	if (defined($values)) {
   1359 		$value = $values->[0];
   1360 	}
   1361 	if ($name eq 'task.final') {
   1362 
   1363 		if (defined($values)) {
   1364 			$ret = 1;
   1365 			push(@errs, [3, gettext(
   1366 			    'task.final should not have value')]);
   1367 		}
   1368 
   1369 	# Need to rcap.max-rss needs to be a number
   1370         } elsif ($name eq 'rcap.max-rss') {
   1371 
   1372 		if (!defined($values)) {
   1373 			$ret = 1;
   1374 			push(@errs, [3, gettext(
   1375 			    'rcap.max-rss missing value')]);
   1376 		} elsif (scalar(@$values) != 1) {
   1377 			$ret = 1;
   1378 			push(@errs, [3, gettext(
   1379 			    'rcap.max-rss should have single value')]);
   1380 		}
   1381 		if (!defined($value) || ref($value)) {
   1382 			$ret = 1;
   1383 			push(@errs, [3, gettext(
   1384 			    'rcap.max-rss has invalid value "%s"'),
   1385 			    projent_values2string($values)]);;
   1386 		} elsif ($value !~ /^\d+$/) {
   1387 			$ret = 1;
   1388 			push(@errs, [3, gettext(
   1389 			    'rcap.max-rss is not an integer value: "%s"'),
   1390 			    projent_values2string($values)]);;
   1391                 } elsif ($value > $MaxNum) { 
   1392 			$ret = 1; 
   1393 			push(@errs, [3, gettext( 
   1394 			    'rcap.max-rss too large')]); 
   1395                 } 
   1396 			
   1397 	} elsif ($name eq 'project.pool') {
   1398 		if (!defined($values)) {
   1399 			$ret = 1;
   1400 			push(@errs, [3, gettext(
   1401 			    'project.pool missing value')]);
   1402 		} elsif (scalar(@$values) != 1) {
   1403 			$ret = 1;
   1404 			push(@errs, [3, gettext(
   1405 			    'project.pool should have single value')]);
   1406 		} elsif (!defined($value) || ref($value)) {
   1407 			$ret = 1;
   1408 			push(@errs, [3, gettext(
   1409 			    'project.pool has invalid value "%s'),
   1410 			    projent_values2string($values)]);;
   1411 		} elsif (!($value =~ /^[[:alpha:]][[:alnum:]_.-]*$/)) {
   1412 			$ret = 1;
   1413 			push(@errs, [3, gettext(
   1414 			    'project.pool: invalid pool name "%s"'),
   1415 			    $value]);
   1416 		# Pool must exist.
   1417 		} elsif (pool_exists($value) != 0) {
   1418 			$ret = 1;
   1419 			push(@errs, [6, gettext(
   1420 			    'project.pool: pools not enabled or pool does '.
   1421 			    'not exist: "%s"'),
   1422 			    $value]);
   1423 		}
   1424 	} else {
   1425 		my $rctlmax;
   1426 		my $rctlflags;
   1427 		my $rules;
   1428 
   1429 		#
   1430 		# See if rctl rules exist for this attribute.  If so, it
   1431 		# is an rctl and is checked for valid values.
   1432 		#
   1433 
   1434 		# check hashed cache of rctl rules.
   1435 		$rules = $RctlRules{$name};
   1436 		if (!defined($rules)) {
   1437 
   1438 			#
   1439 			# See if this is an resource control name, if so
   1440 			# cache rules.
   1441 			#
   1442 			($rctlmax, $rctlflags) = rctl_get_info($name);
   1443 			if (defined($rctlmax)) {
   1444 				$rules = proj_getrctlrules(
   1445 				    $rctlmax, $rctlflags);
   1446 				if (defined($rules)) {
   1447 					$RctlRules{$name} = $rules;
   1448 				} else {
   1449 					$RctlRules{$name} = "NOT AN RCTL";
   1450 				}
   1451 			}	
   1452 		}
   1453 
   1454 		# If rules are defined, this is a resource control.
   1455 		if (defined($rules) && ref($rules)) {
   1456 
   1457 			($result, $ref) =
   1458 			    projent_validate_rctl($attribute, $flags);
   1459 			if ($result != 0) {
   1460 				$ret = 1;
   1461 				push(@errs, @$ref);
   1462 			}
   1463 		}
   1464 	}
   1465 	return ($ret, \@errs);
   1466 }
   1467 
   1468 #
   1469 # projent_validate_attributes(ref to attribute list, flags)
   1470 #
   1471 # Validates all attributes in list of attribute references using
   1472 # projent_validate_attribute.  flags is unused.
   1473 # flags is unused.
   1474 #
   1475 sub projent_validate_attributes
   1476 {
   1477 	my ($attributes, $flags) = @_;
   1478 	my @err;
   1479 	my $ret = 0;
   1480 	my $result = 0;
   1481 	my $ref;
   1482 	my $attribute;
   1483 
   1484 	foreach $attribute (@$attributes) {
   1485 
   1486 		($ret, $ref) = projent_validate_attribute($attribute, $flags);
   1487 		if ($ret != 0) {
   1488 			$result = $ret;
   1489 			push(@err, @$ref);
   1490 		}
   1491 	}
   1492 
   1493 	my %seen;
   1494         my @dups = grep($seen{$_}++ == 1, map { $_->{'name'} } @$attributes);
   1495 	if (@dups) {
   1496 		$result = 1;
   1497 		push(@err, [3, gettext('Duplicate attributes "%s"'),
   1498 		    join(',', @dups)]);
   1499 	}
   1500 
   1501 	return ($result, \@err);
   1502 }
   1503 
   1504 #
   1505 # projent_getrctlrules(max value, global flags)
   1506 #
   1507 # given an rctls max value and global flags, returns a ref to a hash
   1508 # of rctl rules that is used by projent_validate_rctl to validate an
   1509 # rctl's values.
   1510 # 
   1511 sub proj_getrctlrules
   1512 {
   1513 	my ($max, $flags) = @_;
   1514 	my $signals;
   1515 	my $rctl;
   1516 
   1517 	$rctl = {};
   1518 	$signals = 
   1519 	    [ qw(ABRT XRES HUP STOP TERM KILL),
   1520 	      $SigNo{'ABRT'},
   1521 	      $SigNo{'XRES'},
   1522 	      $SigNo{'HUP'},
   1523 	      $SigNo{'STOP'},
   1524 	      $SigNo{'TERM'},
   1525 	      $SigNo{'KILL'} ];
   1526 	
   1527 	$rctl->{'max'} = $max;
   1528 
   1529 	if ($flags & &RCTL_GLOBAL_BYTES) {
   1530 		$rctl->{'type'} = 'bytes';
   1531 	} elsif ($flags & &RCTL_GLOBAL_SECONDS) {
   1532 		$rctl->{'type'} = 'seconds';
   1533 	} elsif ($flags & &RCTL_GLOBAL_COUNT)  {
   1534 		$rctl->{'type'} = 'count';
   1535 	} else {
   1536 		$rctl->{'type'} = 'unknown';
   1537 	}
   1538 	if ($flags & &RCTL_GLOBAL_NOBASIC) {
   1539 		$rctl->{'privs'} = ['privileged', 'priv'];
   1540 	} else {
   1541 		$rctl->{'privs'} = ['basic', 'privileged', 'priv'];
   1542 	}
   1543 
   1544 	if ($flags & &RCTL_GLOBAL_DENY_ALWAYS) {
   1545 		$rctl->{'actions'} = ['deny'];
   1546 
   1547 	} elsif ($flags & &RCTL_GLOBAL_DENY_NEVER) {
   1548 		$rctl->{'actions'} = ['none'];
   1549 	} else {
   1550 		$rctl->{'actions'} = ['none', 'deny'];
   1551 	}
   1552 
   1553 	if ($flags & &RCTL_GLOBAL_SIGNAL_NEVER) {
   1554 		$rctl->{'signals'} = [];
   1555 
   1556 	} else {
   1557 		
   1558 		push(@{$rctl->{'actions'}}, 'sig');
   1559 
   1560 		if ($flags & &RCTL_GLOBAL_CPU_TIME) {
   1561 			push(@$signals, 'XCPU', '30');
   1562 		}
   1563 		if ($flags & &RCTL_GLOBAL_FILE_SIZE) {
   1564 			push(@$signals, 'XFSZ', '31');
   1565 		}
   1566 		$rctl->{'signals'} = $signals;
   1567 	}
   1568 	return ($rctl);
   1569 }
   1570 
   1571 #
   1572 # projent_val2num(scaled value, "seconds" | "count" | "bytes")
   1573 #
   1574 # converts an integer or scaled value to an integer value.
   1575 # returns (integer value, modifier character, unit character.
   1576 #
   1577 # On failure, integer value is undefined.  If the original
   1578 # scaled value is a plain integer, modifier character and
   1579 # unit character will be undefined.
   1580 #
   1581 sub projent_val2num
   1582 {
   1583 	my ($val, $type) = @_;
   1584 	my %scaleM = ( k => 1000,
   1585 		       m => 1000000,
   1586 		       g => 1000000000,
   1587 		       t => 1000000000000,
   1588 		       p => 1000000000000000,
   1589 		       e => 1000000000000000000);
   1590 	my %scaleB = ( k => 1024,
   1591 		       m => 1048576,
   1592 		       g => 1073741824,
   1593 		       t => 1099511627776,
   1594 		       p => 1125899906842624,
   1595 		       e => 1152921504606846976);
   1596 
   1597 	my $scale;
   1598 	my $base;
   1599 	my ($num, $modifier, $unit);
   1600 	my $mul;
   1601 	my $string;
   1602 	my $i;
   1603 	my $undefined;
   1604 	my $exp_unit;
   1605 
   1606 	($num, $modifier, $unit) = $val =~
   1607 	    /^(\d+(?:\.\d+)?)(?i:([kmgtpe])?([bs])?)$/;
   1608 
   1609 	# No numeric match.
   1610 	if (!defined($num)) {
   1611 		return ($undefined, $undefined, $undefined);
   1612 	}
   1613 
   1614 	# Decimal number with no scaling modifier.
   1615 	if (!defined($modifier) && $num =~ /^\d+\.\d+/) {
   1616 		return ($undefined, $undefined, $undefined);
   1617 	}	
   1618 
   1619 	if ($type eq 'bytes') {
   1620 		$exp_unit = 'b';
   1621 		$scale = \%scaleB;
   1622 	} elsif ($type eq 'seconds') {
   1623 		$exp_unit = 's';
   1624 		$scale = \%scaleM;
   1625 	} else {
   1626 		$scale = \%scaleM;
   1627 	}
   1628 
   1629 	if (defined($unit)) {
   1630 		$unit = lc($unit);
   1631 	}
   1632 
   1633 	# So not succeed if unit is incorrect.
   1634 	if (!defined($exp_unit) && defined($unit)) {
   1635 		return ($undefined, $modifier, $unit);
   1636 	}
   1637 	if (defined($unit) && $unit ne $exp_unit) {
   1638 		return ($undefined, $modifier, $unit);
   1639 	}
   1640 
   1641 	if (defined($modifier)) {
   1642 
   1643 		$modifier = lc($modifier);
   1644 		$mul = $scale->{$modifier};
   1645 		$num = $num * $mul;
   1646 	}
   1647 
   1648 	# check for integer overflow.
   1649 	if ($num > $MaxNum) {
   1650 		return ("OVERFLOW", $modifier, $unit);
   1651 	}
   1652 	#
   1653 	# Trim numbers that are decimal equivalent to the maximum value
   1654 	# to the maximum integer value.
   1655 	#
   1656 	if ($num == $MaxNum) {
   1657 		$num = $MaxNum;;
   1658 
   1659 	} elsif ($num < $MaxNum) {
   1660 		# convert any decimal numbers to an integer
   1661 		$num = int($num);
   1662 	}
   1663 
   1664 	return ($num, $modifier, $unit);
   1665 }
   1666 #
   1667 # projent_validate_rctl(ref to rctl attribute hash, flags)
   1668 #
   1669 # verifies that the given rctl hash with keys "name" and
   1670 # "values" contains valid values for the given name.
   1671 # flags is unused.
   1672 #
   1673 sub projent_validate_rctl
   1674 {
   1675 	my ($rctl, $flags) = @_;
   1676 	my $allrules;
   1677 	my $rules;
   1678 	my $name;
   1679 	my $values;
   1680 	my $value;
   1681 	my $valuestring;
   1682 	my $ret = 0;
   1683 	my @err;
   1684 	my $priv;
   1685 	my $val;
   1686 	my @actions;
   1687 	my $action;
   1688 	my $signal;
   1689 	my $sigstring;	# Full signal string on right hand of signal=SIGXXX.
   1690 	my $signame;	# Signal number or XXX part of SIGXXX.
   1691 	my $siglist;
   1692 	my $nonecount;
   1693 	my $denycount;
   1694 	my $sigcount;
   1695 
   1696 	$name = $rctl->{'name'};
   1697 	$values = $rctl->{'values'};
   1698 
   1699 	#
   1700 	# Get the default rules for all rctls, and the specific rules for
   1701 	# this rctl.
   1702 	#
   1703 	$allrules = $RctlRules{'__DEFAULT__'};
   1704 	$rules = $RctlRules{$name};
   1705 
   1706 	if (!defined($rules) || !ref($rules)) {
   1707 		$rules = $allrules;
   1708 	}
   1709 
   1710 	# Allow for no rctl values on rctl.
   1711 	if (!defined($values)) {
   1712 		return (0, \@err);
   1713 	}
   1714 
   1715 	# If values exist, make sure it is a list.
   1716 	if (!ref($values)) {
   1717 
   1718 		push(@err, [3, gettext(
   1719 		    'rctl "%s" missing value'), $name]);
   1720 		return (1, \@err);
   1721 	}
   1722 
   1723 	foreach $value (@$values) {
   1724 
   1725 		# Each value should be a list.
   1726 
   1727 		if (!ref($value)) {
   1728 			$ret = 1;
   1729 			push(@err, [3, gettext(
   1730 			    'rctl "%s" value "%s" should be in ()\'s'),
   1731 				     $name, $value]);
   1732 			
   1733 			next;
   1734 		}
   1735 
   1736 		($priv, $val, @actions) = @$value;
   1737 		if (!@actions) {
   1738 			$ret = 1;
   1739 			$valuestring = projent_values2string([$value]);
   1740 			push(@err, [3, gettext(
   1741 			    'rctl "%s" value missing action "%s"'),
   1742 			    $name, $valuestring]);
   1743 		}
   1744 
   1745 		if (!defined($priv)) {
   1746 			$ret = 1;
   1747 			push(@err, [3, gettext(
   1748 			    'rctl "%s" value missing privilege "%s"'),
   1749 			    $name, $valuestring]);
   1750 
   1751 		} elsif (ref($priv)) {
   1752 			$ret = 1;
   1753 			$valuestring = projent_values2string([$priv]);
   1754 			push(@err, [3, gettext(
   1755 			    'rctl "%s" invalid privilege "%s"'),
   1756 				     $name, $valuestring]);
   1757 
   1758 		} else {
   1759 			if (!(grep /^$priv$/, @{$allrules->{'privs'}})) {
   1760 				
   1761 				$ret = 1;
   1762 				push(@err, [3, gettext(
   1763 			            'rctl "%s" unknown privilege "%s"'),
   1764 				    $name, $priv]);
   1765 
   1766 			} elsif (!(grep /^$priv$/, @{$rules->{'privs'}})) {
   1767 
   1768 				$ret = 1;
   1769 				push(@err, [3, gettext(
   1770 				    'rctl "%s" privilege not allowed '.
   1771 				    '"%s"'), $name, $priv]);
   1772 			}
   1773 		}
   1774 		if (!defined($val)) {
   1775 			$ret = 1;
   1776 			push(@err, [3, gettext(
   1777 			    'rctl "%s" missing value'), $name]);
   1778 
   1779 		} elsif (ref($val)) {
   1780 			$ret = 1;
   1781 			$valuestring = projent_values2string([$val]);
   1782 			push(@err, [3, gettext(
   1783 			    'rctl "%s" invalid value "%s"'),
   1784 				     $name, $valuestring]);
   1785 		
   1786 		} else {
   1787 			if ($val !~ /^\d+$/) {
   1788 				$ret = 1;
   1789 				push(@err, [3, gettext(
   1790 				    'rctl "%s" value "%s" is not '.
   1791 				    'an integer'), $name, $val]);
   1792 
   1793 			} elsif ($val > $rules->{'max'}) {
   1794 				$ret = 1;
   1795 				push(@err, [3, gettext(
   1796 				    'rctl "%s" value "%s" exceeds '.
   1797 				    'system limit'), $name, $val]);
   1798 			}
   1799 		}
   1800 		$nonecount = 0;
   1801 		$denycount = 0;
   1802 		$sigcount = 0;
   1803 
   1804 		foreach $action (@actions) {
   1805 
   1806 			if (ref($action)) {
   1807 				$ret = 1;
   1808 				$valuestring =
   1809 				    projent_values2string([$action]);
   1810 				push(@err, [3, gettext(
   1811 				    'rctl "%s" invalid action "%s"'),
   1812 				     $name, $valuestring]);
   1813 
   1814 				next;
   1815 			}
   1816 
   1817 			if ($action =~ /^sig(nal)?(=.*)?$/) {
   1818 				$signal = $action;
   1819 				$action = 'sig';
   1820 			}
   1821 			if (!(grep /^$action$/, @{$allrules->{'actions'}})) {
   1822 			
   1823 				$ret = 1;
   1824 				push(@err, [3, gettext(
   1825 				    'rctl "%s" unknown action "%s"'),
   1826 				    $name, $action]);
   1827 				next;
   1828 
   1829 			} elsif (!(grep /^$action$/, @{$rules->{'actions'}})) {
   1830 
   1831 				$ret = 1;
   1832 				push(@err, [3, gettext(
   1833 				    'rctl "%s" action not allowed "%s"'),
   1834 				    $name, $action]);
   1835 				next;
   1836 			}
   1837 		
   1838 			if ($action eq 'none') {
   1839 				if ($nonecount >= 1) {
   1840 
   1841 					$ret = 1;
   1842 					push(@err, [3, gettext(
   1843 				    	    'rctl "%s" duplicate action '.
   1844 					    'none'), $name]);
   1845 				}
   1846 				$nonecount++;
   1847 				next;
   1848 			}
   1849 			if ($action eq 'deny') {
   1850 				if ($denycount >= 1) {
   1851 
   1852 					$ret = 1;
   1853 					push(@err, [3, gettext(
   1854 				    	    'rctl "%s" duplicate action '.
   1855 					    'deny'), $name]);
   1856 				}
   1857 				$denycount++;
   1858 				next;
   1859 			}
   1860 
   1861 			# action must be signal
   1862 			if ($sigcount >= 1) {
   1863 
   1864 				$ret = 1;
   1865 				push(@err, [3, gettext(
   1866 			    	    'rctl "%s" duplicate action sig'),
   1867 			    	    $name]);
   1868 			}	
   1869 			$sigcount++;
   1870 
   1871 			#
   1872 			# Make sure signal is correct format, one of:
   1873 			# sig=##
   1874 			# signal=##
   1875 			# sig=SIGXXX
   1876 			# signal=SIGXXX
   1877 			# sig=XXX
   1878 			# signal=SIGXXX
   1879 			#
   1880 			($sigstring) = $signal =~
   1881 			    /^
   1882 				 (?:signal|sig)=
   1883 				     (\d+|
   1884 				     (?:SIG)?[[:upper:]]+(?:[+-][123])?
   1885 				 )
   1886 			     $/x;
   1887 
   1888 			if (!defined($sigstring)) {
   1889 				$ret = 1;
   1890 				push(@err, [3, gettext(
   1891 				    'rctl "%s" invalid signal "%s"'),
   1892 				    $name, $signal]);
   1893 				next;
   1894 			}
   1895 
   1896 			$signame = $sigstring;
   1897 			$signame =~ s/SIG//;
   1898 			
   1899 			# Make sure specific signal is allowed.
   1900 			$siglist = $allrules->{'signals'};
   1901 			if (!(grep /^$signame$/, @$siglist)) {
   1902 				$ret = 1;
   1903 				push(@err, [3, gettext(
   1904 				    'rctl "%s" invalid signal "%s"'),
   1905 				    $name, $signal]);
   1906 				next;
   1907 			}
   1908 			$siglist = $rules->{'signals'};
   1909 
   1910 			if (!(grep /^$signame$/, @$siglist)) {
   1911 				$ret = 1;
   1912 				push(@err, [3, gettext(
   1913 				    'rctl "%s" signal not allowed "%s"'),
   1914 				    $name, $signal]);
   1915 				next;
   1916 			}
   1917 		}
   1918 
   1919 		if ($nonecount && ($denycount || $sigcount)) {
   1920 			$ret = 1;
   1921 			push(@err, [3, gettext(
   1922 			    'rctl "%s" action "none" specified with '.
   1923 			    'other actions'), $name]);
   1924 		}
   1925 	}
   1926 
   1927 	if (@err) {
   1928 		return ($ret, \@err);
   1929 	} else {
   1930 	    return ($ret, \@err);
   1931 	}
   1932 }
   1933 
   1934 1;
   1935