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