Project.pm revision c9f77c52c0735e65aa2534394c5151cdb963cbef
#
# Copyright (c) 2014 Racktop Systems.
#
#
# Project.pm provides the bootstrap for the Sun::Solaris::Project module, and
# also functions for reading, validating and writing out project(4) format
# files.
#
################################################################################
require 5.0010;
use strict;
use warnings;
use locale;
use Errno;
use Fcntl;
our $VERSION = '1.9';
use XSLoader;
our (@EXPORT_OK, %EXPORT_TAGS);
use base qw(Exporter);
#
# Set up default rules for validating rctls.
# These rules are not global-flag specific, but instead
# are the total set of allowable values on all rctls.
#
use Config;
our $MaxNum = &RCTL_MAX_VALUE;
our %RctlRules;
my %rules;
our %SigNo;
my $j;
my $name;
$j++;
}
%rules = (
$SigNo{'ABRT'},
$SigNo{'XRES'},
$SigNo{'HUP'},
$SigNo{'STOP'},
$SigNo{'TERM'},
$SigNo{'KILL'},
$SigNo{'XFSZ'},
$SigNo{'XCPU'} ],
'max' => $MaxNum
);
#
# projf_combine_errors(errorA, errorlistB)
#
# Concatenates a single error with a list of errors. Each error in the new
# list will have a status matching the status of errorA.
#
# Example:
#
# projf_combine_errors(
# [ 5, "Error on line %d, 10 ],
# [ [ 3, "Invalid Value %s", "foo" ],
# [ 6, "Duplicate Value %s", "bar" ]
# ]);
#
# would return the list ref:
#
# [ [ 5, "Error on line %d: Invalid Value %s", 10, "foo" ],
# [ 5, "Error on line %d: Duplicate Value %s", 10, "bar" ]
# ]
#
# This function is used when a fuction wants to add more information to
# a list of errors returned by another function.
#
{
my $error2;
my $newerror;
my @newerrorlist;
push(@newerrorlist, $newerror);
}
return (\@newerrorlist);
}
#
# projf_read(filename, flags)
#
# Reads and parses a project(4) file, and returns a list of projent hashes.
#
# Inputs:
# filename - file to read
# flags - hash ref of flags
#
# If flags contains key "validate", the project file entries will also be
# validated for run-time correctness If so, the flags ref is forwarded to
# projf_validate().
#
# Return Value:
#
# Returns a ref to a list of projent hashes. See projent_parse() for a
# description of a projent hash.
#
sub projf_read
{
my @projents;
my $projent;
my $linenum = 0;
my @errs;
$linenum++;
# Remove any line continuations and trailing newline.
$line =~ s/\\\n//g;
chomp($line);
push(@errs,
[5,
gettext('Parse error on line %d, line too long'),
$linenum]);
}
if ($ret != 0) {
$ref);
next;
}
#
# Cache original line to save original format if it is
# not changed.
#
}
if ($ret != 0) {
}
}
if (@errs) {
return (1, \@errs);
} else {
return (0, \@projents);
}
}
#
# projf_write(filehandle, projent list)
#
# Write a list of projent hashes to a file handle.
# projent's with key "modified" => false will be
# written using the "line" key. projent's with
# key "modified" => "true" will be written by
# constructing a new line based on their "name"
# "projid", "comment", "userlist", "grouplist"
# and "attributelist" keys.
#
sub projf_write
{
my $projent;
my $string;
} else {
}
print $fh "$string";
}
}
#
# projent_parse(line)
#
# Functions for parsing the project file lines into projent hashes.
#
# Returns a number and a ref, one of:
#
# (0, ref to projent hash)
# (non-zero, ref to list of errors)
#
# Flag can be:
# allowspaces: allow spaces between user and group names.
# allowunits : allow units (K, M, etc), on rctl values.
#
# A projent hash contains the keys:
#
# "name" - string name of project
# "projid" - numeric id of project
# "comment" - comment string
# "users" - , seperated user list string
# "userlist" - list ref to list of user name strings
# "groups" - , seperated group list string
# "grouplist" - list ref to liset of group name strings
# "attributes" - ; seperated attribute list string
# "attributelist" - list ref to list of attribute refs
# (see projent_parse_attributes() for attribute ref)
#
sub projent_parse
{
my $projent = {};
my @errs;
#
# Split fields of project line. split() is not used because
# we must enforce that there are 6 fields.
#
$line =~
/^([^:]*):([^:]*):([^:]*):([^:]*):([^:]*):([^:]*)$/;
# If there is not a complete match, nothing will be defined;
if (!defined($projname)) {
'Incorrect number of fields. Should have 5 ":"\'s.')]);
# Get as many fields as we can.
split(/:/, $line);
}
if (defined($projname)) {
if ($ret != 0) {
}
}
if (defined($projid)) {
if ($ret != 0) {
}
}
if (defined($comment)) {
if ($ret != 0) {
}
}
if (defined($users)) {
if ($ret != 0) {
} else {
}
}
if (defined($groups)) {
if ($ret != 0) {
} else {
}
}
if (defined($attributes)) {
if ($ret != 0) {
} else {
}
}
if (@errs) {
return (1, \@errs);
} else {
return (0, $projent);
}
}
#
# Project name syntax checking.
#
{
my @err;
my ($projname) = @_;
'Invalid project name "%s", contains invalid characters'),
$projname]));
return (1, \@err);
}
if (length($projname) > &PROJNAME_MAX) {
'Invalid project name "%s", name too long'),
$projname]));
return (1, \@err);
}
return (0, $projname);
}
#
# Projid syntax checking.
#
{
my @err;
my ($projid) = @_;
# verify projid is a positive number, and less than UID_MAX
if (!($projid =~ /^\d+$/)) {
$projid]);
return (1, \@err);
$projid]);
return (1, \@err);
} else {
return (0, $projid);
}
}
#
# Project comment syntax checking.
#
{
my ($comment) = @_;
# no restrictions on comments
return (0, $comment);
}
#
# projent_parse_users(string, flags)
#
# Parses "," seperated list of users, and returns list ref to a list of
# user names. If flags contains key "allowspaces", then spaces are
# allowed between user names and ","'s.
#
{
my @err;
my $user;
my $pattern;
my @userlist;
if (exists($flags->{'allowspaces'})) {
$pattern = '\s*,\s*';
} else {
$pattern = ',';
}
# Return empty list if there are no users.
if (!(@userlist)) {
return (0, \@userlist);
}
# Verify each user name is the correct format for a valid user name.
# Allow for wildcards.
next;
}
# Allow for ! operator, usernames must begin with alpha-num,
# and contain alpha-num, '_', digits, '.', or '-'.
$user]);
next;
}
}
if (@err) {
return (1,\ @err);
} else {
return (0, \@userlist);
}
}
#
# projent_parse_groups(string, flags)
#
# Parses "," seperated list of groups, and returns list ref to a list of
# groups names. If flags contains key "allowspaces", then spaces are
# allowed between group names and ","'s.
#
{
my @err;
my $group;
my $pattern;
my @grouplist;
if (exists($flags->{'allowspaces'})) {
$pattern = '\s*,\s*';
} else {
$pattern = ',';
}
# Return empty list if there are no groups.
if (!(@grouplist)) {
return (0, \@grouplist);
}
# Verify each group is the correct format for a valid group name.
# Allow for wildcards.
next;
}
# Allow for ! operator, groupnames can contain only alpha
# characters and digits.
$group]);
next;
}
}
if (@err) {
return (1,\ @err);
} else {
return (0, \@grouplist);
}
}
#
# projent_tokenize_attribute_values(values)
#
# This function splits the values string into a list of tokens. Tokens are
# valid string values and the characters ( ) ,
#
{
#
# This seperates the attribute string into higher level tokens
# for parsing.
#
my $prev;
my $cur;
my $next;
my $token;
my @tokens;
my @newtokens;
my @err;
# Seperate tokens delimited by "(", ")", and ",".
# Get rid of blanks
if (!($token =~ /^[(),]$/ ||
'Invalid Character at or near "%s"'), $token]);
}
}
if (@err) {
return (1, \@err);
} else {
return (0, \@newtokens);
}
}
#
# projent_parse_attribute_values(values)
#
# This function parses the values string into a list of values. Each value
# can be either a scalar value, or a ref to another list of values.
# A ref to the list of values is returned.
#
{
#
# For some reason attribute values can be lists of values and
# sublists, which are scoped using ()'s. All values and sublists
# are delimited by ","'s. Empty values are lists are permitted.
# This function returns a reference to a list of values, each of
# which can be a scalar value, or a reference to a sublist. Sublists
# can contain both scalar values and references to furthur sublists.
#
my ($values) = @_;
my $tokens;
my @usedtokens;
my $token;
my $prev = '';
my $parendepth = 0;
my @valuestack;
my @err;
my $line;
push (@valuestack, []);
if ($ret != 0) {
}
push(@usedtokens, $token);
if ($token eq ',') {
$prev eq '') {
push(@{$valuestack[$#valuestack]}, '');
}
$prev = ',';
next;
}
if ($token eq '(') {
$prev eq '')) {
'"%s" <- "(" unexpected'),
$line]);
return (1, \@err);
}
$parendepth++;
my $arrayref = [];
push(@{$valuestack[$#valuestack]}, $arrayref);
push(@valuestack, $arrayref);
$prev = '(';
next;
}
if ($token eq ')') {
if ($parendepth <= 0) {
'"%s" <- ")" unexpected'),
$line]);
return (1, \@err);
}
push(@{$valuestack[$#valuestack]}, '');
}
$parendepth--;
pop @valuestack;
$prev = ')';
next;
}
'"%s" <- "%s" unexpected'),
return (1, \@err);
}
push(@{$valuestack[$#valuestack]}, $token);
next;
}
if ($parendepth != 0) {
'"%s" <- ")" missing'),
$values]);
return (1, \@err);
}
push(@{$valuestack[$#valuestack]}, '');
}
}
#
# projent_parse_attribute("name=values", $flags)
#
# $flags is a hash ref.
# Valid flags keys:
# 'allowunits' - allows numeric values to be scaled on certain attributes
#
# Returns a hash ref with keys:
#
# "name" - name of attribute
# "values" - ref to list of values.
# Each value can be a scalar value, or a ref to
# a sub-list of values.
#
{
my $attribute = {};
my @err;
my $scale;
my $num;
my $modifier;
my $unit;
my $tuple;
my $rules;
my $rctlmax;
my $rctlflags;
# pattern for matching stock symbols.
my $stockp = '[[:upper:]]{1,5}(?:.[[:upper:]]{1,5})?,';
# Match attribute with no value.
if ($name) {
return (0, $attribute);
}
# Match attribute with value list.
if ($name) {
if (!defined($values)) {
$values = '';
}
if ($ret != 0) {
[3,
gettext('Invalid value on attribute "%s"'),
}
# Scale attributes than can be scaled.
if (exists($flags->{"allowunits"})) {
if ($name eq 'rcap.max-rss' &&
$scale = 'bytes';
if (!defined($num)) {
if (defined($unit)) {
'rcap.max-rss has invalid '.
'unit "%s"'), $unit]);
} else {
'rcap.max-rss has invalid '.
}
} elsif ($num eq "OVERFLOW") {
'"%s" exceeds maximum value "%s"'),
} else {
}
}
# Check hashed cache of rctl rules.
if (!defined($rules)) {
#
# See if this is an resource control name, if so
# cache rules.
#
if (defined($rctlmax)) {
if (defined($rules)) {
} else {
"NOT AN RCTL";
}
}
}
# Scale values if this is an rctl.
# Skip if tuple this is not a list.
if (!ref($tuple)) {
next;
}
# Skip if second element is not scalar.
if (!defined($tuple->[1]) ||
ref($tuple->[1])) {
next;
}
$flags->{'type'});
if (!defined($num)) {
if (defined($unit)) {
'rctl %s has '.
'invalid unit '.
'"%s"'),$name,
$unit]);
} else {
'rctl %s has '.
'invalid value '.
'"%s"'), $name,
$tuple->[1]]);
}
} elsif ($num eq "OVERFLOW") {
'rctl %s value "%s" '.
'exceeds maximum value "%s"'),
} else {
}
}
}
}
if (@err) {
return (1, \@err);
} else {
return (0, $attribute);
}
} else {
# Attribute did not match name[=value,value...]
return (1, \@err);
}
}
#
# projent_parse_attributes("; seperated list of name=values pairs");
#
# Returns a list of attribute references, as returned by
# projent_parse_attribute().
#
{
my ($attributes, $flags) = @_;
my @attributelist;
my @attributestrings;
my $attributestring;
my $attribute;
my @errs;
# Split up attributes by ";"'s.
@attributestrings = split(/;/, $attributes);
# If no attributes, return empty list.
if (!@attributestrings) {
return (0, \@attributelist);
}
foreach $attributestring (@attributestrings) {
$flags);
if ($ret != 0) {
} else {
push(@attributelist, $ref);
}
}
if (@errs) {
return (1, \@errs);
} else {
return (0, \@attributelist);
}
}
#
# projent_values_equal(list A, list B)
#
# Given two references to lists of attribute values (as returned by
# projent_parse_attribute_values()), returns 1 if they are identical
# lists or 0 if they are not.
#
# XXX sub projent_values_equal;
{
my ($x, $y) = @_;
my $itema;
my $itemb;
my $index = 0;
if (ref($x) && ref($y)) {
if (scalar(@$x) != scalar(@$y)) {
return (0);
} else {
foreach $itema (@$x) {
return (0);
}
}
return (1);
}
} elsif ((!ref($x) && (!ref($y)))) {
return ($x eq $y);
} else {
return (0);
}
}
#
# Converts a list of values to a , seperated string, enclosing sublists
# in ()'s.
#
{
my ($values) = @_;
my $string;
my $value;
my @valuelist;
if (!defined($values)) {
return ('');
}
if (!ref($values)) {
return ($values);
}
if (ref($value)) {
push(@valuelist,
} else {
}
}
if (!defined($string)) {
$string = '';
}
return ($string);
}
#
# Converts a ref to an attribute hash with keys "name", and "values" to
# a string in the form "name=value,value...".
#
{
my ($attribute) = @_;
my $string;
}
return ($string);
}
#
# Converts a ref to a projent hash (as returned by projent_parse()) to
# a project(4) database entry line.
#
sub projent_2string
{
my ($projent) = @_;
my @attributestrings;
my $attribute;
}
$projent->{'projid'},
$projent->{'comment'},
join(';', @attributestrings))));
}
#
# projf_validate(ref to list of projents hashes, flags)
#
# For each projent hash ref in the list, checks that users, groups, and pools
# exists, and that known attributes are valid. Attributes matching rctl names
# are verified to have valid values given that rctl's global flags and max
# value.
#
# Valid flag keys:
#
# "res" - allow reserved project ids 0-99
# "dup" - allow duplicate project ids
#
sub projf_validate
{
my $projent;
my $ret;
my $ref;
my @err;
my %idhash;
my %namehash;
my %seenids;
my %seennames;
# check for unique project names
my @lineerr;
'Duplicate project name "%s"'),
$projent->{'name'}]);
}
if (!defined($flags->{'dup'})) {
'Duplicate projid "%s"'),
$projent->{'projid'}]);
}
}
if ($ret != 0) {
}
if (@lineerr) {
'Validation error on line %d'),
}
}
if (@err) {
return (1, \@err);
} else {
return (0, $projents);
}
}
#
# projent_validate_unique_id(
# ref to projent hash, ref to list of projent hashes)
#
# Verifies that projid of the projent hash only exists once in the list of
# projent hashes.
#
{
my @err;
my $ret = 0;
$ret = 1;
$projid]);
}
}
#
# projent_validate_unique_id(
# ref to projent hash, ref to list of projent hashes)
#
# Verifies that project name of the projent hash only exists once in the list
# of projent hashes.
#
# If the seconds argument is a hash ref, it is treated
#
{
my $ret = 0;
my @err;
$ret = 1;
push(@err,
}
}
#
# projent_validate(ref to projents hash, flags)
#
# Checks that users, groups, and pools exists, and that known attributes
# are valid. Attributes matching rctl names are verified to have valid
# values given that rctl's global flags and max value.
#
# Valid flag keys:
#
# "allowspaces" - user and group list are allowed to contain whitespace
# "res" - allow reserved project ids 0-99
#
sub projent_validate
{
my $ret = 0;
my $ref;
my @err;
if ($ret != 0) {
}
if ($ret != 0) {
}
if ($ret != 0) {
}
if ($ret != 0) {
}
if ($ret != 0) {
}
if ($ret != 0) {
}
}
if (@err) {
return (1, \@err);
} else {
return (0, $projent);
}
}
#
# projent_validate_name(name, flags)
#
# does nothing, as any parse-able project name is valid
#
{
my @err;
return (0, \@err);
}
#
# projent_validate_projid(projid, flags)
#
# Validates that projid is within the valid range of numbers.
# Valid flag keys:
# "res" - allow reserved projid's 0-99
#
{
my @err;
my $ret = 0;
my $minprojid;
if (defined($flags->{'res'})) {
$minprojid = 0;
} else {
$minprojid = 100;
}
$ret = 1;
'must be >= 100'),
$projid]);
}
}
#
# projent_validate_comment(name, flags)
#
# Does nothing, as any parse-able comment is valid.
#
{
my @err;
return (0, \@err);
}
#
# projent_validate_users(ref to list of user names, flags)
#
# Verifies that each username is either a valid glob, such
# as * or !*, or is an existing user. flags is unused.
# Also validates that there are no duplicates.
#
{
my @err;
my $ret = 0;
my $user;
my $username;
next;
}
$username =~ s/^!//;
if (!defined(getpwnam($username))) {
$ret = 1;
push(@err, [6,
gettext('User "%s" does not exist'),
$username]);
}
}
my %seen;
if (@dups) {
$ret = 1;
join(',', @dups)]);
}
}
#
# projent_validate_groups(ref to list of group names, flags)
#
# Verifies that each groupname is either a valid glob, such
# as * or !*, or is an existing group. flags is unused.
# Also validates that there are no duplicates.
#
{
my @err;
my $ret = 0;
my $group;
my $groupname;
next;
}
$groupname =~ s/^!//;
if (!defined(getgrnam($groupname))) {
$ret = 1;
push(@err, [6,
gettext('Group "%s" does not exist'),
$groupname]);
}
}
my %seen;
if (@dups) {
$ret = 1;
join(',', @dups)]);
}
}
#
# projent_validate_attribute(attribute hash ref, flags)
#
# Verifies that if the attribute's name is a known attribute or
# resource control, that it contains a valid value.
# flags is unused.
#
{
my $value;
my @errs;
my $ret = 0;
my $result;
my $ref;
if (defined($values)) {
}
if ($name eq 'task.final') {
if (defined($values)) {
$ret = 1;
'task.final should not have value')]);
}
# Need to rcap.max-rss needs to be a number
} elsif ($name eq 'rcap.max-rss') {
if (!defined($values)) {
$ret = 1;
'rcap.max-rss missing value')]);
} elsif (scalar(@$values) != 1) {
$ret = 1;
'rcap.max-rss should have single value')]);
}
$ret = 1;
'rcap.max-rss has invalid value "%s"'),
projent_values2string($values)]);;
} elsif ($value !~ /^\d+$/) {
$ret = 1;
'rcap.max-rss is not an integer value: "%s"'),
projent_values2string($values)]);;
$ret = 1;
'rcap.max-rss too large')]);
}
} elsif ($name eq 'project.pool') {
if (!defined($values)) {
$ret = 1;
'project.pool missing value')]);
} elsif (scalar(@$values) != 1) {
$ret = 1;
'project.pool should have single value')]);
$ret = 1;
'project.pool has invalid value "%s'),
projent_values2string($values)]);;
$ret = 1;
'project.pool: invalid pool name "%s"'),
$value]);
# Pool must exist.
$ret = 1;
'project.pool: pools not enabled or pool does '.
'not exist: "%s"'),
$value]);
}
} else {
my $rctlmax;
my $rctlflags;
my $rules;
#
# See if rctl rules exist for this attribute. If so, it
# is an rctl and is checked for valid values.
#
# check hashed cache of rctl rules.
if (!defined($rules)) {
#
# See if this is an resource control name, if so
# cache rules.
#
if (defined($rctlmax)) {
if (defined($rules)) {
} else {
}
}
}
# If rules are defined, this is a resource control.
if ($result != 0) {
$ret = 1;
}
}
}
}
#
# projent_validate_attributes(ref to attribute list, flags)
#
# Validates all attributes in list of attribute references using
# projent_validate_attribute. flags is unused.
# flags is unused.
#
{
my ($attributes, $flags) = @_;
my @err;
my $ret = 0;
my $result = 0;
my $ref;
my $attribute;
foreach $attribute (@$attributes) {
if ($ret != 0) {
}
}
my %seen;
if (@dups) {
$result = 1;
join(',', @dups)]);
}
}
#
# projent_getrctlrules(max value, global flags)
#
# given an rctls max value and global flags, returns a ref to a hash
# of rctl rules that is used by projent_validate_rctl to validate an
# rctl's values.
#
{
my $signals;
my $rctl;
$rctl = {};
$signals =
$SigNo{'ABRT'},
$SigNo{'XRES'},
$SigNo{'HUP'},
$SigNo{'STOP'},
$SigNo{'TERM'},
$SigNo{'KILL'} ];
if ($flags & &RCTL_GLOBAL_BYTES) {
} elsif ($flags & &RCTL_GLOBAL_SECONDS) {
} elsif ($flags & &RCTL_GLOBAL_COUNT) {
} else {
}
if ($flags & &RCTL_GLOBAL_NOBASIC) {
} else {
}
if ($flags & &RCTL_GLOBAL_DENY_ALWAYS) {
} elsif ($flags & &RCTL_GLOBAL_DENY_NEVER) {
} else {
}
if ($flags & &RCTL_GLOBAL_SIGNAL_NEVER) {
$rctl->{'signals'} = [];
} else {
if ($flags & &RCTL_GLOBAL_CPU_TIME) {
}
if ($flags & &RCTL_GLOBAL_FILE_SIZE) {
}
}
return ($rctl);
}
#
# projent_val2num(scaled value, "seconds" | "count" | "bytes")
#
# converts an integer or scaled value to an integer value.
# returns (integer value, modifier character, unit character.
#
# On failure, integer value is undefined. If the original
# scaled value is a plain integer, modifier character and
# unit character will be undefined.
#
sub projent_val2num
{
my %scaleM = ( k => 1000,
m => 1000000,
g => 1000000000,
t => 1000000000000,
p => 1000000000000000,
e => 1000000000000000000);
my %scaleB = ( k => 1024,
m => 1048576,
g => 1073741824,
t => 1099511627776,
p => 1125899906842624,
e => 1152921504606846976);
my $scale;
my $base;
my $mul;
my $string;
my $i;
my $undefined;
my $exp_unit;
# No numeric match.
if (!defined($num)) {
}
# Decimal number with no scaling modifier.
}
if ($type eq 'bytes') {
$exp_unit = 'b';
} elsif ($type eq 'seconds') {
$exp_unit = 's';
} else {
}
if (defined($unit)) {
}
# So not succeed if unit is incorrect.
}
}
if (defined($modifier)) {
}
# check for integer overflow.
}
#
# Trim numbers that are decimal equivalent to the maximum value
# to the maximum integer value.
#
# convert any decimal numbers to an integer
}
}
#
# projent_validate_rctl(ref to rctl attribute hash, flags)
#
# verifies that the given rctl hash with keys "name" and
# "values" contains valid values for the given name.
# flags is unused.
#
{
my $allrules;
my $rules;
my $name;
my $values;
my $value;
my $valuestring;
my $ret = 0;
my @err;
my $priv;
my $val;
my @actions;
my $action;
my $signal;
my $sigstring; # Full signal string on right hand of signal=SIGXXX.
my $signame; # Signal number or XXX part of SIGXXX.
my $siglist;
my $nonecount;
my $denycount;
my $sigcount;
#
# Get the default rules for all rctls, and the specific rules for
# this rctl.
#
}
# Allow for no rctl values on rctl.
if (!defined($values)) {
return (0, \@err);
}
# If values exist, make sure it is a list.
if (!ref($values)) {
'rctl "%s" missing value'), $name]);
return (1, \@err);
}
# Each value should be a list.
if (!ref($value)) {
$ret = 1;
'rctl "%s" value "%s" should be in ()\'s'),
next;
}
if (!@actions) {
$ret = 1;
'rctl "%s" value missing action "%s"'),
$name, $valuestring]);
}
if (!defined($priv)) {
$ret = 1;
'rctl "%s" value missing privilege "%s"'),
$name, $valuestring]);
} elsif (ref($priv)) {
$ret = 1;
'rctl "%s" invalid privilege "%s"'),
$name, $valuestring]);
} else {
$ret = 1;
'rctl "%s" unknown privilege "%s"'),
$ret = 1;
'rctl "%s" privilege not allowed '.
}
}
if (!defined($val)) {
$ret = 1;
'rctl "%s" missing value'), $name]);
} elsif (ref($val)) {
$ret = 1;
'rctl "%s" invalid value "%s"'),
$name, $valuestring]);
} else {
if ($val !~ /^\d+$/) {
$ret = 1;
'rctl "%s" value "%s" is not '.
$ret = 1;
'rctl "%s" value "%s" exceeds '.
}
}
$nonecount = 0;
$denycount = 0;
$sigcount = 0;
if (ref($action)) {
$ret = 1;
$valuestring =
'rctl "%s" invalid action "%s"'),
$name, $valuestring]);
next;
}
$action = 'sig';
}
$ret = 1;
'rctl "%s" unknown action "%s"'),
next;
$ret = 1;
'rctl "%s" action not allowed "%s"'),
next;
}
if ($action eq 'none') {
if ($nonecount >= 1) {
$ret = 1;
'rctl "%s" duplicate action '.
'none'), $name]);
}
$nonecount++;
next;
}
if ($action eq 'deny') {
if ($denycount >= 1) {
$ret = 1;
'rctl "%s" duplicate action '.
'deny'), $name]);
}
$denycount++;
next;
}
# action must be signal
if ($sigcount >= 1) {
$ret = 1;
'rctl "%s" duplicate action sig'),
$name]);
}
$sigcount++;
#
# Make sure signal is correct format, one of:
# sig=##
# signal=##
# sig=SIGXXX
# signal=SIGXXX
# sig=XXX
# signal=SIGXXX
#
/^
(\d+|
)
$/x;
if (!defined($sigstring)) {
$ret = 1;
'rctl "%s" invalid signal "%s"'),
next;
}
# Make sure specific signal is allowed.
$ret = 1;
'rctl "%s" invalid signal "%s"'),
next;
}
$ret = 1;
'rctl "%s" signal not allowed "%s"'),
next;
}
}
$ret = 1;
'rctl "%s" action "none" specified with '.
'other actions'), $name]);
}
}
if (@err) {
} else {
}
}
1;