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################################################################################ 11require 5.8.4; 12 13use strict; 14use warnings; 15use locale; 16use Errno; 17use Fcntl; 18use File::Basename; 19use POSIX qw(locale_h limits_h); 20 21package Sun::Solaris::Project; 22 23our $VERSION = '1.9'; 24 25use XSLoader; 26XSLoader::load(__PACKAGE__, $VERSION); 27 28our (@EXPORT_OK, %EXPORT_TAGS); 29my @constants = qw(MAXPROJID PROJNAME_MAX PROJF_PATH PROJECT_BUFSZ 30 SETPROJ_ERR_TASK SETPROJ_ERR_POOL); 31my @syscalls = qw(getprojid); 32my @libcalls = qw(setproject activeprojects getprojent setprojent endprojent 33 getprojbyname getprojbyid getdefaultproj fgetprojent inproj 34 getprojidbyname); 35my @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 49use base qw(Exporter); 50use 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# 57use Config; 58our $MaxNum = &RCTL_MAX_VALUE; 59our %RctlRules; 60 61my %rules; 62our %SigNo; 63my $j; 64my $name; 65foreach $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# 109sub 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# 149sub 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# 227sub 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# 271sub 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# 358sub 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# 381sub 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# 406sub 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# 421sub 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# 471sub 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# 523sub 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# 565sub 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# 693sub 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# 852sub 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; 897sub 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# 931sub 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# 965sub 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# 983sub 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# 1013sub 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# 1073sub 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# 1098sub 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# 1126sub 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# 1181sub 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# 1197sub 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# 1227sub 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# 1242sub 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# 1283sub 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# 1326sub 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# 1454sub 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# 1490sub 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# 1560sub 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# 1652sub 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 19131; 1914