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