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(5) format 9# files. 10# 11################################################################################ 12require 5.0010; 13 14use strict; 15use warnings; 16use locale; 17use Errno; 18use Fcntl; 19use File::Basename; 20use POSIX qw(locale_h limits_h); 21 22package Sun::Solaris::Project; 23 24our $VERSION = '1.9'; 25 26use XSLoader; 27XSLoader::load(__PACKAGE__, $VERSION); 28 29our (@EXPORT_OK, %EXPORT_TAGS); 30my @constants = qw(MAXPROJID PROJNAME_MAX PROJF_PATH PROJECT_BUFSZ 31 SETPROJ_ERR_TASK SETPROJ_ERR_POOL); 32my @syscalls = qw(getprojid); 33my @libcalls = qw(setproject activeprojects getprojent setprojent endprojent 34 getprojbyname getprojbyid getdefaultproj fgetprojent inproj 35 getprojidbyname); 36my @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 50use base qw(Exporter); 51use 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# 58use Config; 59our $MaxNum = &RCTL_MAX_VALUE; 60our %RctlRules; 61 62my %rules; 63our %SigNo; 64my $j; 65my $name; 66foreach $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# 110sub 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(5) 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# 150sub 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# 228sub 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# 272sub 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# 359sub 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# 382sub 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# 407sub 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# 422sub 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# 472sub 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# 524sub 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# 566sub 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# 694sub 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# 853sub 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; 898sub 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# 932sub 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# 966sub 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(5) database entry line. 983# 984sub 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# 1014sub 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# 1074sub 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# 1099sub 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# 1127sub 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# 1182sub 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# 1198sub 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# 1228sub 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# 1243sub 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# 1284sub 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# 1327sub 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# 1455sub 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# 1491sub 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# 1561sub 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# 1653sub 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 19141; 1915