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