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