usr/src/cmd/perl/contrib/Sun/Solaris/Project/Project.pm

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