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