From 4cc3f7d0cb6f1b12e13134390bf5d75b45b44c63 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 16:17:17 +0200 Subject: [PATCH 01/22] Import Rule-based Editor from ncm-dpmlfc --- src/main/perl/FileEditor.pm | 4 +- src/main/perl/RuleBasedEditor.pm | 911 +++++++++++++++++++++++++++++++ 2 files changed, 914 insertions(+), 1 deletion(-) create mode 100644 src/main/perl/RuleBasedEditor.pm diff --git a/src/main/perl/FileEditor.pm b/src/main/perl/FileEditor.pm index 432283b5..d8cf65e4 100644 --- a/src/main/perl/FileEditor.pm +++ b/src/main/perl/FileEditor.pm @@ -12,7 +12,8 @@ use LC::File; use Exporter; use Fcntl qw(:seek); -our @ISA = qw (CAF::FileWriter Exporter); +use CAF::RuleBasedEditor qw(:rule_constants); +use parent qw(CAF::FileWriter Exporter CAF::RuleBasedEditor); our @EXPORT = qw(BEGINNING_OF_FILE ENDING_OF_FILE); use constant BEGINNING_OF_FILE => (SEEK_SET, 0); @@ -24,6 +25,7 @@ use constant IO_SEEK_END => (0, SEEK_END); use constant SYSCONFIG_SEPARATOR => '='; + =pod =head1 NAME diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm new file mode 100644 index 00000000..7994d1bc --- /dev/null +++ b/src/main/perl/RuleBasedEditor.pm @@ -0,0 +1,911 @@ +# ${license-info} +# ${developer-info} +# ${author-info} +# ${build-info} +# +# +# This module implements a rule-based editor that is used to modify the content +# of an existing file without taking care of the whole file. Each rule +# driving the edition process is applied to one matching line. The input for +# updating the file is the Quattor configuration and conditions can be defined +# based on the contents of this configuration. +# +# IMPORTANT NOTE: this code is used (duplicated) in both ncm-dpmlfc and ncm-xrootd. +# It is planned to move it as a CAF module (see +# https://github.com/quattor/CAF/issues/123). In the meantime be +# sure to keep in sync the code used in both components. The +# main version (with the relevant unit tests) is in ncm-dpmlfc). +# +####################################################################### + +package CAF::RuleBasedEditor; + +use strict; +use warnings; +use NCM::Component; +use vars qw(@ISA $EC); +@ISA = qw(NCM::Component); +$EC=LC::Exception::Context->new->will_store_all; + +use EDG::WP4::CCM::Element; + +use Readonly; + +use Encode qw(encode_utf8); + +local(*DTA); + +# Constant duplicated from FileEditor +use Fcntl qw(:seek); +use constant BEGINNING_OF_FILE => (SEEK_SET, 0); +use constant ENDING_OF_FILE => (SEEK_END, 0); + +# Constants use to format lines in configuration files +# Exported constants +use enum qw(LINE_FORMAT_PARAM=1 + LINE_FORMAT_ENVVAR + LINE_FORMAT_XRDCFG + LINE_FORMAT_XRDCFG_SETENV + LINE_FORMAT_XRDCFG_SET + ); +use enum qw(LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_INSTANCE_PARAMS + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + ); +use enum qw(BITMASK: LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); +# Internal constants +Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_PARAM; +Readonly my $LINE_QUATTOR_COMMENT => "\t\t# Line generated by Quattor"; +Readonly my $LINE_OPT_DEF_REMOVE_IF_UNDEF => 0; +Readonly my $LINE_OPT_DEF_ALWAYS_RULES_ONLY => 0; +Readonly my $RULE_CONDITION_ALWAYS => 'ALWAYS'; +Readonly my $RULE_OPTION_SET_GLOBAL => 'GLOBAL'; + + +# Export constants used to build rules +Readonly my @RULE_CONSTANTS => qw(LINE_FORMAT_PARAM + LINE_FORMAT_ENVVAR + LINE_FORMAT_XRDCFG + LINE_FORMAT_XRDCFG_SETENV + LINE_FORMAT_XRDCFG_SET + LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_INSTANCE_PARAMS + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); +our @EXPORT_OK; +our %EXPORT_TAGS; +push @EXPORT_OK, @RULE_CONSTANTS; +$EXPORT_TAGS{rule_constants} = \@RULE_CONSTANTS; + + +# Backup file extension +Readonly my $BACKUP_FILE_EXT => ".old"; + + +=pod + +=head1 DESCRIPTION + +This module implements a rule-based editor. It has only one public method: B. +Rules are passed as a hash. + +See https://github.com/quattor/CAF/issues/123#issue-123702165 for details. + + +=head2 Public methods + +=over + +=item updateFile + +Update configuration file contents, applying configuration rules. + +Arguments : + config_rules: config rules corresponding to the file to build + config_options: configuration parameters used to build actual configuration + options: a hash setting options to modify the behaviour of this function + +Supported entries for options hash: + always_rules_only: if true, apply only rules with ALWAYS condition (D: false) + remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) + +Return value + always 0 + +=cut + +sub updateFile { + my $function_name = "updateConfigFile"; + my ($self, $config_rules, $config_options, $parser_options) = @_; + + unless ( $config_rules ) { + $self->error("$function_name: 'config_rules' argument missing (internal error)"); + return 1; + } + unless ( $config_options ) { + $self->error("$function_name: 'config_options' argument missing (internal error)"); + return 1; + } + unless ( defined($parser_options) ) { + $self->debug(2,"$function_name: 'parser_options' undefined"); + $parser_options = {}; + } + + $self->seek_begin(); + + # Check that config file has an appropriate header + my $intro_pattern = "# This file is managed by Quattor"; + my $intro = "# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor"; + $self->add_or_replace_lines(qr/^$intro_pattern/, + qr/^$intro$/, + $intro."\n#\n", + BEGINNING_OF_FILE, + ); + + $self->_apply_rules($self, + $config_rules, + $config_options, + $parser_options); + + return 0; +} + + +=pod + +=back + +=head2 Private methods + +=over + +=item formatAttrValue + +This function formats an attribute value based on the value format specified. + +Arguments : + attr_value : attribue value + line_fmt : line format (see LINE_FORMAT_xxx constants) + value_fmt : value format (see LINE_VALUE_xxx constants) + value_opt : value interpretation/formatting options (bitmask, see LINE_VALUE_OPT_xxx constants) + +=cut + +sub _formatAttributeValue { + my $function_name = "_formatAttributeValue"; + my ($self, $attr_value, $line_fmt, $value_fmt, $value_opt) = @_; + + unless ( defined($attr_value) ) { + $self->error("$function_name: 'attr_value' argument missing (internal error)"); + return 1; + } + unless ( defined($line_fmt) ) { + $self->error("$function_name: 'list_fmt' argument missing (internal error)"); + return 1; + } + unless ( defined($value_fmt) ) { + $self->error("$function_name: 'value_fmt' argument missing (internal error)"); + return 1; + } + unless ( defined($value_opt) ) { + $self->error("$function_name: 'value_opt' argument missing (internal error)"); + return 1; + } + + $self->debug(2,"$function_name: formatting attribute value >>>$attr_value<<< (line fmt=$line_fmt, value fmt=$value_fmt, value_opt=$value_opt)"); + + my $formatted_value; + if ( $value_fmt == LINE_VALUE_BOOLEAN ) { + $formatted_value = $attr_value ? 'yes' : 'no'; + + } elsif ( $value_fmt == LINE_VALUE_INSTANCE_PARAMS ) { + $formatted_value = ''; # Don't return undef if no matching attributes is found + # Instance parameters are described in a nlist + $formatted_value .= " -l $attr_value->{logFile}" if $attr_value->{logFile}; + $formatted_value .= " -c $attr_value->{configFile}" if $attr_value->{configFile}; + $formatted_value .= " -k $attr_value->{logKeep}" if $attr_value->{logKeep}; + + } elsif ( $value_fmt == LINE_VALUE_ARRAY ) { + $self->debug(2, "$function_name: array values received: ", join(",",@$attr_value)); + if ( $value_opt & LINE_VALUE_OPT_UNIQUE ) { + my %values = map(($_ => 1), @$attr_value); + $attr_value = [ keys(%values) ]; + $self->debug(2, "$function_name: array values made unique: ", join(",",@$attr_value)); + } + # LINE_VALUE_OPT_UNIQUE implies LINE_VALUE_OPT_SORTED + if ( $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED) ) { + $attr_value = [ sort(@$attr_value) ] if $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED); + $self->debug(2, "$function_name: array values sorted: ", join(",",@$attr_value)); + }; + $formatted_value = join " ", @$attr_value; + + } elsif ( $value_fmt == LINE_VALUE_HASH_KEYS ) { + $formatted_value = join " ", sort keys %$attr_value; + + } elsif ( ($value_fmt == LINE_VALUE_AS_IS) || ($value_fmt == LINE_VALUE_STRING_HASH) ) { + $formatted_value = $attr_value; + + } else { + $self->error("$function_name: invalid value format ($value_fmt) (internal error)") + } + + # Quote value if necessary + if ( ($line_fmt == LINE_FORMAT_PARAM) || ($line_fmt == LINE_FORMAT_ENVVAR) ) { + if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\g1$/)) || + ($value_fmt == LINE_VALUE_BOOLEAN) || + ($formatted_value eq '') ) { + $self->debug(2,"$function_name: quoting value '$formatted_value'"); + $formatted_value = '"' . $formatted_value . '"'; + } + } + + $self->debug(2,"$function_name: formatted value >>>$formatted_value<<<"); + return $formatted_value; +} + + +=pod + +=item _formatConfigLine + +This function formats a configuration line using keyword and value, +according to the line format requested. Values containing spaces are +quoted if the line format is not LINE_FORMAT_XRDCFG. + +Arguments : + keyword : line keyword + value : keyword value (can be empty) + line_fmt : line format (see LINE_FORMAT_xxx constants) + +=cut + +sub _formatConfigLine { + my $function_name = "_formatConfigLine"; + my ($self, $keyword, $value, $line_fmt) = @_; + + unless ( $keyword ) { + $self->error("$function_name: 'keyword' argument missing (internal error)"); + return 1; + } + unless ( defined($value) ) { + $self->error("$function_name: 'value' argument missing (internal error)"); + return 1; + } + unless ( defined($line_fmt) ) { + $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + return 1; + } + + my $config_line = ""; + + if ( $line_fmt == LINE_FORMAT_PARAM ) { + $config_line = "$keyword=$value"; + } elsif ( $line_fmt == LINE_FORMAT_ENVVAR ) { + $config_line = "export $keyword=$value"; + } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SETENV ) { + $config_line = "setenv $keyword = $value"; + } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SET ) { + $config_line = "set $keyword = $value"; + } elsif ( $line_fmt == LINE_FORMAT_XRDCFG ) { + $config_line = $keyword; + $config_line .= " $value" if $value; + # In trust (shift.conf) format, there should be only one blank between + # tokens and no trailing spaces. + $config_line =~ s/\s\s+/ /g; + $config_line =~ s/\s+$//; + } else { + $self->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); + } + + $self->debug(2,"$function_name: Configuration line : >>$config_line<<"); + return $config_line; +} + + +=pod + +=item _buildLinePattern + +This function builds a pattern that will match an existing configuration line for +the configuration parameter specified. The pattern built takes into account the line format. +Every whitespace in the pattern (configuration parameter) are replaced by \s+. +If the line format is LINE_FORMAT_XRDCFG, no whitespace is +imposed at the end of the pattern, as these format can be used to write a configuration +directive as a keyword with no value. + +Arguments : + config_param: parameter to update + line_fmt: line format (see LINE_FORMAT_xxx constants) + config_value: when defined, make it part of the pattern (used when multiple lines + with the same keyword are allowed) + +=cut + +sub _buildLinePattern { + my $function_name = "_buildLinePattern"; + my ($self, $config_param, $line_fmt, $config_value) = @_; + + unless ( $config_param ) { + $self->error("$function_name: 'config_param' argument missing (internal error)"); + return undef; + } + unless ( defined($line_fmt) ) { + $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + return undef; + } + if ( defined($config_value ) ) { + $self->debug(2,"$function_name: configuration value '$config_value' will be added to the pattern"); + $config_value =~ s/\\/\\\\/g; + $config_value =~ s/([\-\+\?\.\*\[\]()\^\$])/\\$1/g; + $config_value =~ s/\s+/\\s+/g; + } else { + $config_value = ""; + } + + # config_param is generally a keyword and in this case it contains no whitespace. + # A special case is when config_param (the rule keyword) is used to match a line + # without specifying a rule: in this case it may contains whitespaces. Remove strict + # matching of them (match any type/number of whitespaces at the same position). + # Look at %trust_config_rules in ncm-dpmlfc Perl module for an example. + $config_param =~ s/\s+/\\s+/g; + + my $config_param_pattern; + if ( $line_fmt == LINE_FORMAT_PARAM ) { + $config_param_pattern = "#?\\s*$config_param=".$config_value; + } elsif ( $line_fmt == LINE_FORMAT_ENVVAR ) { + $config_param_pattern = "#?\\s*export $config_param=".$config_value; + } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SETENV ) { + $config_param_pattern = "#?\\s*setenv\\s+$config_param\\s*=\\s*".$config_value; + } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SET ) { + $config_param_pattern = "#?\\s*set\\s+$config_param\\s*=\\s*".$config_value; + } elsif ( $line_fmt == LINE_FORMAT_XRDCFG ) { + $config_param_pattern = "#?\\s*$config_param"; + # Avoid adding a whitespace requirement if there is no config_value + if ( $config_value ne "" ) { + $config_param_pattern .= "\\s+" . $config_value; + } + } else { + $self->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); + return undef; + } + + return $config_param_pattern +} + + +=pod + +=item _removeConfigLine + +This function comments out a configuration line matching the configuration parameter. +Match operation takes into account the line format. + +Arguments : + config_param: parameter to update + line_fmt : line format (see LINE_FORMAT_xxx constants) + +=cut + +sub _removeConfigLine { + my $function_name = "_removeConfigLine"; + my ($self, $config_param, $line_fmt) = @_; + + unless ( $config_param ) { + $self->error("$function_name: 'config_param' argument missing (internal error)"); + return 1; + } + unless ( defined($line_fmt) ) { + $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + return 1; + } + + # Build a pattern to look for. + my $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt); + + $self->debug(1,"$function_name: commenting out lines matching pattern >>>".$config_param_pattern."<<<"); + # All matching lines must be commented out, except if they are already commented out. + # The code used is a customized version of FileEditor::replace() that lacks support for backreferences + # in the replacement value (here we want to rewrite the same line commented out but we don't know the + # current line contents, only a regexp matching it). + my @lns; + my $line_count = 0; + $self->seek_begin(); + while (my $l = <$self>) { + if ($l =~ qr/^$config_param_pattern/ && $l !~ qr/^\s*#/) { + $self->debug(2,"$function_name: commenting out matching line >>>".$l."<<<"); + $line_count++; + push (@lns, '#'.$l); + } else { + push (@lns, $l); + } + } + if ( $line_count == 0 ) { + $self->debug(1, "$function_name: No line found matching the pattern"); + } else { + $self->debug(1, "$function_name: $line_count lines commented out"); + } + $self->set_contents (join("", @lns)); + +} + + +=pod + +=item _updateConfigLine + +This function does the actual update of a configuration line after doing the final +line formatting based on the line format. + +Arguments : + config_param: parameter to update + config_value : parameter value (can be empty) + line_fmt : line format (see LINE_FORMAT_xxx constants) + multiple : if true, multiple lines with the same keyword can exist (D: false) + +=cut + +sub _updateConfigLine { + my $function_name = "_updateConfigLine"; + my ($self, $config_param, $config_value, $line_fmt, $multiple) = @_; + + unless ( $config_param ) { + $self->error("$function_name: 'config_param' argument missing (internal error)"); + return 1; + } + unless ( defined($config_value) ) { + $self->error("$function_name: 'config_value' argument missing (internal error)"); + return 1; + } + unless ( defined($line_fmt) ) { + $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + return 1; + } + unless ( defined($multiple) ) { + $multiple = 0; + } + + my $config_param_pattern; + my $new_line = $self->_formatConfigLine($config_param,$config_value,$line_fmt); + + # Build a pattern to look for. + if ( $multiple ) { + $self->debug(2,"$function_name: 'multiple' flag enabled"); + $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt,$config_value); + } else { + $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt); + if ( ($line_fmt == LINE_FORMAT_XRDCFG) && $config_value ) { + $config_param_pattern .= "\\s+"; # If the value is defined in these formats, impose a whitespace at the end + } + } + + # Update the matching configuration lines + if ( $new_line ) { + my $comment = ""; + if ( ($line_fmt == LINE_FORMAT_PARAM) || ($line_fmt == LINE_FORMAT_ENVVAR) ) { + $comment = $LINE_QUATTOR_COMMENT; + } + $self->debug(1,"$function_name: checking expected configuration line ($new_line) with pattern >>>".$config_param_pattern."<<<"); + $self->add_or_replace_lines(qr/^\s*$config_param_pattern/, + qr/^\s*$new_line$/, + $new_line.$comment."\n", + ENDING_OF_FILE, + ); + } +} + + +=pod + +=item _parse_rule + +Parse a rule and return as a hash the information necessary to edit lines. If the rule +condition is not met, undef is returned. If an error occured, the hash contains more +information about the error. + +Arguments : + rule: rule to parse + config_options: configuration parameters used to build actual configuration + parser_options: a hash setting options to modify the behaviour of this method + +Supported entries for options hash: + always_rules_only: if true, apply only rules with ALWAYS condition (D: false) + remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) + +Return value: undef if the rule condition is not met or a hash with the following information: + error_msg: a non empty string if an error happened during parsing + remove_matching_lines: a boolean indicating that the matching lines must be removed + option_sets: a list of option sets containing the attribute to use in the updated line + attribute: the option attribute to use in the updated line + +=cut + +sub _parse_rule { + my $function_name = "_parse_rule"; + my ($self, $rule, $config_options, $parser_options) = @_; + my %rule_info; + + unless ( $rule ) { + $self->error("$function_name: 'rule' argument missing (internal error)"); + $rule_info{error_msg} = "rule parser internal error (missing argument)"; + return \%rule_info; + } + unless ( $config_options ) { + $self->error("$function_name: 'config_options' argument missing (internal error)"); + $rule_info{error_msg} = "rule parser internal error (missing argument)"; + return \%rule_info; + } + unless ( defined($parser_options) ) { + $self->debug(2,"$function_name: 'parser_options' undefined"); + $parser_options = {}; + } + if ( defined($parser_options->{always_rules_only}) ) { + $self->debug(1,"$function_name: 'always_rules_only' option set to ".$parser_options->{always_rules_only}); + } else { + $self->debug(1,"$function_name: 'always_rules_only' option not defined: assuming $LINE_OPT_DEF_ALWAYS_RULES_ONLY"); + $parser_options->{always_rules_only} = $LINE_OPT_DEF_ALWAYS_RULES_ONLY; + } + + (my $condition, my $tmp) = split /->/, $rule; + if ( $tmp ) { + $rule = $tmp; + } else { + $condition = ""; + } + $self->debug(1,"$function_name: condition=>>>$condition<<<, rule=>>>$rule<<<"); + + # Check if only rules with ALWAYS condition must be applied. + # ALWAYS is a special condition that is used to flag the only rules that + # must be applied if the option always_rules_only is set. When this option + # is not set, this condition has no effect and is just reset to an empty conditions. + if ( $parser_options->{always_rules_only} ) { + if ( $condition ne $RULE_CONDITION_ALWAYS ) { + $self->debug(1,"$function_name: rule ignored ($RULE_CONDITION_ALWAYS condition not set)"); + return; + } + } + if ( $condition eq $RULE_CONDITION_ALWAYS ) { + $condition = ''; + } + + # Check if rule condition is met if one is defined + if ( $condition ne "" ) { + $self->debug(1,"$function_name: checking condition >>>$condition<<<"); + + # Condition may be negated if it starts with a !: remove it from the condition value. + # If the condition is negated, when the condition is true the rule must not be applied. + my $negate = 0; + if ( $condition =~ /^!/ ) { + $negate = 1; + $condition =~ s/^!//; + } + my ($cond_attribute,$cond_option_set) = split /:/, $condition; + unless ( $cond_option_set ) { + $cond_option_set = $cond_attribute; + $cond_attribute = ""; + } + $self->debug(2,"$function_name: condition option set = '$cond_option_set', ". + "condition attribute = '$cond_attribute', negate=$negate"); + my $cond_satisfied = 1; # Assume condition is satisfied + if ( $cond_attribute ) { + # Due to Perl autovivification, testing directly exists($config_options->{$cond_option_set}->{$cond_attribute}) will spring + # $config_options->{$cond_option_set} into existence if it doesn't exist. + my $cond_true = $config_options->{$cond_option_set} && + exists($config_options->{$cond_option_set}->{$cond_attribute}); + if ( $negate ) { + $cond_satisfied = 0 if $cond_true; + } else { + $cond_satisfied = 0 unless $cond_true; + } + } elsif ( $cond_option_set ) { + if ( $negate ) { + $cond_satisfied = 0 if exists($config_options->{$cond_option_set}); + } else { + $cond_satisfied = 0 unless exists($config_options->{$cond_option_set}); + } + } + if ( !$cond_satisfied ) { + # When the condition is not satisfied and if option remove_if_undef is set, + # remove configuration line (if present). + $self->debug(1,"$function_name: condition not satisfied, flag set to remove matching configuration lines"); + $rule_info{remove_matching_lines} = 1; + return \%rule_info; + } + } + + my @option_sets; + ($rule_info{attribute}, my $option_sets_str) = split /:/, $rule; + if ( $option_sets_str ) { + @option_sets = split /\s*,\s*/, $option_sets_str; + } + $rule_info{option_sets} = \@option_sets; + + return \%rule_info; +} + + +=pod + +=item _apply_rules + +Apply configuration rules. This method is the real workhorse of the rule-based editor. + +Arguments : + config_rules: config rules corresponding to the file to build + config_options: configuration parameters used to build actual configuration + parser_options: a hash setting options to modify the behaviour of this function + +Supported entries for options hash: + always_rules_only: if true, apply only rules with ALWAYS condition (D: false) + remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) + +=cut + +sub _apply_rules { + my $function_name = "_apply_rules"; + my ($self, $config_rules, $config_options, $parser_options) = @_; + + unless ( $config_rules ) { + $self->error("$function_name: 'config_rules' argument missing (internal error)"); + return 1; + } + unless ( $config_options ) { + $self->error("$function_name: 'config_options' argument missing (internal error)"); + return 1; + } + unless ( defined($parser_options) ) { + $self->debug(2,"$function_name: 'parser_options' undefined"); + $parser_options = {}; + } + if ( defined($parser_options->{remove_if_undef}) ) { + $self->debug(1,"$function_name: 'remove_if_undef' option set to ".$parser_options->{remove_if_undef}); + } else { + $self->debug(1,"$function_name: 'remove_if_undef' option not defined: assuming $LINE_OPT_DEF_REMOVE_IF_UNDEF"); + $parser_options->{remove_if_undef} = $LINE_OPT_DEF_REMOVE_IF_UNDEF; + } + + + # Loop over all config rule entries. + # Config rules are stored in a hash whose key is the variable to write + # and whose value is the rule itself. + # If the variable name start with a '-', this means that the matching configuration + # line must be commented out unconditionally. + # Each rule format is '[condition->]attribute:option_set[,option_set,...];line_fmt' where + # condition: either a role that must be enabled or ALWAYS if the rule must be applied + # when 'always_rules_only' is true. A role is enabled if 'role_enabled' is + # true in the corresponding option set. + # option_set and attribute: attribute in option set that must be substituted + # line_fmt: the format to use when building the line + # An empty rule is valid and means that the keyword part must be + # written as is, using the line_fmt specified. + + my $rule_id = 0; + foreach my $keyword (sort keys %$config_rules) { + my $rule = $config_rules->{$keyword}; + $rule = '' unless defined($rule); + $rule_id++; + + # Initialize parser_options for this rule according the default for this file + my $rule_parsing_options = { %{$parser_options} }; + + # Check if the keyword is prefixed by: + # - a '-': in this case the corresponding line must be unconditionally + # commented out if it is present + # - a '*': in this case the corresponding line must be commented out if + # it is present and the option is undefined + my $comment_line = 0; + if ( $keyword =~ /^-/ ) { + $keyword =~ s/^-//; + $comment_line = 1; + } elsif ( $keyword =~ /^\?/ ) { + $keyword =~ s/^\?//; + $rule_parsing_options->{remove_if_undef} = 1; + $self->debug(2,"$function_name: 'remove_if_undef' option set for the current rule"); + } + + # Split different elements of the rule + ($rule, my $line_fmt, my $value_fmt) = split /;/, $rule; + unless ( $line_fmt ) { + $line_fmt = $LINE_FORMAT_DEFAULT; + } + my $value_opt; + if ( $value_fmt ) { + ($value_fmt, $value_opt) = split /:/, $value_fmt; + }else { + $value_fmt = LINE_VALUE_AS_IS; + } + unless ( defined($value_opt) ) { + # $value_opt is a bitmask. Set to 0 if not specified. + $value_opt = 0; + } + + + # If the keyword was "negated", remove (comment out) configuration line if present and enabled + if ( $comment_line ) { + $self->debug(1,"$function_name: keyword '$keyword' negated, removing configuration line"); + $self->_removeConfigLine($keyword,$line_fmt); + next; + } + + + # Parse rule if it is non empty + my $rule_info; + if ( $rule ne '' ) { + $self->debug(1,"$function_name: processing rule $rule_id (variable=>>>$keyword<<<, rule=>>>$rule<<<, fmt=$line_fmt)"); + $rule_info = $self->_parse_rule($rule,$config_options,$rule_parsing_options); + next unless $rule_info; + $self->debug(2,"$function_name: information returned by rule parser: ".join(" ",sort(keys(%$rule_info)))); + + if ( exists($rule_info->{error_msg}) ) { + $self->error("Error parsing rule >>>$rule<<<: ".$rule_info->{error_msg}); + # FIXME: decide whether an invalid rule is just ignored or causes any modification to be prevented. + # $self->cancel() + next; + } elsif ( $rule_info->{remove_matching_lines} ) { + if ( $rule_parsing_options->{remove_if_undef} ) { + $self->debug(1,"$function_name: removing configuration lines for keyword '$keyword'"); + $self->_removeConfigLine($keyword,$line_fmt); + } else { + $self->debug(1,"$function_name: remove_if_undef not set, ignoring line to remove"); + } + next; + } + } + + # Build the value to be substitued for each option set specified. + # option_set=GLOBAL is a special case indicating a global option instead of an + # attribute in a specific option set. + my $config_value = ""; + my $attribute_present = 1; + my $config_updated = 0; + my @array_values; + if ( $rule_info->{attribute} ) { + foreach my $option_set (@{$rule_info->{option_sets}}) { + my $attr_value; + $self->debug(1,"$function_name: retrieving '".$rule_info->{attribute}."' value in option set $option_set"); + if ( $option_set eq $RULE_OPTION_SET_GLOBAL ) { + if ( exists($config_options->{$rule_info->{attribute}}) ) { + $attr_value = $config_options->{$rule_info->{attribute}}; + } else { + $self->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in global option set"); + $attribute_present = 0; + } + } else { + # See comment above about Perl autovivification and impact on testing attribute existence + if ( $config_options->{$option_set} && exists($config_options->{$option_set}->{$rule_info->{attribute}}) ) { + $attr_value = $config_options->{$option_set}->{$rule_info->{attribute}}; + } else { + $self->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in option set '$option_set'"); + $attribute_present = 0; + } + } + + # If attribute is not defined in the present configuration, check if there is a matching + # line in the config file for the keyword and comment it out. This requires option + # remove_if_undef to be set. + # Note that this will never match instance parameters and will not remove entries + # no longer part of the configuration in a still existing LINE_VALUE_ARRAY or + # LINE_VALUE_STRING_HASH. + unless ( $attribute_present ) { + if ( $rule_parsing_options->{remove_if_undef} ) { + $self->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' undefined, removing configuration line"); + $self->_removeConfigLine($keyword,$line_fmt); + } + next; + } + + # Instance parameters are specific, as this is a nlist of instance + # with the value being a nlist of parameters for the instance. + # Also the variable name must be updated to contain the instance name. + # One configuration line must be written/updated for each instance. + if ( $value_fmt == LINE_VALUE_INSTANCE_PARAMS ) { + foreach my $instance (sort keys %{$attr_value}) { + my $params = $attr_value->{$instance}; + $self->debug(1,"$function_name: formatting instance '$instance' parameters ($params)"); + $config_value = $self->_formatAttributeValue($params, + $line_fmt, + $value_fmt, + $value_opt, + ); + my $config_param = $keyword; + my $instance_uc = uc($instance); + $config_param =~ s/%%INSTANCE%%/$instance_uc/; + $self->debug(2,"New variable name generated: >>>$config_param<<<"); + $self->_updateConfigLine($config_param,$config_value,$line_fmt); + } + $config_updated = 1; + } elsif ( $value_fmt == LINE_VALUE_STRING_HASH ) { + # With this value format, several lines with the same keyword are generated, + # one for each key/value pair. + foreach my $k (sort keys %$attr_value) { + my $v = $attr_value->{$k}; + # Value is made by joining key and value as a string + # Keys may be escaped if they contain characters like '/': unescaping a non-escaped + # string is generally harmless. + my $tmp = unescape($k)." $v"; + $self->debug(1,"$function_name: formatting (string hash) attribute '".$rule_info->{attribute}."' value ($tmp, value_fmt=$value_fmt)"); + $config_value = $self->_formatAttributeValue($tmp, + $line_fmt, + $value_fmt, + $value_opt, + ); + $self->_updateConfigLine($keyword,$config_value,$line_fmt,1); + } + $config_updated = 1; + } elsif ( $value_fmt == LINE_VALUE_ARRAY ) { + # Arrays are not processed immediately. First, all the values from all the options sets + # are collected into one array that will be processed later according to LINE_VALUE_OPT_xxx + # options specified (if any). + @array_values = (@array_values, @$attr_value) + } else { + $self->debug(1,"$function_name: formatting attribute '".$rule_info->{attribute}."' value ($attr_value, value_fmt=$value_fmt)"); + $config_value .= ' ' if $config_value; + $config_value .= $self->_formatAttributeValue($attr_value, + $line_fmt, + $value_fmt, + $value_opt, + ); + $self->debug(2,"$function_name: adding attribute '".$rule_info->{attribute}."' from option set '".$option_set. + "' to value (config_value=".$config_value.")"); + } + } + } else { + # $rule_info->{attribute} empty means an empty rule : in this case,just write the configuration param. + $self->debug(1,"$function_name: no attribute specified in rule '$rule'"); + } + + # There is a delayed formatting of arrays after collecting all the values from all + # the option sets in the rule. Formatting is done taking into account the relevant + # LINE_VALUE_OPT_xxx specified (bitmask). + if ( $value_fmt == LINE_VALUE_ARRAY ) { + if ( $value_opt & LINE_VALUE_OPT_SINGLE ) { + # With this value format, several lines with the same keyword are generated, + # one for each array value (if value_opt is not LINE_VALUE_OPT_SINGLE, all + # the values are concatenated on one line). + $self->debug(1,"$function_name: formatting (array) attribute '".$rule_info->{attribute}."as LINE_VALUE_OPT_SINGLE"); + foreach my $val (@array_values) { + $config_value = $self->_formatAttributeValue($val, + $line_fmt, + LINE_VALUE_AS_IS, + $value_opt, + ); + $self->_updateConfigLine($keyword,$config_value,$line_fmt,1); + } + $config_updated = 1; + } else { + $config_value = $self->_formatAttributeValue(\@array_values, + $line_fmt, + $value_fmt, + $value_opt, + ); + } + } + + # Instance parameters, string hashes have already been written + if ( !$config_updated && $attribute_present ) { + $self->_updateConfigLine($keyword,$config_value,$line_fmt); + } + + } + +} + + +=pod + +=back + +=cut + +1; # Required for PERL modules From 0d01b25c3b74d50be098b3b94616d699361ceb22 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 18:23:10 +0200 Subject: [PATCH 02/22] RuleBasedEditor.pm: fix calling sequence for reporting methods --- src/main/perl/RuleBasedEditor.pm | 134 +++++++++++++++---------------- 1 file changed, 67 insertions(+), 67 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index 7994d1bc..015cbfff 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -131,15 +131,15 @@ sub updateFile { my ($self, $config_rules, $config_options, $parser_options) = @_; unless ( $config_rules ) { - $self->error("$function_name: 'config_rules' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); return 1; } unless ( $config_options ) { - $self->error("$function_name: 'config_options' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); return 1; } unless ( defined($parser_options) ) { - $self->debug(2,"$function_name: 'parser_options' undefined"); + *$self->{LOG}->debug(2,"$function_name: 'parser_options' undefined"); $parser_options = {}; } @@ -188,23 +188,23 @@ sub _formatAttributeValue { my ($self, $attr_value, $line_fmt, $value_fmt, $value_opt) = @_; unless ( defined($attr_value) ) { - $self->error("$function_name: 'attr_value' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'attr_value' argument missing (internal error)"); return 1; } unless ( defined($line_fmt) ) { - $self->error("$function_name: 'list_fmt' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'list_fmt' argument missing (internal error)"); return 1; } unless ( defined($value_fmt) ) { - $self->error("$function_name: 'value_fmt' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'value_fmt' argument missing (internal error)"); return 1; } unless ( defined($value_opt) ) { - $self->error("$function_name: 'value_opt' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'value_opt' argument missing (internal error)"); return 1; } - $self->debug(2,"$function_name: formatting attribute value >>>$attr_value<<< (line fmt=$line_fmt, value fmt=$value_fmt, value_opt=$value_opt)"); + *$self->{LOG}->debug(2,"$function_name: formatting attribute value >>>$attr_value<<< (line fmt=$line_fmt, value fmt=$value_fmt, value_opt=$value_opt)"); my $formatted_value; if ( $value_fmt == LINE_VALUE_BOOLEAN ) { @@ -218,16 +218,16 @@ sub _formatAttributeValue { $formatted_value .= " -k $attr_value->{logKeep}" if $attr_value->{logKeep}; } elsif ( $value_fmt == LINE_VALUE_ARRAY ) { - $self->debug(2, "$function_name: array values received: ", join(",",@$attr_value)); + *$self->{LOG}->debug(2, "$function_name: array values received: ", join(",",@$attr_value)); if ( $value_opt & LINE_VALUE_OPT_UNIQUE ) { my %values = map(($_ => 1), @$attr_value); $attr_value = [ keys(%values) ]; - $self->debug(2, "$function_name: array values made unique: ", join(",",@$attr_value)); + *$self->{LOG}->debug(2, "$function_name: array values made unique: ", join(",",@$attr_value)); } # LINE_VALUE_OPT_UNIQUE implies LINE_VALUE_OPT_SORTED if ( $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED) ) { $attr_value = [ sort(@$attr_value) ] if $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED); - $self->debug(2, "$function_name: array values sorted: ", join(",",@$attr_value)); + *$self->{LOG}->debug(2, "$function_name: array values sorted: ", join(",",@$attr_value)); }; $formatted_value = join " ", @$attr_value; @@ -238,7 +238,7 @@ sub _formatAttributeValue { $formatted_value = $attr_value; } else { - $self->error("$function_name: invalid value format ($value_fmt) (internal error)") + *$self->{LOG}->error("$function_name: invalid value format ($value_fmt) (internal error)") } # Quote value if necessary @@ -246,12 +246,12 @@ sub _formatAttributeValue { if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\g1$/)) || ($value_fmt == LINE_VALUE_BOOLEAN) || ($formatted_value eq '') ) { - $self->debug(2,"$function_name: quoting value '$formatted_value'"); + *$self->{LOG}->debug(2,"$function_name: quoting value '$formatted_value'"); $formatted_value = '"' . $formatted_value . '"'; } } - $self->debug(2,"$function_name: formatted value >>>$formatted_value<<<"); + *$self->{LOG}->debug(2,"$function_name: formatted value >>>$formatted_value<<<"); return $formatted_value; } @@ -276,15 +276,15 @@ sub _formatConfigLine { my ($self, $keyword, $value, $line_fmt) = @_; unless ( $keyword ) { - $self->error("$function_name: 'keyword' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'keyword' argument missing (internal error)"); return 1; } unless ( defined($value) ) { - $self->error("$function_name: 'value' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'value' argument missing (internal error)"); return 1; } unless ( defined($line_fmt) ) { - $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); return 1; } @@ -306,10 +306,10 @@ sub _formatConfigLine { $config_line =~ s/\s\s+/ /g; $config_line =~ s/\s+$//; } else { - $self->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); + *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); } - $self->debug(2,"$function_name: Configuration line : >>$config_line<<"); + *$self->{LOG}->debug(2,"$function_name: Configuration line : >>$config_line<<"); return $config_line; } @@ -338,15 +338,15 @@ sub _buildLinePattern { my ($self, $config_param, $line_fmt, $config_value) = @_; unless ( $config_param ) { - $self->error("$function_name: 'config_param' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); return undef; } unless ( defined($line_fmt) ) { - $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); return undef; } if ( defined($config_value ) ) { - $self->debug(2,"$function_name: configuration value '$config_value' will be added to the pattern"); + *$self->{LOG}->debug(2,"$function_name: configuration value '$config_value' will be added to the pattern"); $config_value =~ s/\\/\\\\/g; $config_value =~ s/([\-\+\?\.\*\[\]()\^\$])/\\$1/g; $config_value =~ s/\s+/\\s+/g; @@ -377,7 +377,7 @@ sub _buildLinePattern { $config_param_pattern .= "\\s+" . $config_value; } } else { - $self->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); + *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); return undef; } @@ -403,18 +403,18 @@ sub _removeConfigLine { my ($self, $config_param, $line_fmt) = @_; unless ( $config_param ) { - $self->error("$function_name: 'config_param' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); return 1; } unless ( defined($line_fmt) ) { - $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); return 1; } # Build a pattern to look for. my $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt); - $self->debug(1,"$function_name: commenting out lines matching pattern >>>".$config_param_pattern."<<<"); + *$self->{LOG}->debug(1,"$function_name: commenting out lines matching pattern >>>".$config_param_pattern."<<<"); # All matching lines must be commented out, except if they are already commented out. # The code used is a customized version of FileEditor::replace() that lacks support for backreferences # in the replacement value (here we want to rewrite the same line commented out but we don't know the @@ -424,7 +424,7 @@ sub _removeConfigLine { $self->seek_begin(); while (my $l = <$self>) { if ($l =~ qr/^$config_param_pattern/ && $l !~ qr/^\s*#/) { - $self->debug(2,"$function_name: commenting out matching line >>>".$l."<<<"); + *$self->{LOG}->debug(2,"$function_name: commenting out matching line >>>".$l."<<<"); $line_count++; push (@lns, '#'.$l); } else { @@ -432,9 +432,9 @@ sub _removeConfigLine { } } if ( $line_count == 0 ) { - $self->debug(1, "$function_name: No line found matching the pattern"); + *$self->{LOG}->debug(1, "$function_name: No line found matching the pattern"); } else { - $self->debug(1, "$function_name: $line_count lines commented out"); + *$self->{LOG}->debug(1, "$function_name: $line_count lines commented out"); } $self->set_contents (join("", @lns)); @@ -461,15 +461,15 @@ sub _updateConfigLine { my ($self, $config_param, $config_value, $line_fmt, $multiple) = @_; unless ( $config_param ) { - $self->error("$function_name: 'config_param' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); return 1; } unless ( defined($config_value) ) { - $self->error("$function_name: 'config_value' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_value' argument missing (internal error)"); return 1; } unless ( defined($line_fmt) ) { - $self->error("$function_name: 'line_fmt' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); return 1; } unless ( defined($multiple) ) { @@ -481,7 +481,7 @@ sub _updateConfigLine { # Build a pattern to look for. if ( $multiple ) { - $self->debug(2,"$function_name: 'multiple' flag enabled"); + *$self->{LOG}->debug(2,"$function_name: 'multiple' flag enabled"); $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt,$config_value); } else { $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt); @@ -496,7 +496,7 @@ sub _updateConfigLine { if ( ($line_fmt == LINE_FORMAT_PARAM) || ($line_fmt == LINE_FORMAT_ENVVAR) ) { $comment = $LINE_QUATTOR_COMMENT; } - $self->debug(1,"$function_name: checking expected configuration line ($new_line) with pattern >>>".$config_param_pattern."<<<"); + *$self->{LOG}->debug(1,"$function_name: checking expected configuration line ($new_line) with pattern >>>".$config_param_pattern."<<<"); $self->add_or_replace_lines(qr/^\s*$config_param_pattern/, qr/^\s*$new_line$/, $new_line.$comment."\n", @@ -537,23 +537,23 @@ sub _parse_rule { my %rule_info; unless ( $rule ) { - $self->error("$function_name: 'rule' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'rule' argument missing (internal error)"); $rule_info{error_msg} = "rule parser internal error (missing argument)"; return \%rule_info; } unless ( $config_options ) { - $self->error("$function_name: 'config_options' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); $rule_info{error_msg} = "rule parser internal error (missing argument)"; return \%rule_info; } unless ( defined($parser_options) ) { - $self->debug(2,"$function_name: 'parser_options' undefined"); + *$self->{LOG}->debug(2,"$function_name: 'parser_options' undefined"); $parser_options = {}; } if ( defined($parser_options->{always_rules_only}) ) { - $self->debug(1,"$function_name: 'always_rules_only' option set to ".$parser_options->{always_rules_only}); + *$self->{LOG}->debug(1,"$function_name: 'always_rules_only' option set to ".$parser_options->{always_rules_only}); } else { - $self->debug(1,"$function_name: 'always_rules_only' option not defined: assuming $LINE_OPT_DEF_ALWAYS_RULES_ONLY"); + *$self->{LOG}->debug(1,"$function_name: 'always_rules_only' option not defined: assuming $LINE_OPT_DEF_ALWAYS_RULES_ONLY"); $parser_options->{always_rules_only} = $LINE_OPT_DEF_ALWAYS_RULES_ONLY; } @@ -563,7 +563,7 @@ sub _parse_rule { } else { $condition = ""; } - $self->debug(1,"$function_name: condition=>>>$condition<<<, rule=>>>$rule<<<"); + *$self->{LOG}->debug(1,"$function_name: condition=>>>$condition<<<, rule=>>>$rule<<<"); # Check if only rules with ALWAYS condition must be applied. # ALWAYS is a special condition that is used to flag the only rules that @@ -571,7 +571,7 @@ sub _parse_rule { # is not set, this condition has no effect and is just reset to an empty conditions. if ( $parser_options->{always_rules_only} ) { if ( $condition ne $RULE_CONDITION_ALWAYS ) { - $self->debug(1,"$function_name: rule ignored ($RULE_CONDITION_ALWAYS condition not set)"); + *$self->{LOG}->debug(1,"$function_name: rule ignored ($RULE_CONDITION_ALWAYS condition not set)"); return; } } @@ -581,7 +581,7 @@ sub _parse_rule { # Check if rule condition is met if one is defined if ( $condition ne "" ) { - $self->debug(1,"$function_name: checking condition >>>$condition<<<"); + *$self->{LOG}->debug(1,"$function_name: checking condition >>>$condition<<<"); # Condition may be negated if it starts with a !: remove it from the condition value. # If the condition is negated, when the condition is true the rule must not be applied. @@ -595,7 +595,7 @@ sub _parse_rule { $cond_option_set = $cond_attribute; $cond_attribute = ""; } - $self->debug(2,"$function_name: condition option set = '$cond_option_set', ". + *$self->{LOG}->debug(2,"$function_name: condition option set = '$cond_option_set', ". "condition attribute = '$cond_attribute', negate=$negate"); my $cond_satisfied = 1; # Assume condition is satisfied if ( $cond_attribute ) { @@ -618,7 +618,7 @@ sub _parse_rule { if ( !$cond_satisfied ) { # When the condition is not satisfied and if option remove_if_undef is set, # remove configuration line (if present). - $self->debug(1,"$function_name: condition not satisfied, flag set to remove matching configuration lines"); + *$self->{LOG}->debug(1,"$function_name: condition not satisfied, flag set to remove matching configuration lines"); $rule_info{remove_matching_lines} = 1; return \%rule_info; } @@ -657,21 +657,21 @@ sub _apply_rules { my ($self, $config_rules, $config_options, $parser_options) = @_; unless ( $config_rules ) { - $self->error("$function_name: 'config_rules' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); return 1; } unless ( $config_options ) { - $self->error("$function_name: 'config_options' argument missing (internal error)"); + *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); return 1; } unless ( defined($parser_options) ) { - $self->debug(2,"$function_name: 'parser_options' undefined"); + *$self->{LOG}->debug(2,"$function_name: 'parser_options' undefined"); $parser_options = {}; } if ( defined($parser_options->{remove_if_undef}) ) { - $self->debug(1,"$function_name: 'remove_if_undef' option set to ".$parser_options->{remove_if_undef}); + *$self->{LOG}->debug(1,"$function_name: 'remove_if_undef' option set to ".$parser_options->{remove_if_undef}); } else { - $self->debug(1,"$function_name: 'remove_if_undef' option not defined: assuming $LINE_OPT_DEF_REMOVE_IF_UNDEF"); + *$self->{LOG}->debug(1,"$function_name: 'remove_if_undef' option not defined: assuming $LINE_OPT_DEF_REMOVE_IF_UNDEF"); $parser_options->{remove_if_undef} = $LINE_OPT_DEF_REMOVE_IF_UNDEF; } @@ -711,7 +711,7 @@ sub _apply_rules { } elsif ( $keyword =~ /^\?/ ) { $keyword =~ s/^\?//; $rule_parsing_options->{remove_if_undef} = 1; - $self->debug(2,"$function_name: 'remove_if_undef' option set for the current rule"); + *$self->{LOG}->debug(2,"$function_name: 'remove_if_undef' option set for the current rule"); } # Split different elements of the rule @@ -733,7 +733,7 @@ sub _apply_rules { # If the keyword was "negated", remove (comment out) configuration line if present and enabled if ( $comment_line ) { - $self->debug(1,"$function_name: keyword '$keyword' negated, removing configuration line"); + *$self->{LOG}->debug(1,"$function_name: keyword '$keyword' negated, removing configuration line"); $self->_removeConfigLine($keyword,$line_fmt); next; } @@ -742,22 +742,22 @@ sub _apply_rules { # Parse rule if it is non empty my $rule_info; if ( $rule ne '' ) { - $self->debug(1,"$function_name: processing rule $rule_id (variable=>>>$keyword<<<, rule=>>>$rule<<<, fmt=$line_fmt)"); + *$self->{LOG}->debug(1,"$function_name: processing rule $rule_id (variable=>>>$keyword<<<, rule=>>>$rule<<<, fmt=$line_fmt)"); $rule_info = $self->_parse_rule($rule,$config_options,$rule_parsing_options); next unless $rule_info; - $self->debug(2,"$function_name: information returned by rule parser: ".join(" ",sort(keys(%$rule_info)))); + *$self->{LOG}->debug(2,"$function_name: information returned by rule parser: ".join(" ",sort(keys(%$rule_info)))); if ( exists($rule_info->{error_msg}) ) { - $self->error("Error parsing rule >>>$rule<<<: ".$rule_info->{error_msg}); + *$self->{LOG}->error("Error parsing rule >>>$rule<<<: ".$rule_info->{error_msg}); # FIXME: decide whether an invalid rule is just ignored or causes any modification to be prevented. # $self->cancel() next; } elsif ( $rule_info->{remove_matching_lines} ) { if ( $rule_parsing_options->{remove_if_undef} ) { - $self->debug(1,"$function_name: removing configuration lines for keyword '$keyword'"); + *$self->{LOG}->debug(1,"$function_name: removing configuration lines for keyword '$keyword'"); $self->_removeConfigLine($keyword,$line_fmt); } else { - $self->debug(1,"$function_name: remove_if_undef not set, ignoring line to remove"); + *$self->{LOG}->debug(1,"$function_name: remove_if_undef not set, ignoring line to remove"); } next; } @@ -773,12 +773,12 @@ sub _apply_rules { if ( $rule_info->{attribute} ) { foreach my $option_set (@{$rule_info->{option_sets}}) { my $attr_value; - $self->debug(1,"$function_name: retrieving '".$rule_info->{attribute}."' value in option set $option_set"); + *$self->{LOG}->debug(1,"$function_name: retrieving '".$rule_info->{attribute}."' value in option set $option_set"); if ( $option_set eq $RULE_OPTION_SET_GLOBAL ) { if ( exists($config_options->{$rule_info->{attribute}}) ) { $attr_value = $config_options->{$rule_info->{attribute}}; } else { - $self->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in global option set"); + *$self->{LOG}->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in global option set"); $attribute_present = 0; } } else { @@ -786,7 +786,7 @@ sub _apply_rules { if ( $config_options->{$option_set} && exists($config_options->{$option_set}->{$rule_info->{attribute}}) ) { $attr_value = $config_options->{$option_set}->{$rule_info->{attribute}}; } else { - $self->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in option set '$option_set'"); + *$self->{LOG}->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in option set '$option_set'"); $attribute_present = 0; } } @@ -799,7 +799,7 @@ sub _apply_rules { # LINE_VALUE_STRING_HASH. unless ( $attribute_present ) { if ( $rule_parsing_options->{remove_if_undef} ) { - $self->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' undefined, removing configuration line"); + *$self->{LOG}->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' undefined, removing configuration line"); $self->_removeConfigLine($keyword,$line_fmt); } next; @@ -812,7 +812,7 @@ sub _apply_rules { if ( $value_fmt == LINE_VALUE_INSTANCE_PARAMS ) { foreach my $instance (sort keys %{$attr_value}) { my $params = $attr_value->{$instance}; - $self->debug(1,"$function_name: formatting instance '$instance' parameters ($params)"); + *$self->{LOG}->debug(1,"$function_name: formatting instance '$instance' parameters ($params)"); $config_value = $self->_formatAttributeValue($params, $line_fmt, $value_fmt, @@ -821,7 +821,7 @@ sub _apply_rules { my $config_param = $keyword; my $instance_uc = uc($instance); $config_param =~ s/%%INSTANCE%%/$instance_uc/; - $self->debug(2,"New variable name generated: >>>$config_param<<<"); + *$self->{LOG}->debug(2,"New variable name generated: >>>$config_param<<<"); $self->_updateConfigLine($config_param,$config_value,$line_fmt); } $config_updated = 1; @@ -834,7 +834,7 @@ sub _apply_rules { # Keys may be escaped if they contain characters like '/': unescaping a non-escaped # string is generally harmless. my $tmp = unescape($k)." $v"; - $self->debug(1,"$function_name: formatting (string hash) attribute '".$rule_info->{attribute}."' value ($tmp, value_fmt=$value_fmt)"); + *$self->{LOG}->debug(1,"$function_name: formatting (string hash) attribute '".$rule_info->{attribute}."' value ($tmp, value_fmt=$value_fmt)"); $config_value = $self->_formatAttributeValue($tmp, $line_fmt, $value_fmt, @@ -849,20 +849,20 @@ sub _apply_rules { # options specified (if any). @array_values = (@array_values, @$attr_value) } else { - $self->debug(1,"$function_name: formatting attribute '".$rule_info->{attribute}."' value ($attr_value, value_fmt=$value_fmt)"); + *$self->{LOG}->debug(1,"$function_name: formatting attribute '".$rule_info->{attribute}."' value ($attr_value, value_fmt=$value_fmt)"); $config_value .= ' ' if $config_value; $config_value .= $self->_formatAttributeValue($attr_value, $line_fmt, $value_fmt, $value_opt, ); - $self->debug(2,"$function_name: adding attribute '".$rule_info->{attribute}."' from option set '".$option_set. + *$self->{LOG}->debug(2,"$function_name: adding attribute '".$rule_info->{attribute}."' from option set '".$option_set. "' to value (config_value=".$config_value.")"); } } } else { # $rule_info->{attribute} empty means an empty rule : in this case,just write the configuration param. - $self->debug(1,"$function_name: no attribute specified in rule '$rule'"); + *$self->{LOG}->debug(1,"$function_name: no attribute specified in rule '$rule'"); } # There is a delayed formatting of arrays after collecting all the values from all @@ -873,7 +873,7 @@ sub _apply_rules { # With this value format, several lines with the same keyword are generated, # one for each array value (if value_opt is not LINE_VALUE_OPT_SINGLE, all # the values are concatenated on one line). - $self->debug(1,"$function_name: formatting (array) attribute '".$rule_info->{attribute}."as LINE_VALUE_OPT_SINGLE"); + *$self->{LOG}->debug(1,"$function_name: formatting (array) attribute '".$rule_info->{attribute}."as LINE_VALUE_OPT_SINGLE"); foreach my $val (@array_values) { $config_value = $self->_formatAttributeValue($val, $line_fmt, From f5a2f06dd3762b07727f91aea614b87818823996 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 18:23:52 +0200 Subject: [PATCH 03/22] import rule-based editor unittests from ncm-dpmlfc (value_format) --- src/test/perl/rbe_value_format.t | 186 +++++++++++++++++++++++++++++++ 1 file changed, 186 insertions(+) create mode 100644 src/test/perl/rbe_value_format.t diff --git a/src/test/perl/rbe_value_format.t b/src/test/perl/rbe_value_format.t new file mode 100644 index 00000000..474f2e16 --- /dev/null +++ b/src/test/perl/rbe_value_format.t @@ -0,0 +1,186 @@ +# -*- mode: cperl -*- +# ${license-info} +# ${author-info} +# ${build-info} + +use strict; +use warnings; +use FindBin qw($Bin); +use lib "$Bin/modules"; +use testapp; +use CAF::FileEditor; +use CAF::RuleBasedEditor qw(:rule_constants); +use Readonly; +use CAF::Object; +use Test::More tests => 20; +use Test::NoWarnings; +use Test::Quattor; +use Carp qw(confess); + +Test::NoWarnings::clear_warnings(); + + +=pod + +=head1 SYNOPSIS + +Basic test for rule-based editor (value formatting) + +=cut + +Readonly my $FILENAME => '/my/file'; + +our %opts = (); +our $path; +my ($log, $str); +my $this_app = testapp->new ($0, qw (--verbose)); + +$SIG{__DIE__} = \&confess; + +*testapp::error = sub { + my $self = shift; + $self->{ERROR} = @_; +}; + + +open ($log, ">", \$str); +$this_app->set_report_logfile ($log); + +my $formatted_value; +my $rbe_fh = CAF::FileEditor->open($FILENAME, log => $this_app); +ok(defined($rbe_fh), $FILENAME." was opened"); + +# LINE_VALUE_BOOLEAN +Readonly my $FALSE => 'no'; +Readonly my $TRUE => 'yes'; +Readonly my $TRUE_QUOTED => '"yes"'; +$formatted_value = $rbe_fh->_formatAttributeValue(0, + LINE_FORMAT_XRDCFG, + LINE_VALUE_BOOLEAN, + 0, + ); +is($formatted_value, $FALSE, "Boolean (false) correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue(1, + LINE_FORMAT_XRDCFG, + LINE_VALUE_BOOLEAN, + 0, + ); +is($formatted_value, $TRUE, "Boolean (true) correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue(1, + LINE_FORMAT_PARAM, + LINE_VALUE_BOOLEAN, + 0, + ); +is($formatted_value, $TRUE_QUOTED, "Boolean (true, quoted) correctly formatted"); + + +# LINE_VALUE_AS_IS +Readonly my $AS_IS_VALUE => 'This is a Test'; +Readonly my $AS_IS_VALUE_DOUBLE_QUOTED => '"This is a Test"'; +Readonly my $AS_IS_VALUE_SINGLE_QUOTED => "'This is a Test'"; +Readonly my $EMPTY_VALUE => ''; +Readonly my $EMPTY_VALUE_QUOTED => '""'; +$formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE, + LINE_FORMAT_XRDCFG, + LINE_VALUE_AS_IS, + 0, + ); +is($formatted_value, $AS_IS_VALUE, "Literal value correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE, + LINE_FORMAT_ENVVAR, + LINE_VALUE_AS_IS, + 0, + ); +is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Literal value (quoted) correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_DOUBLE_QUOTED, + LINE_FORMAT_XRDCFG, + LINE_VALUE_AS_IS, + 0, + ); +is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Quoted literal value correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_DOUBLE_QUOTED, + LINE_FORMAT_ENVVAR, + LINE_VALUE_AS_IS, + 0, + ); +is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Already quoted literal value correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_SINGLE_QUOTED, + LINE_FORMAT_ENVVAR, + LINE_VALUE_AS_IS, + 0, + ); +is($formatted_value, $AS_IS_VALUE_SINGLE_QUOTED, "Already single quoted literal value correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue($EMPTY_VALUE, + LINE_FORMAT_XRDCFG, + LINE_VALUE_AS_IS, + 0, + ); +is($formatted_value, $EMPTY_VALUE, "Empty value correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue($EMPTY_VALUE, + LINE_FORMAT_PARAM, + LINE_VALUE_AS_IS, + 0, + ); +is($formatted_value, $EMPTY_VALUE_QUOTED, "Empty value (quoted) correctly formatted"); + + +# LINE_VALUE_INSTANCE_PARAMS +# configFile intentionally misspelled confFile for testing +Readonly my %INSTANCE_PARAMS => (logFile => '/test/instance.log', + confFile => '/test/instance.conf', + logKeep => 60, + unused => 'dummy', + ); +Readonly my $FORMATTED_INSTANCE_PARAMS => ' -l /test/instance.log -k 60'; +Readonly my $FORMATTED_INSTANCE_PARAMS_QUOTED => '" -l /test/instance.log -k 60"'; +$formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, + LINE_FORMAT_XRDCFG, + LINE_VALUE_INSTANCE_PARAMS, + 0, + ); +is($formatted_value, $FORMATTED_INSTANCE_PARAMS, "Instance params correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, + LINE_FORMAT_PARAM, + LINE_VALUE_INSTANCE_PARAMS, + 0, + ); +is($formatted_value, $FORMATTED_INSTANCE_PARAMS_QUOTED, "Instance params (quoted) correctly formatted"); + + +# LINE_VALUE_ARRAY +Readonly my @TEST_ARRAY => ('confFile', 'logFile', 'unused', 'logKeep', 'logFile'); +Readonly my $FORMATTED_ARRAY => 'confFile logFile unused logKeep logFile'; +Readonly my $FORMATTED_ARRAY_SORTED => 'confFile logFile logFile logKeep unused'; +Readonly my $FORMATTED_ARRAY_UNIQUE => 'confFile logFile logKeep unused'; +my $rbe_fh = CAF::FileEditor->open($FILENAME, log => $this_app); +ok(defined($rbe_fh), $FILENAME." was opened"); +$formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, + LINE_FORMAT_XRDCFG, + LINE_VALUE_ARRAY, + 0, + ); +is($formatted_value, $FORMATTED_ARRAY, "Array values correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, + LINE_FORMAT_XRDCFG, + LINE_VALUE_ARRAY, + LINE_VALUE_OPT_SORTED, + ); +is($formatted_value, $FORMATTED_ARRAY_SORTED, "Array values (sorted) correctly formatted"); +$formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, + LINE_FORMAT_XRDCFG, + LINE_VALUE_ARRAY, + LINE_VALUE_OPT_UNIQUE, + ); +is($formatted_value, $FORMATTED_ARRAY_UNIQUE, "Array values (unique) correctly formatted"); + + +# LINE_VALUE_HASH_KEYS +$formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, + LINE_FORMAT_XRDCFG, + LINE_VALUE_HASH_KEYS, + 0, + ); +is($formatted_value, $FORMATTED_ARRAY_UNIQUE, "Hash keys correctly formatted"); + + +Test::NoWarnings::had_no_warnings(); From 70e02a817108ee75c2750a96b731de708ff9ff3d Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 19:56:54 +0200 Subject: [PATCH 04/22] RuleBasedEditor: import unit test remove_variable from ncm-dpmlfc - Fix typo in _apply_rules() calling sequence --- src/main/perl/RuleBasedEditor.pm | 3 +- src/test/perl/rbe_remove_variable.t | 238 ++++++++++++++++++++++++++++ 2 files changed, 239 insertions(+), 2 deletions(-) create mode 100644 src/test/perl/rbe_remove_variable.t diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index 015cbfff..baa9bc06 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -154,8 +154,7 @@ sub updateFile { BEGINNING_OF_FILE, ); - $self->_apply_rules($self, - $config_rules, + $self->_apply_rules($config_rules, $config_options, $parser_options); diff --git a/src/test/perl/rbe_remove_variable.t b/src/test/perl/rbe_remove_variable.t new file mode 100644 index 00000000..632a4acc --- /dev/null +++ b/src/test/perl/rbe_remove_variable.t @@ -0,0 +1,238 @@ +# -*- mode: cperl -*- +# ${license-info} +# ${author-info} +# ${build-info} + +use strict; +use warnings; +use FindBin qw($Bin); +use lib "$Bin/modules"; +use testapp; +use CAF::FileEditor; +use CAF::RuleBasedEditor qw(:rule_constants); +use Readonly; +use CAF::Object; +use Test::More tests => 12; +use Test::NoWarnings; +use Test::Quattor; +use Carp qw(confess); + +Test::NoWarnings::clear_warnings(); + + +=pod + +=head1 SYNOPSIS + +Basic tests for rule-based editor (variable deletion) + +=cut + +Readonly my $DPM_CONF_FILE => "/etc/sysconfig/dpm"; + +Readonly my $DPM_INITIAL_CONF_1 => '# should the dpm daemon run? +# any string but "yes" will equivalent to "NO" +# +RUN_DPMDAEMON="yes" +# +# should we run with another limit on the number of file descriptors than the default? +# any string will be passed to ulimit -n +#ULIMIT_N=4096 +# +############################################################################################### +# Change and uncomment the variables below if your setup is different than the one by default # +############################################################################################### + +ALLOW_COREDUMP="yes" + +################# +# DPM variables # +################# + +# - DPM Name Server host : please change !!!!!! +#DPNS_HOST=grid05.lal.in2p3.fr + +# - make sure we use globus pthread model +export GLOBUS_THREAD_MODEL=pthread +'; + +Readonly my $DPM_INITIAL_CONF_2 => $DPM_INITIAL_CONF_1 . ' +# Duplicated line +ALLOW_COREDUMP="yes" +'; + +Readonly my $DPM_EXPECTED_CONF_1 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +# should the dpm daemon run? +# any string but "yes" will equivalent to "NO" +# +RUN_DPMDAEMON="yes" +# +# should we run with another limit on the number of file descriptors than the default? +# any string will be passed to ulimit -n +#ULIMIT_N=4096 +# +############################################################################################### +# Change and uncomment the variables below if your setup is different than the one by default # +############################################################################################### + +#ALLOW_COREDUMP="yes" + +################# +# DPM variables # +################# + +# - DPM Name Server host : please change !!!!!! +#DPNS_HOST=grid05.lal.in2p3.fr + +# - make sure we use globus pthread model +#export GLOBUS_THREAD_MODEL=pthread +'; + +Readonly my $DPM_EXPECTED_CONF_2 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +# should the dpm daemon run? +# any string but "yes" will equivalent to "NO" +# +RUN_DPMDAEMON="yes" +# +# should we run with another limit on the number of file descriptors than the default? +# any string will be passed to ulimit -n +#ULIMIT_N=4096 +# +############################################################################################### +# Change and uncomment the variables below if your setup is different than the one by default # +############################################################################################### + +#ALLOW_COREDUMP="yes" + +################# +# DPM variables # +################# + +# - DPM Name Server host : please change !!!!!! +#DPNS_HOST=grid05.lal.in2p3.fr + +# - make sure we use globus pthread model +export GLOBUS_THREAD_MODEL=pthread +'; + +Readonly my $DPM_EXPECTED_CONF_3 => $DPM_EXPECTED_CONF_1 . ' +# Duplicated line +#ALLOW_COREDUMP="yes" +'; + + +my %config_rules_1 = ( + "-ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, + "-GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + ); + +my %config_rules_2 = ( + "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + ); + +my %config_rules_3 = ( + "ALLOW_COREDUMP" => "!srmv22->allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "dpns->globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + ); + +my %config_rules_4 = ( + "?ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + ); + +my %parser_options = ("remove_if_undef" => 1); + + +############# +# Main code # +############# + +$CAF::Object::NoAction = 1; +set_caf_file_close_diff(1); + +our %opts = (); +our $path; +my ($log, $str); +my $this_app = testapp->new ($0, qw (--verbose)); + +$SIG{__DIE__} = \&confess; + +*testapp::error = sub { + my $self = shift; + $self->{ERROR} = @_; +}; + + +open ($log, ">", \$str); +$this_app->set_report_logfile ($log); + +my $changes; +my $fh; + + +# Test negated keywords +my $dpm_options = {}; +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%config_rules_1, + $dpm_options, + \%parser_options); +is("$fh", $DPM_EXPECTED_CONF_1, $DPM_CONF_FILE." has expected contents (negated keywords)"); +$fh->close(); + +# Test removal of a config line is config option is not defined +$dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%config_rules_2, + $dpm_options, + \%parser_options); +is("$fh", $DPM_EXPECTED_CONF_2, $DPM_CONF_FILE." has expected contents (config option not defined)"); +$fh->close(); + +# Test removal of a config line is rule condition is not met +$dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%config_rules_3, + $dpm_options, + \%parser_options); +is("$fh", $DPM_EXPECTED_CONF_1, $DPM_CONF_FILE." has expected contents (rule condition not met)"); +$fh->close(); + +# Test removal of a config line is config option is not defined +# when keyword is prefixed by ? +$dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%config_rules_4, + $dpm_options); +is("$fh", $DPM_EXPECTED_CONF_2, $DPM_CONF_FILE." has expected contents (rule keyword prefixed by ?)"); +$fh->close(); + + +# Test removal of config lines appearing multiple times +$dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%config_rules_1, + $dpm_options, + \%parser_options); +is("$fh", $DPM_EXPECTED_CONF_3, $DPM_CONF_FILE." has expected contents (repeated config line)"); +$fh->close(); + + +Test::NoWarnings::had_no_warnings(); From dea2dc5ade7440b3041c3ee249b76626a1751976 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 20:08:29 +0200 Subject: [PATCH 05/22] RuleBasedEditor: import unit test build_line_pattern.t from ncm-dpmlfc --- src/test/perl/rbe_build_line_pattern.t | 94 ++++++++++++++++++++++++++ 1 file changed, 94 insertions(+) create mode 100644 src/test/perl/rbe_build_line_pattern.t diff --git a/src/test/perl/rbe_build_line_pattern.t b/src/test/perl/rbe_build_line_pattern.t new file mode 100644 index 00000000..8981439e --- /dev/null +++ b/src/test/perl/rbe_build_line_pattern.t @@ -0,0 +1,94 @@ +# -*- mode: cperl -*- +# ${license-info} +# ${author-info} +# ${build-info} + +use strict; +use warnings; +use FindBin qw($Bin); +use lib "$Bin/modules"; +use testapp; +use CAF::FileEditor; +use CAF::RuleBasedEditor qw(:rule_constants); +use Readonly; +use CAF::Object; +use Test::More tests => 8; +use Test::NoWarnings; +use Test::Quattor; +use Carp qw(confess); + +Test::NoWarnings::clear_warnings(); + + +=pod + +=head1 SYNOPSIS + +Basic test for rule-based editor (line pattern build) + +=cut + +Readonly my $FILENAME => '/my/file'; + +our %opts = (); +our $path; +my ($log, $str); +my $this_app = testapp->new ($0, qw (--verbose)); + +$SIG{__DIE__} = \&confess; + +*testapp::error = sub { + my $self = shift; + $self->{ERROR} = @_; +}; + + +open ($log, ">", \$str); +$this_app->set_report_logfile ($log); + +my $fh = CAF::FileEditor->open($FILENAME, log => $this_app); +ok(defined($fh), $FILENAME." was opened"); + + +# Build a line pattern without a parameter value +Readonly my $KEYWORD => 'DPNS_HOST'; +Readonly my $LINE_PATTERN_ENV_VAR => '#?\s*export DPNS_HOST='; +Readonly my $LINE_PATTERN_KEY_VALUE => '#?\s*DPNS_HOST'; +my $escaped_pattern = $fh->_buildLinePattern($KEYWORD, + LINE_FORMAT_ENVVAR); +is($escaped_pattern, $LINE_PATTERN_ENV_VAR, "Environment variable pattern ok"); +$escaped_pattern = $fh->_buildLinePattern($KEYWORD, + LINE_FORMAT_XRDCFG); +is($escaped_pattern, $LINE_PATTERN_KEY_VALUE, "Key/value pattern ok"); + +# Build a line pattern without a parameter value +Readonly my $VALUE_1 => 'dpns.example.com'; +Readonly my $EXPECTED_PATTERN_1 => '#?\s*export DPNS_HOST=dpns\.example\.com'; +Readonly my $VALUE_2 => 0; +Readonly my $EXPECTED_PATTERN_2 => '#?\s*export DPNS_HOST=0'; +Readonly my $VALUE_3 => '^dp$n-s.*ex] a+m(ple[.c)o+m?'; +Readonly my $EXPECTED_PATTERN_3 => '#?\s*export DPNS_HOST=\^dp\$n\-s\.\*ex\]\s+a\+m\(ple\[\.c\)o\+m\?'; +# Test \ escaping separately as it also needs the expected value also needs to be escaped for the test +# to be successful! +Readonly my $VALUE_4 => 'a\b'; +Readonly my $EXPECTED_PATTERN_4 => '#?\s*export DPNS_HOST=a\\\\b'; +$escaped_pattern = $fh->_buildLinePattern($KEYWORD, + LINE_FORMAT_ENVVAR, + $VALUE_1); +is($escaped_pattern, $EXPECTED_PATTERN_1, "Environment variable with value (host name): pattern ok"); +$escaped_pattern = $fh->_buildLinePattern($KEYWORD, + LINE_FORMAT_ENVVAR, + $VALUE_2); +is($escaped_pattern, $EXPECTED_PATTERN_2, "Environment variable with value (0): pattern ok"); +$escaped_pattern = $fh->_buildLinePattern($KEYWORD, + LINE_FORMAT_ENVVAR, + $VALUE_3); +is($escaped_pattern, $EXPECTED_PATTERN_3, "Environment variable with value (special characters): pattern ok"); +$escaped_pattern = $fh->_buildLinePattern($KEYWORD, + LINE_FORMAT_ENVVAR, + $VALUE_4); +is($escaped_pattern, $EXPECTED_PATTERN_4, "Environment variable with value (backslash): pattern ok"); + + +# Test::NoWarnings::had_no_warnings(); + From 8f7e5b3ed44609d6e6524cc5f53d567609ef4583 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 20:42:35 +0200 Subject: [PATCH 06/22] RuleBasedEditor: import unit test rule_parser.t from ncm-dpmlfc --- src/test/perl/rbe_rule_parser.t | 510 ++++++++++++++++++++++++++++++++ 1 file changed, 510 insertions(+) create mode 100644 src/test/perl/rbe_rule_parser.t diff --git a/src/test/perl/rbe_rule_parser.t b/src/test/perl/rbe_rule_parser.t new file mode 100644 index 00000000..d41c3ea7 --- /dev/null +++ b/src/test/perl/rbe_rule_parser.t @@ -0,0 +1,510 @@ +# -*- mode: cperl -*- +# ${license-info} +# ${author-info} +# ${build-info} + +use strict; +use warnings; +use FindBin qw($Bin); +use lib "$Bin/modules"; +use testapp; +use CAF::FileEditor; +use CAF::RuleBasedEditor qw(:rule_constants); +use Readonly; +use CAF::Object; +use Test::More tests => 30; +use Test::NoWarnings; +use Test::Quattor; +use Carp qw(confess); + +Test::NoWarnings::clear_warnings(); + + +=pod + +=head1 SYNOPSIS + +Basic tests for rule-based editor (variable substitution) + +=cut + +Readonly my $DPM_CONF_FILE => "/etc/sysconfig/dpm"; +Readonly my $DMLITE_CONF_FILE => "/etc/httpd/conf.d/zlcgdm-dav.conf"; +Readonly my $DPM_SHIFT_CONF_FILE => "/etc/shift.conf"; + +Readonly my $DPM_INITIAL_CONF_1 => '# should the dpm daemon run? +# any string but "yes" will equivalent to "NO" +# +RUN_DPMDAEMON="no" +# +# should we run with another limit on the number of file descriptors than the default? +# any string will be passed to ulimit -n +#ULIMIT_N=4096 +# +############################################################################################### +# Change and uncomment the variables below if your setup is different than the one by default # +############################################################################################### + +#ALLOW_COREDUMP="no" + +################# +# DPM variables # +################# + +# - DPM Name Server host : please change !!!!!! +#DPNS_HOST=grid05.lal.in2p3.fr + +# - make sure we use globus pthread model +#export GLOBUS_THREAD_MODEL=pthread +'; + +Readonly my $DPM_INITIAL_CONF_2 => $DPM_INITIAL_CONF_1 . ' +# Duplicated line +ALLOW_COREDUMP="no" +# +# Very similar line +ALLOW_COREDUMP2="no" +'; + +Readonly my $DPM_INITIAL_CONF_3 => $DPM_INITIAL_CONF_1 . ' +#DISKFLAGS="a list of flag" +'; + +Readonly my $DMLITE_INITIAL_CONF_1 => '# +# This is the Apache configuration for the dmlite DAV. +# +# The first part of the file configures all the required options common to all +# VirtualHosts. The actual VirtualHost instances are defined at the end of this file. +# + +# Static content +Alias /static/ /usr/share/lcgdm-dav/ + + + ExpiresActive On + ExpiresDefault "access plus 1 month" + + + +# Alias for the delegation +ScriptAlias /gridsite-delegation "/usr/libexec/gridsite/cgi-bin/gridsite-delegation.cgi" + +# Base path for nameserver requests + + + # None, one or several flags + # Write Enable write access + # NoAuthn Disables user authentication + # RemoteCopy Enables third party copies + NSFlags Write + + # On redirect, maximum number of replicas in the URL + # (Used only by LFC) + NSMaxReplicas 3 + + # Redirection ports + # Two parameters: unsecure (plain HTTP) and secure (HTTPS) + # NSRedirectPort 80 443 + + # List of trusted DN (as X509 Subject). + # This DN can act on behalf of other users using the HTTP headers: + # X-Auth-Dn + # X-Auth-FqanN (Can be specified multiple times, with N starting on 0, and incrementing) + # NSTrustedDNS "/DC=ch/DC=cern/OU=computers/CN=trusted-host.cern.ch" + + # If mod_gridsite does not give us information about the certificate, this + # enables mod_ssl to pass environment variables that can be used by mod_lcgdm_ns + # to get the user DN. + SSLOptions +StdEnvVars + + +'; + + +Readonly my $DPM_EXPECTED_CONF_1 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +# should the dpm daemon run? +# any string but "yes" will equivalent to "NO" +# +RUN_DPMDAEMON="no" +# +# should we run with another limit on the number of file descriptors than the default? +# any string will be passed to ulimit -n +#ULIMIT_N=4096 +# +############################################################################################### +# Change and uncomment the variables below if your setup is different than the one by default # +############################################################################################### + +ALLOW_COREDUMP="yes" # Line generated by Quattor + +################# +# DPM variables # +################# + +# - DPM Name Server host : please change !!!!!! +#DPNS_HOST=grid05.lal.in2p3.fr + +# - make sure we use globus pthread model +export GLOBUS_THREAD_MODEL=pthread # Line generated by Quattor +'; + +Readonly my $DPM_EXPECTED_CONF_2 => $DPM_EXPECTED_CONF_1 . ' +# Duplicated line +ALLOW_COREDUMP="yes" # Line generated by Quattor +# +# Very similar line +ALLOW_COREDUMP2="no" +'; + +Readonly my $DPM_EXPECTED_CONF_3 => $DPM_EXPECTED_CONF_1 . ' +DISKFLAGS="Write RemoteCopy" # Line generated by Quattor +'; + +Readonly my $DMLITE_EXPECTED_CONF_1 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +# +# This is the Apache configuration for the dmlite DAV. +# +# The first part of the file configures all the required options common to all +# VirtualHosts. The actual VirtualHost instances are defined at the end of this file. +# + +# Static content +Alias /static/ /usr/share/lcgdm-dav/ + + + ExpiresActive On + ExpiresDefault "access plus 1 month" + + + +# Alias for the delegation +ScriptAlias /gridsite-delegation "/usr/libexec/gridsite/cgi-bin/gridsite-delegation.cgi" + +# Base path for nameserver requests + + + # None, one or several flags + # Write Enable write access + # NoAuthn Disables user authentication + # RemoteCopy Enables third party copies +NSFlags Write RemoteCopy + + # On redirect, maximum number of replicas in the URL + # (Used only by LFC) + NSMaxReplicas 3 + + # Redirection ports + # Two parameters: unsecure (plain HTTP) and secure (HTTPS) + # NSRedirectPort 80 443 + + # List of trusted DN (as X509 Subject). + # This DN can act on behalf of other users using the HTTP headers: + # X-Auth-Dn + # X-Auth-FqanN (Can be specified multiple times, with N starting on 0, and incrementing) + # NSTrustedDNS "/DC=ch/DC=cern/OU=computers/CN=trusted-host.cern.ch" + + # If mod_gridsite does not give us information about the certificate, this + # enables mod_ssl to pass environment variables that can be used by mod_lcgdm_ns + # to get the user DN. + SSLOptions +StdEnvVars + + +'; + +Readonly my $COND_TEST_INITIAL => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +NSFlags Write RemoteCopy +DiskFlags NoAuthn +'; + +Readonly my $COND_TEST_EXPECTED_1 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +NSFlags Write RemoteCopy +'; + +Readonly my $COND_TEST_EXPECTED_2 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +NSFlags Write RemoteCopy +#DiskFlags NoAuthn +'; + +Readonly my $COND_TEST_EXPECTED_3 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +DiskFlags NoAuthn +NSFlags Write RemoteCopy +'; + +Readonly my $NEG_COND_TEST_EXPECTED_1 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +DiskFlags NoAuthn +'; + +Readonly my $NEG_COND_TEST_EXPECTED_2 => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +#NSFlags Write RemoteCopy +DiskFlags NoAuthn +'; + + +Readonly my $NO_RULE_EXPECTED => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +RFIO DAEMONV3_WRMT 1 +'; + +Readonly my $MULTI_COND_SETS_EXPECTED => '# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor +# +DPNS FTRUST node1.example.com +DPNS FTRUST node2.example.com +DPNS FTRUST node4.example.com +DPNS FTRUST node3.example.com +DPNS RTRUST node1.example.com node1.example.com node2.example.com node3.example.com node4.example.com +DPNS TRUST node1.example.com node2.example.com node4.example.com node3.example.com node1.example.com +DPNS WTRUST node1.example.com node2.example.com node3.example.com node4.example.com +'; + + +# Test rules + +my %dpm_config_rules_1 = ( + "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + ); + +my %dpm_config_rules_2 = ( + "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + "DISKFLAGS" =>"DiskFlags:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_ARRAY, + ); + +my %dav_config_rules = ( + "NSFlags" =>"NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, +); + +my %rules_with_conditions = ( + "NSFlags" =>"DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "DiskFlags" =>"DiskFlags:dpns->DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, +); + +my %rules_with_conditions_2 = ( + "NSFlags" =>"DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "DiskFlags" =>"DiskFlags:dpn->DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, +); + +my %rules_with_neg_conds = ( + "NSFlags" =>"!DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "DiskFlags" =>"!DiskFlags:dpns->DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, +); + +my %rules_no_rule = ( + "RFIO DAEMONV3_WRMT 1" => ";".LINE_FORMAT_XRDCFG, +); + +my %rules_multi_cond_sets = ( + "DPNS TRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "DPNS WTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_UNIQUE, + "DPNS RTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_SORTED, + "DPNS FTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_SINGLE, +); + +my %rules_always = ( + "NSFlags" => "ALWAYS->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "DiskFlags" => "DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, +); + +# Option sets + +my $dpm_options = {dpm => {allowCoreDump => 1, + globusThreadModel => "pthread", + fastThreads => 200, + DiskFlags => [ "Write", "RemoteCopy" ], + }, + dpns => {hostlist => ['node1.example.com', 'node2.example.com']}, + srmv1 => {hostlist => ['node4.example.com', 'node3.example.com', 'node1.example.com']}}; + +my $dmlite_options = {dav => {NSFlags => [ "Write", "RemoteCopy" ], + DiskFlags => [ "NoAuthn" ], + }}; + + +my $all_options = {%$dpm_options, %$dmlite_options}; + + +############# +# Main code # +############# + +$CAF::Object::NoAction = 1; +set_caf_file_close_diff(1); + +our %opts = (); +our $path; +my ($log, $str); +my $this_app = testapp->new ($0, qw (--verbose)); + +$SIG{__DIE__} = \&confess; + +*testapp::error = sub { + my $self = shift; + $self->{ERROR} = @_; +}; + + +open ($log, ">", \$str); +$this_app->set_report_logfile ($log); + +my $changes; +my $fh; + +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); + + +# Test simple variable substitution +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%dpm_config_rules_1, + $dpm_options); +is("$fh", $DPM_EXPECTED_CONF_1, $DPM_CONF_FILE." has expected contents (config 1)"); +$fh->close(); + + +# Test potentially ambiguous config (duplicated lines, similar keywords) +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%dpm_config_rules_1, + $dpm_options); +is("$fh", $DPM_EXPECTED_CONF_2, $DPM_CONF_FILE." has expected contents (config 2)"); +$fh->close(); + + +# Test array displayed as list +set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_3); +my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%dpm_config_rules_2, + $dpm_options); +is("$fh", $DPM_EXPECTED_CONF_3, $DPM_CONF_FILE." has expected contents (config 3)"); +$fh->close(); + + +# Test 'keyword value" format (a la Apache) +set_file_contents($DMLITE_CONF_FILE,$DMLITE_INITIAL_CONF_1); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%dav_config_rules, + $dmlite_options); +is("$fh", $DMLITE_EXPECTED_CONF_1, $DMLITE_CONF_FILE." has expected contents"); +$fh->close(); + + +# Test rule conditions + +set_file_contents($DMLITE_CONF_FILE,''); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_with_conditions, + $all_options); +is("$fh", $COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (rules with conditions)"); +$fh->close(); + +set_file_contents($DMLITE_CONF_FILE,''); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_with_neg_conds, + $all_options); +is("$fh", $NEG_COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (rules with negative conditions)"); +$fh->close(); + +set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_with_conditions, + $all_options); +is("$fh", $COND_TEST_INITIAL, $DMLITE_CONF_FILE." has expected contents (initial contents, rules conditions with non existent attribute)"); +$fh->close(); + +set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_with_conditions_2, + $all_options); +is("$fh", $COND_TEST_INITIAL, $DMLITE_CONF_FILE." has expected contents (initial contents, rules conditions with non existent option set)"); +$fh->close(); + +my %parser_options; +$parser_options{remove_if_undef} = 1; +set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_with_conditions, + $all_options, + \%parser_options); +is("$fh", $COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents (initial contents, rules conditions, parser options)"); +$fh->close(); + +set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_with_neg_conds, + $all_options, + \%parser_options); +is("$fh", $NEG_COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents (initial contents, rules with negative conditions, parser options)"); +$fh->close(); + +set_file_contents($DMLITE_CONF_FILE,''); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_always, + $dmlite_options); +is("$fh", $COND_TEST_EXPECTED_3, $DMLITE_CONF_FILE." has expected contents (always_rules_only not set)"); +$fh->close(); + +$parser_options{always_rules_only} = 1; +set_file_contents($DMLITE_CONF_FILE,''); +my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +ok(defined($fh), $DMLITE_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_always, + $dmlite_options, + \%parser_options); +is("$fh", $COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (always_rules_only set)"); +$fh->close(); + + +# Rule with only a keyword +set_file_contents($DPM_SHIFT_CONF_FILE,''); +my $fh = CAF::FileEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_no_rule, + $dpm_options); +is("$fh", $NO_RULE_EXPECTED, $DPM_SHIFT_CONF_FILE." has expected contents (keyword only)"); +$fh->close(); + + +# Rule with multiple condition sets and multiple-word keyword +set_file_contents($DPM_SHIFT_CONF_FILE,''); +my $fh = CAF::FileEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); +ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); +$changes = $fh->updateFile( + \%rules_multi_cond_sets, + $dpm_options); +is("$fh", $MULTI_COND_SETS_EXPECTED, $DPM_SHIFT_CONF_FILE." has expected contents (multiple condition sets)"); +$fh->close(); + + +Test::NoWarnings::had_no_warnings(); From 8870beec651380176570d9cf550c0a9af2bfd692 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 21:48:04 +0200 Subject: [PATCH 07/22] RuleBasedEditor: update constant names to be independent from ncm-dpmlfc/xrootd - Unit tests updated --- src/main/perl/RuleBasedEditor.pm | 91 ++++++++++++++++---------- src/test/perl/rbe_build_line_pattern.t | 12 ++-- src/test/perl/rbe_remove_variable.t | 16 ++--- src/test/perl/rbe_rule_parser.t | 38 +++++------ src/test/perl/rbe_value_format.t | 32 ++++----- 5 files changed, 104 insertions(+), 85 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index baa9bc06..48560503 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -6,15 +6,17 @@ # # This module implements a rule-based editor that is used to modify the content # of an existing file without taking care of the whole file. Each rule -# driving the edition process is applied to one matching line. The input for +# driving the edition process is applied to all matching lines. The input for # updating the file is the Quattor configuration and conditions can be defined # based on the contents of this configuration. # -# IMPORTANT NOTE: this code is used (duplicated) in both ncm-dpmlfc and ncm-xrootd. -# It is planned to move it as a CAF module (see -# https://github.com/quattor/CAF/issues/123). In the meantime be -# sure to keep in sync the code used in both components. The -# main version (with the relevant unit tests) is in ncm-dpmlfc). +# This module extends the base methods of the CAF FileEditor: it contains +# all the methods making the rule-based editor (only one being a public method). +# The methods provided in this module can be used at the same time as the +# base methods of the FileEditor. +# +# The code of the rule-based editor is maintained in a separate module only for +# clarity. It cannot be used directly (there is intentionally not constructor). # ####################################################################### @@ -35,32 +37,49 @@ use Encode qw(encode_utf8); local(*DTA); -# Constant duplicated from FileEditor +# Constant duplicated from FileEditor: +# Importing them from it failed due to a chicken and egg problem... use Fcntl qw(:seek); use constant BEGINNING_OF_FILE => (SEEK_SET, 0); use constant ENDING_OF_FILE => (SEEK_END, 0); -# Constants use to format lines in configuration files -# Exported constants -use enum qw(LINE_FORMAT_PARAM=1 - LINE_FORMAT_ENVVAR - LINE_FORMAT_XRDCFG - LINE_FORMAT_XRDCFG_SETENV - LINE_FORMAT_XRDCFG_SET +######################################################### +# Constants use to format lines in configuration files. # +# These constants are exported. # +######################################################### + +# LINE_FORMAT_xxx: general syntax of the line (key/val format) +# LINE_FORMAT_SH_VAR: key=val (e.g. SH shell family) +# LINE_FORMAT_ENV_VAR: export key=val (e.g. SH shell family) +# LINE_FORMAT_KEY_VAL: key val (e.g. Xrootd, Apache) +# LINE_FORMAT_KEY_VAL_SETENV: setenv key val (used by Xrootd in particular) +# LINE_FORMAT_KEY_VAL_SET: set key val (used by Xrootd in particular) +use enum qw(LINE_FORMAT_SH_VAR=1 + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET ); + +# LINE_VALUE_xxx: how to interpret the configuration value +# LINE_VALUE_INSTANCE_PARAMS is specific to Xrootd. use enum qw(LINE_VALUE_AS_IS LINE_VALUE_BOOLEAN - LINE_VALUE_INSTANCE_PARAMS LINE_VALUE_ARRAY LINE_VALUE_HASH_KEYS LINE_VALUE_STRING_HASH + LINE_VALUE_INSTANCE_PARAMS ); + +# LINE_VALUE_OPT_xxx: options for rendering the value +# (mainly apply to lists and dictionnaries) use enum qw(BITMASK: LINE_VALUE_OPT_SINGLE LINE_VALUE_OPT_UNIQUE LINE_VALUE_OPT_SORTED ); + # Internal constants -Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_PARAM; +Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_SH_VAR; Readonly my $LINE_QUATTOR_COMMENT => "\t\t# Line generated by Quattor"; Readonly my $LINE_OPT_DEF_REMOVE_IF_UNDEF => 0; Readonly my $LINE_OPT_DEF_ALWAYS_RULES_ONLY => 0; @@ -69,11 +88,11 @@ Readonly my $RULE_OPTION_SET_GLOBAL => 'GLOBAL'; # Export constants used to build rules -Readonly my @RULE_CONSTANTS => qw(LINE_FORMAT_PARAM - LINE_FORMAT_ENVVAR - LINE_FORMAT_XRDCFG - LINE_FORMAT_XRDCFG_SETENV - LINE_FORMAT_XRDCFG_SET +Readonly my @RULE_CONSTANTS => qw(LINE_FORMAT_SH_VAR + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET LINE_VALUE_AS_IS LINE_VALUE_BOOLEAN LINE_VALUE_INSTANCE_PARAMS @@ -241,7 +260,7 @@ sub _formatAttributeValue { } # Quote value if necessary - if ( ($line_fmt == LINE_FORMAT_PARAM) || ($line_fmt == LINE_FORMAT_ENVVAR) ) { + if ( ($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR) ) { if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\g1$/)) || ($value_fmt == LINE_VALUE_BOOLEAN) || ($formatted_value eq '') ) { @@ -261,7 +280,7 @@ sub _formatAttributeValue { This function formats a configuration line using keyword and value, according to the line format requested. Values containing spaces are -quoted if the line format is not LINE_FORMAT_XRDCFG. +quoted if the line format is not LINE_FORMAT_KEY_VAL. Arguments : keyword : line keyword @@ -289,15 +308,15 @@ sub _formatConfigLine { my $config_line = ""; - if ( $line_fmt == LINE_FORMAT_PARAM ) { + if ( $line_fmt == LINE_FORMAT_SH_VAR ) { $config_line = "$keyword=$value"; - } elsif ( $line_fmt == LINE_FORMAT_ENVVAR ) { + } elsif ( $line_fmt == LINE_FORMAT_ENV_VAR ) { $config_line = "export $keyword=$value"; - } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SETENV ) { + } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SETENV ) { $config_line = "setenv $keyword = $value"; - } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SET ) { + } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SET ) { $config_line = "set $keyword = $value"; - } elsif ( $line_fmt == LINE_FORMAT_XRDCFG ) { + } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL ) { $config_line = $keyword; $config_line .= " $value" if $value; # In trust (shift.conf) format, there should be only one blank between @@ -320,7 +339,7 @@ sub _formatConfigLine { This function builds a pattern that will match an existing configuration line for the configuration parameter specified. The pattern built takes into account the line format. Every whitespace in the pattern (configuration parameter) are replaced by \s+. -If the line format is LINE_FORMAT_XRDCFG, no whitespace is +If the line format is LINE_FORMAT_KEY_VAL, no whitespace is imposed at the end of the pattern, as these format can be used to write a configuration directive as a keyword with no value. @@ -361,15 +380,15 @@ sub _buildLinePattern { $config_param =~ s/\s+/\\s+/g; my $config_param_pattern; - if ( $line_fmt == LINE_FORMAT_PARAM ) { + if ( $line_fmt == LINE_FORMAT_SH_VAR ) { $config_param_pattern = "#?\\s*$config_param=".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_ENVVAR ) { + } elsif ( $line_fmt == LINE_FORMAT_ENV_VAR ) { $config_param_pattern = "#?\\s*export $config_param=".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SETENV ) { + } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SETENV ) { $config_param_pattern = "#?\\s*setenv\\s+$config_param\\s*=\\s*".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_XRDCFG_SET ) { + } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SET ) { $config_param_pattern = "#?\\s*set\\s+$config_param\\s*=\\s*".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_XRDCFG ) { + } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL ) { $config_param_pattern = "#?\\s*$config_param"; # Avoid adding a whitespace requirement if there is no config_value if ( $config_value ne "" ) { @@ -484,7 +503,7 @@ sub _updateConfigLine { $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt,$config_value); } else { $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt); - if ( ($line_fmt == LINE_FORMAT_XRDCFG) && $config_value ) { + if ( ($line_fmt == LINE_FORMAT_KEY_VAL) && $config_value ) { $config_param_pattern .= "\\s+"; # If the value is defined in these formats, impose a whitespace at the end } } @@ -492,7 +511,7 @@ sub _updateConfigLine { # Update the matching configuration lines if ( $new_line ) { my $comment = ""; - if ( ($line_fmt == LINE_FORMAT_PARAM) || ($line_fmt == LINE_FORMAT_ENVVAR) ) { + if ( ($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR) ) { $comment = $LINE_QUATTOR_COMMENT; } *$self->{LOG}->debug(1,"$function_name: checking expected configuration line ($new_line) with pattern >>>".$config_param_pattern."<<<"); diff --git a/src/test/perl/rbe_build_line_pattern.t b/src/test/perl/rbe_build_line_pattern.t index 8981439e..83b7ac23 100644 --- a/src/test/perl/rbe_build_line_pattern.t +++ b/src/test/perl/rbe_build_line_pattern.t @@ -55,10 +55,10 @@ Readonly my $KEYWORD => 'DPNS_HOST'; Readonly my $LINE_PATTERN_ENV_VAR => '#?\s*export DPNS_HOST='; Readonly my $LINE_PATTERN_KEY_VALUE => '#?\s*DPNS_HOST'; my $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENVVAR); + LINE_FORMAT_ENV_VAR); is($escaped_pattern, $LINE_PATTERN_ENV_VAR, "Environment variable pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_XRDCFG); + LINE_FORMAT_KEY_VAL); is($escaped_pattern, $LINE_PATTERN_KEY_VALUE, "Key/value pattern ok"); # Build a line pattern without a parameter value @@ -73,19 +73,19 @@ Readonly my $EXPECTED_PATTERN_3 => '#?\s*export DPNS_HOST=\^dp\$n\-s\.\*ex\]\s+a Readonly my $VALUE_4 => 'a\b'; Readonly my $EXPECTED_PATTERN_4 => '#?\s*export DPNS_HOST=a\\\\b'; $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENVVAR, + LINE_FORMAT_ENV_VAR, $VALUE_1); is($escaped_pattern, $EXPECTED_PATTERN_1, "Environment variable with value (host name): pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENVVAR, + LINE_FORMAT_ENV_VAR, $VALUE_2); is($escaped_pattern, $EXPECTED_PATTERN_2, "Environment variable with value (0): pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENVVAR, + LINE_FORMAT_ENV_VAR, $VALUE_3); is($escaped_pattern, $EXPECTED_PATTERN_3, "Environment variable with value (special characters): pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENVVAR, + LINE_FORMAT_ENV_VAR, $VALUE_4); is($escaped_pattern, $EXPECTED_PATTERN_4, "Environment variable with value (backslash): pattern ok"); diff --git a/src/test/perl/rbe_remove_variable.t b/src/test/perl/rbe_remove_variable.t index 632a4acc..7d9486e3 100644 --- a/src/test/perl/rbe_remove_variable.t +++ b/src/test/perl/rbe_remove_variable.t @@ -124,23 +124,23 @@ Readonly my $DPM_EXPECTED_CONF_3 => $DPM_EXPECTED_CONF_1 . ' my %config_rules_1 = ( - "-ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, - "-GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + "-ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_BOOLEAN, + "-GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENV_VAR, ); my %config_rules_2 = ( - "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, - "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENV_VAR, ); my %config_rules_3 = ( - "ALLOW_COREDUMP" => "!srmv22->allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, - "GLOBUS_THREAD_MODEL" => "dpns->globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + "ALLOW_COREDUMP" => "!srmv22->allowCoreDump:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "dpns->globusThreadModel:dpm;".LINE_FORMAT_ENV_VAR, ); my %config_rules_4 = ( - "?ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, - "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + "?ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENV_VAR, ); my %parser_options = ("remove_if_undef" => 1); diff --git a/src/test/perl/rbe_rule_parser.t b/src/test/perl/rbe_rule_parser.t index d41c3ea7..bc74c21f 100644 --- a/src/test/perl/rbe_rule_parser.t +++ b/src/test/perl/rbe_rule_parser.t @@ -268,49 +268,49 @@ DPNS WTRUST node1.example.com node2.example.com node3.example.com node4.example. # Test rules my %dpm_config_rules_1 = ( - "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, - "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, + "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENV_VAR, ); my %dpm_config_rules_2 = ( - "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_BOOLEAN, - "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENVVAR, - "DISKFLAGS" =>"DiskFlags:dpm;".LINE_FORMAT_PARAM.";".LINE_VALUE_ARRAY, + "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENV_VAR, + "DISKFLAGS" =>"DiskFlags:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_ARRAY, ); my %dav_config_rules = ( - "NSFlags" =>"NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "NSFlags" =>"NSFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, ); my %rules_with_conditions = ( - "NSFlags" =>"DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, - "DiskFlags" =>"DiskFlags:dpns->DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "NSFlags" =>"DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, + "DiskFlags" =>"DiskFlags:dpns->DiskFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, ); my %rules_with_conditions_2 = ( - "NSFlags" =>"DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, - "DiskFlags" =>"DiskFlags:dpn->DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "NSFlags" =>"DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, + "DiskFlags" =>"DiskFlags:dpn->DiskFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, ); my %rules_with_neg_conds = ( - "NSFlags" =>"!DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, - "DiskFlags" =>"!DiskFlags:dpns->DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "NSFlags" =>"!DiskFlags:dpm->NSFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, + "DiskFlags" =>"!DiskFlags:dpns->DiskFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, ); my %rules_no_rule = ( - "RFIO DAEMONV3_WRMT 1" => ";".LINE_FORMAT_XRDCFG, + "RFIO DAEMONV3_WRMT 1" => ";".LINE_FORMAT_KEY_VAL, ); my %rules_multi_cond_sets = ( - "DPNS TRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, - "DPNS WTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_UNIQUE, - "DPNS RTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_SORTED, - "DPNS FTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_SINGLE, + "DPNS TRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, + "DPNS WTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_UNIQUE, + "DPNS RTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_SORTED, + "DPNS FTRUST" => "dpm->hostlist:dpns,srmv1;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY.":".LINE_VALUE_OPT_SINGLE, ); my %rules_always = ( - "NSFlags" => "ALWAYS->NSFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, - "DiskFlags" => "DiskFlags:dav;".LINE_FORMAT_XRDCFG.";".LINE_VALUE_ARRAY, + "NSFlags" => "ALWAYS->NSFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, + "DiskFlags" => "DiskFlags:dav;".LINE_FORMAT_KEY_VAL.";".LINE_VALUE_ARRAY, ); # Option sets diff --git a/src/test/perl/rbe_value_format.t b/src/test/perl/rbe_value_format.t index 474f2e16..73668cfa 100644 --- a/src/test/perl/rbe_value_format.t +++ b/src/test/perl/rbe_value_format.t @@ -55,19 +55,19 @@ Readonly my $FALSE => 'no'; Readonly my $TRUE => 'yes'; Readonly my $TRUE_QUOTED => '"yes"'; $formatted_value = $rbe_fh->_formatAttributeValue(0, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_BOOLEAN, 0, ); is($formatted_value, $FALSE, "Boolean (false) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(1, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_BOOLEAN, 0, ); is($formatted_value, $TRUE, "Boolean (true) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(1, - LINE_FORMAT_PARAM, + LINE_FORMAT_SH_VAR, LINE_VALUE_BOOLEAN, 0, ); @@ -81,43 +81,43 @@ Readonly my $AS_IS_VALUE_SINGLE_QUOTED => "'This is a Test'"; Readonly my $EMPTY_VALUE => ''; Readonly my $EMPTY_VALUE_QUOTED => '""'; $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_AS_IS, 0, ); is($formatted_value, $AS_IS_VALUE, "Literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE, - LINE_FORMAT_ENVVAR, + LINE_FORMAT_ENV_VAR, LINE_VALUE_AS_IS, 0, ); is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Literal value (quoted) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_DOUBLE_QUOTED, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_AS_IS, 0, ); is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Quoted literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_DOUBLE_QUOTED, - LINE_FORMAT_ENVVAR, + LINE_FORMAT_ENV_VAR, LINE_VALUE_AS_IS, 0, ); is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Already quoted literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_SINGLE_QUOTED, - LINE_FORMAT_ENVVAR, + LINE_FORMAT_ENV_VAR, LINE_VALUE_AS_IS, 0, ); is($formatted_value, $AS_IS_VALUE_SINGLE_QUOTED, "Already single quoted literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($EMPTY_VALUE, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_AS_IS, 0, ); is($formatted_value, $EMPTY_VALUE, "Empty value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($EMPTY_VALUE, - LINE_FORMAT_PARAM, + LINE_FORMAT_SH_VAR, LINE_VALUE_AS_IS, 0, ); @@ -134,13 +134,13 @@ Readonly my %INSTANCE_PARAMS => (logFile => '/test/instance.log', Readonly my $FORMATTED_INSTANCE_PARAMS => ' -l /test/instance.log -k 60'; Readonly my $FORMATTED_INSTANCE_PARAMS_QUOTED => '" -l /test/instance.log -k 60"'; $formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_INSTANCE_PARAMS, 0, ); is($formatted_value, $FORMATTED_INSTANCE_PARAMS, "Instance params correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, - LINE_FORMAT_PARAM, + LINE_FORMAT_SH_VAR, LINE_VALUE_INSTANCE_PARAMS, 0, ); @@ -155,19 +155,19 @@ Readonly my $FORMATTED_ARRAY_UNIQUE => 'confFile logFile logKeep unused'; my $rbe_fh = CAF::FileEditor->open($FILENAME, log => $this_app); ok(defined($rbe_fh), $FILENAME." was opened"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_ARRAY, 0, ); is($formatted_value, $FORMATTED_ARRAY, "Array values correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_ARRAY, LINE_VALUE_OPT_SORTED, ); is($formatted_value, $FORMATTED_ARRAY_SORTED, "Array values (sorted) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_ARRAY, LINE_VALUE_OPT_UNIQUE, ); @@ -176,7 +176,7 @@ is($formatted_value, $FORMATTED_ARRAY_UNIQUE, "Array values (unique) correctly f # LINE_VALUE_HASH_KEYS $formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, - LINE_FORMAT_XRDCFG, + LINE_FORMAT_KEY_VAL, LINE_VALUE_HASH_KEYS, 0, ); From 9aa3d33d26d19105b887bb2eed125f9e896bc17d Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 22:01:48 +0200 Subject: [PATCH 08/22] RuleBasedEditor: misc. refactoring in unit tests --- src/test/perl/rbe_build_line_pattern.t | 20 ++-- src/test/perl/rbe_remove_variable.t | 33 +++---- src/test/perl/rbe_rule_parser.t | 76 ++++++--------- src/test/perl/rbe_value_format.t | 128 ++++++++++++------------- 4 files changed, 119 insertions(+), 138 deletions(-) diff --git a/src/test/perl/rbe_build_line_pattern.t b/src/test/perl/rbe_build_line_pattern.t index 83b7ac23..50193078 100644 --- a/src/test/perl/rbe_build_line_pattern.t +++ b/src/test/perl/rbe_build_line_pattern.t @@ -55,10 +55,10 @@ Readonly my $KEYWORD => 'DPNS_HOST'; Readonly my $LINE_PATTERN_ENV_VAR => '#?\s*export DPNS_HOST='; Readonly my $LINE_PATTERN_KEY_VALUE => '#?\s*DPNS_HOST'; my $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENV_VAR); + LINE_FORMAT_ENV_VAR); is($escaped_pattern, $LINE_PATTERN_ENV_VAR, "Environment variable pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_KEY_VAL); + LINE_FORMAT_KEY_VAL); is($escaped_pattern, $LINE_PATTERN_KEY_VALUE, "Key/value pattern ok"); # Build a line pattern without a parameter value @@ -73,20 +73,20 @@ Readonly my $EXPECTED_PATTERN_3 => '#?\s*export DPNS_HOST=\^dp\$n\-s\.\*ex\]\s+a Readonly my $VALUE_4 => 'a\b'; Readonly my $EXPECTED_PATTERN_4 => '#?\s*export DPNS_HOST=a\\\\b'; $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENV_VAR, - $VALUE_1); + LINE_FORMAT_ENV_VAR, + $VALUE_1); is($escaped_pattern, $EXPECTED_PATTERN_1, "Environment variable with value (host name): pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENV_VAR, - $VALUE_2); + LINE_FORMAT_ENV_VAR, + $VALUE_2); is($escaped_pattern, $EXPECTED_PATTERN_2, "Environment variable with value (0): pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENV_VAR, - $VALUE_3); + LINE_FORMAT_ENV_VAR, + $VALUE_3); is($escaped_pattern, $EXPECTED_PATTERN_3, "Environment variable with value (special characters): pattern ok"); $escaped_pattern = $fh->_buildLinePattern($KEYWORD, - LINE_FORMAT_ENV_VAR, - $VALUE_4); + LINE_FORMAT_ENV_VAR, + $VALUE_4); is($escaped_pattern, $EXPECTED_PATTERN_4, "Environment variable with value (backslash): pattern ok"); diff --git a/src/test/perl/rbe_remove_variable.t b/src/test/perl/rbe_remove_variable.t index 7d9486e3..0d08af27 100644 --- a/src/test/perl/rbe_remove_variable.t +++ b/src/test/perl/rbe_remove_variable.t @@ -178,10 +178,9 @@ my $dpm_options = {}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%config_rules_1, - $dpm_options, - \%parser_options); +$changes = $fh->updateFile(\%config_rules_1, + $dpm_options, + \%parser_options); is("$fh", $DPM_EXPECTED_CONF_1, $DPM_CONF_FILE." has expected contents (negated keywords)"); $fh->close(); @@ -190,10 +189,9 @@ $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%config_rules_2, - $dpm_options, - \%parser_options); +$changes = $fh->updateFile(\%config_rules_2, + $dpm_options, + \%parser_options); is("$fh", $DPM_EXPECTED_CONF_2, $DPM_CONF_FILE." has expected contents (config option not defined)"); $fh->close(); @@ -202,10 +200,9 @@ $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%config_rules_3, - $dpm_options, - \%parser_options); +$changes = $fh->updateFile(\%config_rules_3, + $dpm_options, + \%parser_options); is("$fh", $DPM_EXPECTED_CONF_1, $DPM_CONF_FILE." has expected contents (rule condition not met)"); $fh->close(); @@ -215,9 +212,8 @@ $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%config_rules_4, - $dpm_options); +$changes = $fh->updateFile(\%config_rules_4, + $dpm_options); is("$fh", $DPM_EXPECTED_CONF_2, $DPM_CONF_FILE." has expected contents (rule keyword prefixed by ?)"); $fh->close(); @@ -227,10 +223,9 @@ $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%config_rules_1, - $dpm_options, - \%parser_options); +$changes = $fh->updateFile(\%config_rules_1, + $dpm_options, + \%parser_options); is("$fh", $DPM_EXPECTED_CONF_3, $DPM_CONF_FILE." has expected contents (repeated config line)"); $fh->close(); diff --git a/src/test/perl/rbe_rule_parser.t b/src/test/perl/rbe_rule_parser.t index bc74c21f..94184c30 100644 --- a/src/test/perl/rbe_rule_parser.t +++ b/src/test/perl/rbe_rule_parser.t @@ -364,9 +364,8 @@ set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%dpm_config_rules_1, - $dpm_options); +$changes = $fh->updateFile(\%dpm_config_rules_1, + $dpm_options); is("$fh", $DPM_EXPECTED_CONF_1, $DPM_CONF_FILE." has expected contents (config 1)"); $fh->close(); @@ -375,9 +374,8 @@ $fh->close(); set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%dpm_config_rules_1, - $dpm_options); +$changes = $fh->updateFile(\%dpm_config_rules_1, + $dpm_options); is("$fh", $DPM_EXPECTED_CONF_2, $DPM_CONF_FILE." has expected contents (config 2)"); $fh->close(); @@ -386,9 +384,8 @@ $fh->close(); set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_3); my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%dpm_config_rules_2, - $dpm_options); +$changes = $fh->updateFile(\%dpm_config_rules_2, + $dpm_options); is("$fh", $DPM_EXPECTED_CONF_3, $DPM_CONF_FILE." has expected contents (config 3)"); $fh->close(); @@ -397,9 +394,8 @@ $fh->close(); set_file_contents($DMLITE_CONF_FILE,$DMLITE_INITIAL_CONF_1); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%dav_config_rules, - $dmlite_options); +$changes = $fh->updateFile(\%dav_config_rules, + $dmlite_options); is("$fh", $DMLITE_EXPECTED_CONF_1, $DMLITE_CONF_FILE." has expected contents"); $fh->close(); @@ -409,36 +405,32 @@ $fh->close(); set_file_contents($DMLITE_CONF_FILE,''); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_with_conditions, - $all_options); +$changes = $fh->updateFile(\%rules_with_conditions, + $all_options); is("$fh", $COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (rules with conditions)"); $fh->close(); set_file_contents($DMLITE_CONF_FILE,''); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_with_neg_conds, - $all_options); +$changes = $fh->updateFile(\%rules_with_neg_conds, + $all_options); is("$fh", $NEG_COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (rules with negative conditions)"); $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_with_conditions, - $all_options); +$changes = $fh->updateFile(\%rules_with_conditions, + $all_options); is("$fh", $COND_TEST_INITIAL, $DMLITE_CONF_FILE." has expected contents (initial contents, rules conditions with non existent attribute)"); $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_with_conditions_2, - $all_options); +$changes = $fh->updateFile(\%rules_with_conditions_2, + $all_options); is("$fh", $COND_TEST_INITIAL, $DMLITE_CONF_FILE." has expected contents (initial contents, rules conditions with non existent option set)"); $fh->close(); @@ -447,29 +439,26 @@ $parser_options{remove_if_undef} = 1; set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_with_conditions, - $all_options, - \%parser_options); +$changes = $fh->updateFile(\%rules_with_conditions, + $all_options, + \%parser_options); is("$fh", $COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents (initial contents, rules conditions, parser options)"); $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_with_neg_conds, - $all_options, - \%parser_options); +$changes = $fh->updateFile(\%rules_with_neg_conds, + $all_options, + \%parser_options); is("$fh", $NEG_COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents (initial contents, rules with negative conditions, parser options)"); $fh->close(); set_file_contents($DMLITE_CONF_FILE,''); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_always, - $dmlite_options); +$changes = $fh->updateFile(\%rules_always, + $dmlite_options); is("$fh", $COND_TEST_EXPECTED_3, $DMLITE_CONF_FILE." has expected contents (always_rules_only not set)"); $fh->close(); @@ -477,10 +466,9 @@ $parser_options{always_rules_only} = 1; set_file_contents($DMLITE_CONF_FILE,''); my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_always, - $dmlite_options, - \%parser_options); +$changes = $fh->updateFile(\%rules_always, + $dmlite_options, + \%parser_options); is("$fh", $COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (always_rules_only set)"); $fh->close(); @@ -489,9 +477,8 @@ $fh->close(); set_file_contents($DPM_SHIFT_CONF_FILE,''); my $fh = CAF::FileEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_no_rule, - $dpm_options); +$changes = $fh->updateFile(\%rules_no_rule, + $dpm_options); is("$fh", $NO_RULE_EXPECTED, $DPM_SHIFT_CONF_FILE." has expected contents (keyword only)"); $fh->close(); @@ -500,9 +487,8 @@ $fh->close(); set_file_contents($DPM_SHIFT_CONF_FILE,''); my $fh = CAF::FileEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); -$changes = $fh->updateFile( - \%rules_multi_cond_sets, - $dpm_options); +$changes = $fh->updateFile(\%rules_multi_cond_sets, + $dpm_options); is("$fh", $MULTI_COND_SETS_EXPECTED, $DPM_SHIFT_CONF_FILE." has expected contents (multiple condition sets)"); $fh->close(); diff --git a/src/test/perl/rbe_value_format.t b/src/test/perl/rbe_value_format.t index 73668cfa..d7079592 100644 --- a/src/test/perl/rbe_value_format.t +++ b/src/test/perl/rbe_value_format.t @@ -55,22 +55,22 @@ Readonly my $FALSE => 'no'; Readonly my $TRUE => 'yes'; Readonly my $TRUE_QUOTED => '"yes"'; $formatted_value = $rbe_fh->_formatAttributeValue(0, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_BOOLEAN, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_BOOLEAN, + 0, + ); is($formatted_value, $FALSE, "Boolean (false) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(1, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_BOOLEAN, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_BOOLEAN, + 0, + ); is($formatted_value, $TRUE, "Boolean (true) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(1, - LINE_FORMAT_SH_VAR, - LINE_VALUE_BOOLEAN, - 0, - ); + LINE_FORMAT_SH_VAR, + LINE_VALUE_BOOLEAN, + 0, + ); is($formatted_value, $TRUE_QUOTED, "Boolean (true, quoted) correctly formatted"); @@ -81,46 +81,46 @@ Readonly my $AS_IS_VALUE_SINGLE_QUOTED => "'This is a Test'"; Readonly my $EMPTY_VALUE => ''; Readonly my $EMPTY_VALUE_QUOTED => '""'; $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_AS_IS, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_AS_IS, + 0, + ); is($formatted_value, $AS_IS_VALUE, "Literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE, - LINE_FORMAT_ENV_VAR, - LINE_VALUE_AS_IS, - 0, - ); + LINE_FORMAT_ENV_VAR, + LINE_VALUE_AS_IS, + 0, + ); is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Literal value (quoted) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_DOUBLE_QUOTED, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_AS_IS, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_AS_IS, + 0, + ); is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Quoted literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_DOUBLE_QUOTED, - LINE_FORMAT_ENV_VAR, - LINE_VALUE_AS_IS, - 0, - ); + LINE_FORMAT_ENV_VAR, + LINE_VALUE_AS_IS, + 0, + ); is($formatted_value, $AS_IS_VALUE_DOUBLE_QUOTED, "Already quoted literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($AS_IS_VALUE_SINGLE_QUOTED, - LINE_FORMAT_ENV_VAR, - LINE_VALUE_AS_IS, - 0, - ); + LINE_FORMAT_ENV_VAR, + LINE_VALUE_AS_IS, + 0, + ); is($formatted_value, $AS_IS_VALUE_SINGLE_QUOTED, "Already single quoted literal value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($EMPTY_VALUE, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_AS_IS, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_AS_IS, + 0, + ); is($formatted_value, $EMPTY_VALUE, "Empty value correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue($EMPTY_VALUE, - LINE_FORMAT_SH_VAR, - LINE_VALUE_AS_IS, - 0, - ); + LINE_FORMAT_SH_VAR, + LINE_VALUE_AS_IS, + 0, + ); is($formatted_value, $EMPTY_VALUE_QUOTED, "Empty value (quoted) correctly formatted"); @@ -134,16 +134,16 @@ Readonly my %INSTANCE_PARAMS => (logFile => '/test/instance.log', Readonly my $FORMATTED_INSTANCE_PARAMS => ' -l /test/instance.log -k 60'; Readonly my $FORMATTED_INSTANCE_PARAMS_QUOTED => '" -l /test/instance.log -k 60"'; $formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_INSTANCE_PARAMS, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_INSTANCE_PARAMS, + 0, + ); is($formatted_value, $FORMATTED_INSTANCE_PARAMS, "Instance params correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, - LINE_FORMAT_SH_VAR, - LINE_VALUE_INSTANCE_PARAMS, - 0, - ); + LINE_FORMAT_SH_VAR, + LINE_VALUE_INSTANCE_PARAMS, + 0, + ); is($formatted_value, $FORMATTED_INSTANCE_PARAMS_QUOTED, "Instance params (quoted) correctly formatted"); @@ -155,31 +155,31 @@ Readonly my $FORMATTED_ARRAY_UNIQUE => 'confFile logFile logKeep unused'; my $rbe_fh = CAF::FileEditor->open($FILENAME, log => $this_app); ok(defined($rbe_fh), $FILENAME." was opened"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_ARRAY, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_ARRAY, + 0, + ); is($formatted_value, $FORMATTED_ARRAY, "Array values correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_ARRAY, - LINE_VALUE_OPT_SORTED, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_ARRAY, + LINE_VALUE_OPT_SORTED, + ); is($formatted_value, $FORMATTED_ARRAY_SORTED, "Array values (sorted) correctly formatted"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_ARRAY, - LINE_VALUE_OPT_UNIQUE, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_ARRAY, + LINE_VALUE_OPT_UNIQUE, + ); is($formatted_value, $FORMATTED_ARRAY_UNIQUE, "Array values (unique) correctly formatted"); # LINE_VALUE_HASH_KEYS $formatted_value = $rbe_fh->_formatAttributeValue(\%INSTANCE_PARAMS, - LINE_FORMAT_KEY_VAL, - LINE_VALUE_HASH_KEYS, - 0, - ); + LINE_FORMAT_KEY_VAL, + LINE_VALUE_HASH_KEYS, + 0, + ); is($formatted_value, $FORMATTED_ARRAY_UNIQUE, "Hash keys correctly formatted"); From da657f1427ee0abed4027e79cac42435bc0e7e4b Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sat, 23 Apr 2016 22:43:53 +0200 Subject: [PATCH 09/22] RuleBasedEditor: document rule format + misc. doc improvements --- src/main/perl/RuleBasedEditor.pm | 87 ++++++++++++++++++++++++++++++-- 1 file changed, 84 insertions(+), 3 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index 48560503..d50af67e 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -43,6 +43,7 @@ use Fcntl qw(:seek); use constant BEGINNING_OF_FILE => (SEEK_SET, 0); use constant ENDING_OF_FILE => (SEEK_END, 0); + ######################################################### # Constants use to format lines in configuration files. # # These constants are exported. # @@ -117,10 +118,90 @@ Readonly my $BACKUP_FILE_EXT => ".old"; =head1 DESCRIPTION -This module implements a rule-based editor. It has only one public method: B. -Rules are passed as a hash. +This module implements a rule-based editor. It extends the B. It has only +one public method: B (see below) and no specific constructor. + +Rules used to edit the file are defined as hashes: each entry defines a rule. +Multiple rules can be applied to the same file: it is important that they are +orthogonal, else the result is unpredictable. + +The hash entry key represents the line keyword in configuration file and +hash value is the parsing rule for the keyword value. Parsing rule format is : + + [condition->]option_name:option_set[,option_set,...];line_fmt[;value_fmt[:value_fmt_opt]] + +If the line keyword (hash key) is starting with a '-', this means that the matching +configuration line must be removed/commented out (instead of added/updated) from the +configuration file if present. If it is starting with a '?', this means that the +matching line must be removed/commented out if the option is undefined. + +=over + +=item condtion + +an option or an option set that must exist for the rule to be applied. +Both option_set and option_name:option_set are accepted (see below). +Only one option set is allowed and only its existence, not its value is tested. +In addition, the condition may be negated (option or option_set must +not exist) by prepending it with '!'. + +=item option_name + +the name of an option that will be retrieved from the configuration. + +=item option_set + +the name of an option set where the option is located in (for example 'dpnsHost:dpm' +means C option of 'dpm' option set. An option set is a sub-hash in the configuration +hash. C is a special value for 'option_set' indicating that the option is a global option, +instead of belonging to a specific option set (global options are at the top level of the option +hash). + +=item line_fmt + +defines the format used to represent the key/value pair. 3 formats are +supported (see LINE_FORMAT_xxx constants below): + +=over + +=item + +a sh shell environment variable definition (export VAR=val) + +=item + +a sh shell variable definition (VAR=val) + +=item + +a 'keyword value' line, as used by Xrootd or Apache config files. + +=item + +a 'setenv keyword value' line, as used by Xrootd config files mainly. + +=item + +a 'set keyword value' line, as used by Xrootd config files mainly. + +=back + +Inline comments are not supported in 'keyword value' family of formats. + +=item value_fmt + +used to indicate how to interpret the configuration value. It is used mainly for +boolean values, list and hashes. See LINE_VALUE_xxx constants below for the possible values. + +=item value_fmt + +used to indicate how to interpret the configuration value. It is used mainly for +boolean values, list and hashes. See LINE_VALUE_xxx constants below for the possible values. + +=back -See https://github.com/quattor/CAF/issues/123#issue-123702165 for details. +For an example of rules, look at ncm-dpmlfc or ncm-xrootd source code in +configuration-modules-grid repository. =head2 Public methods From 8f238411e162b3c0378ce8fd27641f5b47bab930 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sun, 24 Apr 2016 11:08:28 +0200 Subject: [PATCH 10/22] RuleBasedEditor: convert into a subclass of the FileEditor --- src/main/perl/FileEditor.pm | 3 +- src/main/perl/RuleBasedEditor.pm | 39 ++++++++++++------- src/test/perl/rbe_build_line_pattern.t | 3 +- src/test/perl/rbe_remove_variable.t | 11 +++--- src/test/perl/rbe_rule_parser.t | 29 +++++++------- src/test/perl/rbe_value_format.t | 5 +-- src/test/perl/test-cafrulebasededitor.t | 51 +++++++++++++++++++++++++ 7 files changed, 100 insertions(+), 41 deletions(-) create mode 100644 src/test/perl/test-cafrulebasededitor.t diff --git a/src/main/perl/FileEditor.pm b/src/main/perl/FileEditor.pm index d8cf65e4..630ec6f7 100644 --- a/src/main/perl/FileEditor.pm +++ b/src/main/perl/FileEditor.pm @@ -12,8 +12,7 @@ use LC::File; use Exporter; use Fcntl qw(:seek); -use CAF::RuleBasedEditor qw(:rule_constants); -use parent qw(CAF::FileWriter Exporter CAF::RuleBasedEditor); +use parent qw(CAF::FileWriter Exporter); our @EXPORT = qw(BEGINNING_OF_FILE ENDING_OF_FILE); use constant BEGINNING_OF_FILE => (SEEK_SET, 0); diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index d50af67e..a078ec12 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -10,13 +10,11 @@ # updating the file is the Quattor configuration and conditions can be defined # based on the contents of this configuration. # -# This module extends the base methods of the CAF FileEditor: it contains -# all the methods making the rule-based editor (only one being a public method). +# This module is a subclass of the CAF FileEditor: it extends the base methods of +# the CAF FileEditor. In addition to the constructor it has only one public method. # The methods provided in this module can be used at the same time as the # base methods of the FileEditor. # -# The code of the rule-based editor is maintained in a separate module only for -# clarity. It cannot be used directly (there is intentionally not constructor). # ####################################################################### @@ -24,11 +22,11 @@ package CAF::RuleBasedEditor; use strict; use warnings; -use NCM::Component; use vars qw(@ISA $EC); -@ISA = qw(NCM::Component); $EC=LC::Exception::Context->new->will_store_all; +use parent qw(CAF::FileEditor Exporter); + use EDG::WP4::CCM::Element; use Readonly; @@ -37,11 +35,8 @@ use Encode qw(encode_utf8); local(*DTA); -# Constant duplicated from FileEditor: -# Importing them from it failed due to a chicken and egg problem... -use Fcntl qw(:seek); -use constant BEGINNING_OF_FILE => (SEEK_SET, 0); -use constant ENDING_OF_FILE => (SEEK_END, 0); +# Constants from FileEditor +use CAF::FileEditor qw(BEGINNING_OF_FILE ENDING_OF_FILE); ######################################################### @@ -118,8 +113,9 @@ Readonly my $BACKUP_FILE_EXT => ".old"; =head1 DESCRIPTION -This module implements a rule-based editor. It extends the B. It has only -one public method: B (see below) and no specific constructor. +This module implements a rule-based editor. It is a subclass of the B +and extends it. In addition to the constructor, it has only +one public method: B (see below). Rules used to edit the file are defined as hashes: each entry defines a rule. Multiple rules can be applied to the same file: it is important that they are @@ -208,6 +204,23 @@ configuration-modules-grid repository. =over +=item new + +This is the constructor. It mainly executes the FileEditor constructor and supports the +same arguments. + +==cut + +sub new +{ + my $class = shift; + my $self = $class->SUPER::new (@_); + return $self; +} + + +=pod + =item updateFile Update configuration file contents, applying configuration rules. diff --git a/src/test/perl/rbe_build_line_pattern.t b/src/test/perl/rbe_build_line_pattern.t index 50193078..6f7161d0 100644 --- a/src/test/perl/rbe_build_line_pattern.t +++ b/src/test/perl/rbe_build_line_pattern.t @@ -8,7 +8,6 @@ use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; use testapp; -use CAF::FileEditor; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; @@ -46,7 +45,7 @@ $SIG{__DIE__} = \&confess; open ($log, ">", \$str); $this_app->set_report_logfile ($log); -my $fh = CAF::FileEditor->open($FILENAME, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($FILENAME, log => $this_app); ok(defined($fh), $FILENAME." was opened"); diff --git a/src/test/perl/rbe_remove_variable.t b/src/test/perl/rbe_remove_variable.t index 0d08af27..b57174a1 100644 --- a/src/test/perl/rbe_remove_variable.t +++ b/src/test/perl/rbe_remove_variable.t @@ -8,7 +8,6 @@ use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; use testapp; -use CAF::FileEditor; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; @@ -176,7 +175,7 @@ my $fh; # Test negated keywords my $dpm_options = {}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_1, $dpm_options, @@ -187,7 +186,7 @@ $fh->close(); # Test removal of a config line is config option is not defined $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_2, $dpm_options, @@ -198,7 +197,7 @@ $fh->close(); # Test removal of a config line is rule condition is not met $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_3, $dpm_options, @@ -210,7 +209,7 @@ $fh->close(); # when keyword is prefixed by ? $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_4, $dpm_options); @@ -221,7 +220,7 @@ $fh->close(); # Test removal of config lines appearing multiple times $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_1, $dpm_options, diff --git a/src/test/perl/rbe_rule_parser.t b/src/test/perl/rbe_rule_parser.t index 94184c30..eea3f459 100644 --- a/src/test/perl/rbe_rule_parser.t +++ b/src/test/perl/rbe_rule_parser.t @@ -8,7 +8,6 @@ use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; use testapp; -use CAF::FileEditor; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; @@ -362,7 +361,7 @@ set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); # Test simple variable substitution set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dpm_config_rules_1, $dpm_options); @@ -372,7 +371,7 @@ $fh->close(); # Test potentially ambiguous config (duplicated lines, similar keywords) set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dpm_config_rules_1, $dpm_options); @@ -382,7 +381,7 @@ $fh->close(); # Test array displayed as list set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_3); -my $fh = CAF::FileEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dpm_config_rules_2, $dpm_options); @@ -392,7 +391,7 @@ $fh->close(); # Test 'keyword value" format (a la Apache) set_file_contents($DMLITE_CONF_FILE,$DMLITE_INITIAL_CONF_1); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dav_config_rules, $dmlite_options); @@ -403,7 +402,7 @@ $fh->close(); # Test rule conditions set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions, $all_options); @@ -411,7 +410,7 @@ is("$fh", $COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (rule $fh->close(); set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_neg_conds, $all_options); @@ -419,7 +418,7 @@ is("$fh", $NEG_COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents ( $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions, $all_options); @@ -427,7 +426,7 @@ is("$fh", $COND_TEST_INITIAL, $DMLITE_CONF_FILE." has expected contents (initial $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions_2, $all_options); @@ -437,7 +436,7 @@ $fh->close(); my %parser_options; $parser_options{remove_if_undef} = 1; set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions, $all_options, @@ -446,7 +445,7 @@ is("$fh", $COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents (init $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_neg_conds, $all_options, @@ -455,7 +454,7 @@ is("$fh", $NEG_COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents ( $fh->close(); set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_always, $dmlite_options); @@ -464,7 +463,7 @@ $fh->close(); $parser_options{always_rules_only} = 1; set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::FileEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_always, $dmlite_options, @@ -475,7 +474,7 @@ $fh->close(); # Rule with only a keyword set_file_contents($DPM_SHIFT_CONF_FILE,''); -my $fh = CAF::FileEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_no_rule, $dpm_options); @@ -485,7 +484,7 @@ $fh->close(); # Rule with multiple condition sets and multiple-word keyword set_file_contents($DPM_SHIFT_CONF_FILE,''); -my $fh = CAF::FileEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_multi_cond_sets, $dpm_options); diff --git a/src/test/perl/rbe_value_format.t b/src/test/perl/rbe_value_format.t index d7079592..70f6b797 100644 --- a/src/test/perl/rbe_value_format.t +++ b/src/test/perl/rbe_value_format.t @@ -8,7 +8,6 @@ use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; use testapp; -use CAF::FileEditor; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; @@ -47,7 +46,7 @@ open ($log, ">", \$str); $this_app->set_report_logfile ($log); my $formatted_value; -my $rbe_fh = CAF::FileEditor->open($FILENAME, log => $this_app); +my $rbe_fh = CAF::RuleBasedEditor->open($FILENAME, log => $this_app); ok(defined($rbe_fh), $FILENAME." was opened"); # LINE_VALUE_BOOLEAN @@ -152,7 +151,7 @@ Readonly my @TEST_ARRAY => ('confFile', 'logFile', 'unused', 'logKeep', 'logFile Readonly my $FORMATTED_ARRAY => 'confFile logFile unused logKeep logFile'; Readonly my $FORMATTED_ARRAY_SORTED => 'confFile logFile logFile logKeep unused'; Readonly my $FORMATTED_ARRAY_UNIQUE => 'confFile logFile logKeep unused'; -my $rbe_fh = CAF::FileEditor->open($FILENAME, log => $this_app); +my $rbe_fh = CAF::RuleBasedEditor->open($FILENAME, log => $this_app); ok(defined($rbe_fh), $FILENAME." was opened"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, LINE_FORMAT_KEY_VAL, diff --git a/src/test/perl/test-cafrulebasededitor.t b/src/test/perl/test-cafrulebasededitor.t new file mode 100644 index 00000000..4e34424d --- /dev/null +++ b/src/test/perl/test-cafrulebasededitor.t @@ -0,0 +1,51 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw($Bin); +use lib "$Bin/modules"; +use testapp; +use CAF::RuleBasedEditor; +use Test::More; +use Carp qw(confess); +use File::Path; +use File::Temp qw(tempfile); + +my $testdir = 'target/test/editor'; +mkpath($testdir); +(undef, our $filename) = tempfile(DIR => $testdir); + +use constant TEXT => < <new ($0, qw (--verbose)); + +$SIG{__DIE__} = \&confess; + +*testapp::error = sub { + my $self = shift; + $self->{ERROR} = @_; +}; + +open ($log, ">", \$str); +my $fh = CAF::RuleBasedEditor->new ($filename); +isa_ok ($fh, "CAF::RuleBasedEditor", "Correct class after new method"); +isa_ok ($fh, "CAF::FileEditor", "Correct class inheritance after new method"); +isa_ok ($fh, "CAF::FileWriter", "Correct class inheritance after new method"); +is (${$fh->string_ref()}, TEXT, "File opened and correctly read"); +$fh->close(); + +is(*$fh->{filename}, $filename, "The object stores its parent's attributes"); + +done_testing(); + From 6f77a5af0604449299011d4b9342b347222b5b19 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sun, 24 Apr 2016 18:42:21 +0200 Subject: [PATCH 11/22] RuleBaseEditor.pm: address initial comments by @stdweird in #151 --- src/main/perl/RuleBasedEditor.pm | 332 +++++++++++++++++++------------ 1 file changed, 203 insertions(+), 129 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index a078ec12..fbbca28d 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -2,124 +2,28 @@ # ${developer-info} # ${author-info} # ${build-info} -# -# -# This module implements a rule-based editor that is used to modify the content -# of an existing file without taking care of the whole file. Each rule -# driving the edition process is applied to all matching lines. The input for -# updating the file is the Quattor configuration and conditions can be defined -# based on the contents of this configuration. -# -# This module is a subclass of the CAF FileEditor: it extends the base methods of -# the CAF FileEditor. In addition to the constructor it has only one public method. -# The methods provided in this module can be used at the same time as the -# base methods of the FileEditor. -# -# -####################################################################### - -package CAF::RuleBasedEditor; - -use strict; -use warnings; -use vars qw(@ISA $EC); -$EC=LC::Exception::Context->new->will_store_all; - -use parent qw(CAF::FileEditor Exporter); - -use EDG::WP4::CCM::Element; - -use Readonly; - -use Encode qw(encode_utf8); - -local(*DTA); - -# Constants from FileEditor -use CAF::FileEditor qw(BEGINNING_OF_FILE ENDING_OF_FILE); - - -######################################################### -# Constants use to format lines in configuration files. # -# These constants are exported. # -######################################################### - -# LINE_FORMAT_xxx: general syntax of the line (key/val format) -# LINE_FORMAT_SH_VAR: key=val (e.g. SH shell family) -# LINE_FORMAT_ENV_VAR: export key=val (e.g. SH shell family) -# LINE_FORMAT_KEY_VAL: key val (e.g. Xrootd, Apache) -# LINE_FORMAT_KEY_VAL_SETENV: setenv key val (used by Xrootd in particular) -# LINE_FORMAT_KEY_VAL_SET: set key val (used by Xrootd in particular) -use enum qw(LINE_FORMAT_SH_VAR=1 - LINE_FORMAT_ENV_VAR - LINE_FORMAT_KEY_VAL - LINE_FORMAT_KEY_VAL_SETENV - LINE_FORMAT_KEY_VAL_SET - ); - -# LINE_VALUE_xxx: how to interpret the configuration value -# LINE_VALUE_INSTANCE_PARAMS is specific to Xrootd. -use enum qw(LINE_VALUE_AS_IS - LINE_VALUE_BOOLEAN - LINE_VALUE_ARRAY - LINE_VALUE_HASH_KEYS - LINE_VALUE_STRING_HASH - LINE_VALUE_INSTANCE_PARAMS - ); - -# LINE_VALUE_OPT_xxx: options for rendering the value -# (mainly apply to lists and dictionnaries) -use enum qw(BITMASK: LINE_VALUE_OPT_SINGLE - LINE_VALUE_OPT_UNIQUE - LINE_VALUE_OPT_SORTED - ); - -# Internal constants -Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_SH_VAR; -Readonly my $LINE_QUATTOR_COMMENT => "\t\t# Line generated by Quattor"; -Readonly my $LINE_OPT_DEF_REMOVE_IF_UNDEF => 0; -Readonly my $LINE_OPT_DEF_ALWAYS_RULES_ONLY => 0; -Readonly my $RULE_CONDITION_ALWAYS => 'ALWAYS'; -Readonly my $RULE_OPTION_SET_GLOBAL => 'GLOBAL'; - - -# Export constants used to build rules -Readonly my @RULE_CONSTANTS => qw(LINE_FORMAT_SH_VAR - LINE_FORMAT_ENV_VAR - LINE_FORMAT_KEY_VAL - LINE_FORMAT_KEY_VAL_SETENV - LINE_FORMAT_KEY_VAL_SET - LINE_VALUE_AS_IS - LINE_VALUE_BOOLEAN - LINE_VALUE_INSTANCE_PARAMS - LINE_VALUE_ARRAY - LINE_VALUE_HASH_KEYS - LINE_VALUE_STRING_HASH - LINE_VALUE_OPT_SINGLE - LINE_VALUE_OPT_UNIQUE - LINE_VALUE_OPT_SORTED - ); -our @EXPORT_OK; -our %EXPORT_TAGS; -push @EXPORT_OK, @RULE_CONSTANTS; -$EXPORT_TAGS{rule_constants} = \@RULE_CONSTANTS; - - -# Backup file extension -Readonly my $BACKUP_FILE_EXT => ".old"; - =pod =head1 DESCRIPTION -This module implements a rule-based editor. It is a subclass of the B -and extends it. In addition to the constructor, it has only -one public method: B (see below). +This module implements a rule-based editor that is used to modify the content +of an existing file without taking care of the whole file. Each rule +driving the edition process is applied to all matching lines. The input for +updating the file is the Quattor configuration and conditions can be defined +based on the contents of this configuration. + +This module is a subclass of the L: it extends the base methods of +the CAF FileEditor. In addition to the constructor it has only one public method. +The methods provided in this module can be used at the same time as the +base methods of the L. Rules used to edit the file are defined as hashes: each entry defines a rule. Multiple rules can be applied to the same file: it is important that they are -orthogonal, else the result is unpredictable. +orthogonal, else the result is unpredictable. The order used to apply rules is undefined. +The result of applying the rules with the same configuration is idempotent when starting +from the same initial file but sucessive edition of a file (with different configuration values) +may not necessarily be idempotent (in general they are). The hash entry key represents the line keyword in configuration file and hash value is the parsing rule for the keyword value. Parsing rule format is : @@ -133,7 +37,7 @@ matching line must be removed/commented out if the option is undefined. =over -=item condtion +=item condition an option or an option set that must exist for the rule to be applied. Both option_set and option_name:option_set are accepted (see below). @@ -162,11 +66,11 @@ supported (see LINE_FORMAT_xxx constants below): =item -a sh shell environment variable definition (export VAR=val) +a SH shell environment variable definition (export key=val). =item -a sh shell variable definition (VAR=val) +a SH shell variable definition (key=val). =item @@ -174,11 +78,11 @@ a 'keyword value' line, as used by Xrootd or Apache config files. =item -a 'setenv keyword value' line, as used by Xrootd config files mainly. +a 'setenv keyword value' line, as used by Xrootd config files mainly. It can also be used in a CSH shell script. =item -a 'set keyword value' line, as used by Xrootd config files mainly. +a 'set keyword value' line, as used by Xrootd config files mainly. It doesn't work in a CSH shell script (C<=> missing). =back @@ -196,31 +100,201 @@ boolean values, list and hashes. See LINE_VALUE_xxx constants below for the poss =back -For an example of rules, look at ncm-dpmlfc or ncm-xrootd source code in +An example of rule declaration is: + + my %dpm_config_rules_2 = ( + "ALLOW_COREDUMP" => "allowCoreDump:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_BOOLEAN, + "GLOBUS_THREAD_MODEL" => "globusThreadModel:dpm;".LINE_FORMAT_ENV_VAR, + "DISKFLAGS" =>"DiskFlags:dpm;".LINE_FORMAT_SH_VAR.";".LINE_VALUE_ARRAY, + ); + +For more comprehensive examples of rules, look at L or L source code in configuration-modules-grid repository. +=cut -=head2 Public methods + +package CAF::RuleBasedEditor; + +use strict; +use warnings; +use vars qw($EC); +$EC=LC::Exception::Context->new->will_store_all; + +use parent qw(CAF::FileEditor Exporter); + +use EDG::WP4::CCM::Element; + +use Readonly; + +use Encode qw(encode_utf8); + +# Constants from FileEditor +use CAF::FileEditor qw(BEGINNING_OF_FILE ENDING_OF_FILE); + + +=pod + +=head2 Rule Constants + +The constants described here are used to build the rules. All these +constants are exported. Add the following to use them: + + use RuleBasedEditor qw(:rule_constants); + +There is a different group of constants for each part of the rule. + + +=head3 LINE_FORMAT_xxx: general syntax of the line =over -=item new +=item * -This is the constructor. It mainly executes the FileEditor constructor and supports the -same arguments. +LINE_FORMAT_SH_VAR: key=val (e.g. SH shell family) -==cut +=item * -sub new -{ - my $class = shift; - my $self = $class->SUPER::new (@_); - return $self; -} +LINE_FORMAT_ENV_VAR: export key=val (e.g. SH shell family) +=item * + +LINE_FORMAT_KEY_VAL: key val (e.g. Xrootd, Apache) + +=item * +LINE_FORMAT_KEY_VAL_SETENV: setenv key val (used by Xrootd in particular) + +=item * + +LINE_FORMAT_KEY_VAL_SET: set key val (used by Xrootd in particular) + +=back + +=cut + +use enum qw(LINE_FORMAT_SH_VAR=1 + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET + ); + +=pod + +=head3 + +LINE_VALUE_xxx: how to interpret the configuration value + +=over + +=item + +LINE_VALUE_AS_IS: take the value as it is, do not attempt any conversion + +=item + +LINE_VALUE_BOOLEAN: interpret the value as a boolean rendered as C or C + +=item + +LINE_VALUE_ARRAY: the value is an array. Rendering controlled by LINE_VALUE_OPT_xxx constants. + +=item + +LINE_VALUE_HASH_KEYS: the value is hash whose keys are the value. Rendering similar to arrays. + +=item + +LINE_VALUE_STRING_HASH: the value is a hash of string. Rendering controlled by LINE_VALUE_OPT_xxx constants. + +=item + +LINE_VALUE_INSTANCE_PARAMS: specific to L + +=back + +=cut + +use enum qw(LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + LINE_VALUE_INSTANCE_PARAMS + ); + +=pod + +=head3 LINE_VALUE_OPT_xxx: options for rendering the value + +These options mainly apply to lists and hashes and are interpreted as a bitmask. + +=over + +=item + +LINE_VALUE_OPT_SINGLE: each value must be a separate instance of the keyword (multiple lines) + +=item + +LINE_VALUE_OPT_UNIQUE: each values are concataneted as a space-separated string + +=item + +LINE_VALUE_OPT_SORTED: values are sorted + +=back + +=cut + +use enum qw(BITMASK: LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); + +# Internal constants +Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_SH_VAR; +Readonly my $LINE_QUATTOR_COMMENT => "\t\t# Line generated by Quattor"; +Readonly my $LINE_OPT_DEF_REMOVE_IF_UNDEF => 0; +Readonly my $LINE_OPT_DEF_ALWAYS_RULES_ONLY => 0; +Readonly my $RULE_CONDITION_ALWAYS => 'ALWAYS'; +Readonly my $RULE_OPTION_SET_GLOBAL => 'GLOBAL'; + + +# Export constants used to build rules +# Needs to be updated when a constant is added or removed +Readonly my @RULE_CONSTANTS => qw(LINE_FORMAT_SH_VAR + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET + LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_INSTANCE_PARAMS + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); + + +our @EXPORT_OK; +our %EXPORT_TAGS; +push @EXPORT_OK, @RULE_CONSTANTS; +$EXPORT_TAGS{rule_constants} = \@RULE_CONSTANTS; + + +# Backup file extension +Readonly my $BACKUP_FILE_EXT => ".old"; =pod +=head2 Public methods + +=over + =item updateFile Update configuration file contents, applying configuration rules. @@ -259,9 +333,9 @@ sub updateFile { $self->seek_begin(); # Check that config file has an appropriate header - my $intro_pattern = "# This file is managed by Quattor"; + Readonly my $INTRO_PATTERN => "# This file is managed by Quattor"; my $intro = "# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor"; - $self->add_or_replace_lines(qr/^$intro_pattern/, + $self->add_or_replace_lines(qr/^$INTRO_PATTERN/, qr/^$intro$/, $intro."\n#\n", BEGINNING_OF_FILE, From 55eb2078f8a95880ad744c9b085c0cc72d653164 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Mon, 25 Apr 2016 09:08:02 +0200 Subject: [PATCH 12/22] RuleBasedEditor: general reformatting with perl-Tidy - perl-Tidy options used: -lp -l=132 -cti=1 -nolq -pt=2 -sbt=2 -bt=2 -sbl -boc -cab=3 -nbbc -mbl=3 --- src/main/perl/RuleBasedEditor.pm | 1301 ++++++++++++++++-------------- 1 file changed, 677 insertions(+), 624 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index fbbca28d..03dcaa08 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -119,7 +119,7 @@ package CAF::RuleBasedEditor; use strict; use warnings; use vars qw($EC); -$EC=LC::Exception::Context->new->will_store_all; +$EC = LC::Exception::Context->new->will_store_all; use parent qw(CAF::FileEditor Exporter); @@ -172,12 +172,13 @@ LINE_FORMAT_KEY_VAL_SET: set key val (used by Xrootd in particular) =cut -use enum qw(LINE_FORMAT_SH_VAR=1 - LINE_FORMAT_ENV_VAR - LINE_FORMAT_KEY_VAL - LINE_FORMAT_KEY_VAL_SETENV - LINE_FORMAT_KEY_VAL_SET - ); +use enum qw( + LINE_FORMAT_SH_VAR=1 + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET + ); =pod @@ -215,13 +216,14 @@ LINE_VALUE_INSTANCE_PARAMS: specific to L =cut -use enum qw(LINE_VALUE_AS_IS - LINE_VALUE_BOOLEAN - LINE_VALUE_ARRAY - LINE_VALUE_HASH_KEYS - LINE_VALUE_STRING_HASH - LINE_VALUE_INSTANCE_PARAMS - ); +use enum qw( + LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + LINE_VALUE_INSTANCE_PARAMS + ); =pod @@ -247,37 +249,39 @@ LINE_VALUE_OPT_SORTED: values are sorted =cut -use enum qw(BITMASK: LINE_VALUE_OPT_SINGLE - LINE_VALUE_OPT_UNIQUE - LINE_VALUE_OPT_SORTED - ); +use enum qw( + BITMASK: LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); # Internal constants -Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_SH_VAR; -Readonly my $LINE_QUATTOR_COMMENT => "\t\t# Line generated by Quattor"; -Readonly my $LINE_OPT_DEF_REMOVE_IF_UNDEF => 0; +Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_SH_VAR; +Readonly my $LINE_QUATTOR_COMMENT => "\t\t# Line generated by Quattor"; +Readonly my $LINE_OPT_DEF_REMOVE_IF_UNDEF => 0; Readonly my $LINE_OPT_DEF_ALWAYS_RULES_ONLY => 0; -Readonly my $RULE_CONDITION_ALWAYS => 'ALWAYS'; -Readonly my $RULE_OPTION_SET_GLOBAL => 'GLOBAL'; +Readonly my $RULE_CONDITION_ALWAYS => 'ALWAYS'; +Readonly my $RULE_OPTION_SET_GLOBAL => 'GLOBAL'; # Export constants used to build rules # Needs to be updated when a constant is added or removed -Readonly my @RULE_CONSTANTS => qw(LINE_FORMAT_SH_VAR - LINE_FORMAT_ENV_VAR - LINE_FORMAT_KEY_VAL - LINE_FORMAT_KEY_VAL_SETENV - LINE_FORMAT_KEY_VAL_SET - LINE_VALUE_AS_IS - LINE_VALUE_BOOLEAN - LINE_VALUE_INSTANCE_PARAMS - LINE_VALUE_ARRAY - LINE_VALUE_HASH_KEYS - LINE_VALUE_STRING_HASH - LINE_VALUE_OPT_SINGLE - LINE_VALUE_OPT_UNIQUE - LINE_VALUE_OPT_SORTED - ); +Readonly my @RULE_CONSTANTS => qw( + LINE_FORMAT_SH_VAR + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET + LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_INSTANCE_PARAMS + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); our @EXPORT_OK; @@ -313,39 +317,43 @@ Return value =cut -sub updateFile { - my $function_name = "updateConfigFile"; - my ($self, $config_rules, $config_options, $parser_options) = @_; - - unless ( $config_rules ) { - *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); - return 1; - } - unless ( $config_options ) { - *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); - return 1; - } - unless ( defined($parser_options) ) { - *$self->{LOG}->debug(2,"$function_name: 'parser_options' undefined"); - $parser_options = {}; - } - - $self->seek_begin(); - - # Check that config file has an appropriate header - Readonly my $INTRO_PATTERN => "# This file is managed by Quattor"; - my $intro = "# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor"; - $self->add_or_replace_lines(qr/^$INTRO_PATTERN/, - qr/^$intro$/, - $intro."\n#\n", - BEGINNING_OF_FILE, - ); - - $self->_apply_rules($config_rules, - $config_options, - $parser_options); - - return 0; +sub updateFile +{ + my $function_name = "updateConfigFile"; + my ($self, $config_rules, $config_options, $parser_options) = @_; + + unless ($config_rules) { + *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); + return 1; + } + unless ($config_options) { + *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); + return 1; + } + unless (defined($parser_options)) { + *$self->{LOG}->debug(2, "$function_name: 'parser_options' undefined"); + $parser_options = {}; + } + + $self->seek_begin(); + + # Check that config file has an appropriate header + Readonly my $INTRO_PATTERN => "# This file is managed by Quattor"; + my $intro = "# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor"; + $self->add_or_replace_lines( + qr/^$INTRO_PATTERN/, + qr/^$intro$/, + $intro . "\n#\n", + BEGINNING_OF_FILE, + ); + + $self->_apply_rules( + $config_rules, + $config_options, + $parser_options + ); + + return 0; } @@ -369,76 +377,80 @@ Arguments : =cut -sub _formatAttributeValue { - my $function_name = "_formatAttributeValue"; - my ($self, $attr_value, $line_fmt, $value_fmt, $value_opt) = @_; - - unless ( defined($attr_value) ) { - *$self->{LOG}->error("$function_name: 'attr_value' argument missing (internal error)"); - return 1; - } - unless ( defined($line_fmt) ) { - *$self->{LOG}->error("$function_name: 'list_fmt' argument missing (internal error)"); - return 1; - } - unless ( defined($value_fmt) ) { - *$self->{LOG}->error("$function_name: 'value_fmt' argument missing (internal error)"); - return 1; - } - unless ( defined($value_opt) ) { - *$self->{LOG}->error("$function_name: 'value_opt' argument missing (internal error)"); - return 1; - } - - *$self->{LOG}->debug(2,"$function_name: formatting attribute value >>>$attr_value<<< (line fmt=$line_fmt, value fmt=$value_fmt, value_opt=$value_opt)"); - - my $formatted_value; - if ( $value_fmt == LINE_VALUE_BOOLEAN ) { - $formatted_value = $attr_value ? 'yes' : 'no'; - - } elsif ( $value_fmt == LINE_VALUE_INSTANCE_PARAMS ) { - $formatted_value = ''; # Don't return undef if no matching attributes is found - # Instance parameters are described in a nlist - $formatted_value .= " -l $attr_value->{logFile}" if $attr_value->{logFile}; - $formatted_value .= " -c $attr_value->{configFile}" if $attr_value->{configFile}; - $formatted_value .= " -k $attr_value->{logKeep}" if $attr_value->{logKeep}; - - } elsif ( $value_fmt == LINE_VALUE_ARRAY ) { - *$self->{LOG}->debug(2, "$function_name: array values received: ", join(",",@$attr_value)); - if ( $value_opt & LINE_VALUE_OPT_UNIQUE ) { - my %values = map(($_ => 1), @$attr_value); - $attr_value = [ keys(%values) ]; - *$self->{LOG}->debug(2, "$function_name: array values made unique: ", join(",",@$attr_value)); +sub _formatAttributeValue +{ + my $function_name = "_formatAttributeValue"; + my ($self, $attr_value, $line_fmt, $value_fmt, $value_opt) = @_; + + unless (defined($attr_value)) { + *$self->{LOG}->error("$function_name: 'attr_value' argument missing (internal error)"); + return 1; } - # LINE_VALUE_OPT_UNIQUE implies LINE_VALUE_OPT_SORTED - if ( $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED) ) { - $attr_value = [ sort(@$attr_value) ] if $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED); - *$self->{LOG}->debug(2, "$function_name: array values sorted: ", join(",",@$attr_value)); - }; - $formatted_value = join " ", @$attr_value; - - } elsif ( $value_fmt == LINE_VALUE_HASH_KEYS ) { - $formatted_value = join " ", sort keys %$attr_value; - - } elsif ( ($value_fmt == LINE_VALUE_AS_IS) || ($value_fmt == LINE_VALUE_STRING_HASH) ) { - $formatted_value = $attr_value; - - } else { - *$self->{LOG}->error("$function_name: invalid value format ($value_fmt) (internal error)") - } - - # Quote value if necessary - if ( ($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR) ) { - if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\g1$/)) || - ($value_fmt == LINE_VALUE_BOOLEAN) || - ($formatted_value eq '') ) { - *$self->{LOG}->debug(2,"$function_name: quoting value '$formatted_value'"); - $formatted_value = '"' . $formatted_value . '"'; + unless (defined($line_fmt)) { + *$self->{LOG}->error("$function_name: 'list_fmt' argument missing (internal error)"); + return 1; + } + unless (defined($value_fmt)) { + *$self->{LOG}->error("$function_name: 'value_fmt' argument missing (internal error)"); + return 1; } - } - - *$self->{LOG}->debug(2,"$function_name: formatted value >>>$formatted_value<<<"); - return $formatted_value; + unless (defined($value_opt)) { + *$self->{LOG}->error("$function_name: 'value_opt' argument missing (internal error)"); + return 1; + } + + *$self->{LOG}->debug(2, + "$function_name: formatting attribute value >>>$attr_value<<< (line fmt=$line_fmt, value fmt=$value_fmt, value_opt=$value_opt)" + ); + + my $formatted_value; + if ($value_fmt == LINE_VALUE_BOOLEAN) { + $formatted_value = $attr_value ? 'yes' : 'no'; + + } elsif ($value_fmt == LINE_VALUE_INSTANCE_PARAMS) { + $formatted_value = ''; # Don't return undef if no matching attributes is found + # Instance parameters are described in a nlist + $formatted_value .= " -l $attr_value->{logFile}" if $attr_value->{logFile}; + $formatted_value .= " -c $attr_value->{configFile}" if $attr_value->{configFile}; + $formatted_value .= " -k $attr_value->{logKeep}" if $attr_value->{logKeep}; + + } elsif ($value_fmt == LINE_VALUE_ARRAY) { + *$self->{LOG}->debug(2, "$function_name: array values received: ", join(",", @$attr_value)); + if ($value_opt & LINE_VALUE_OPT_UNIQUE) { + my %values = map(($_ => 1), @$attr_value); + $attr_value = [keys(%values)]; + *$self->{LOG}->debug(2, "$function_name: array values made unique: ", join(",", @$attr_value)); + } + # LINE_VALUE_OPT_UNIQUE implies LINE_VALUE_OPT_SORTED + if ($value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED)) { + $attr_value = [sort(@$attr_value)] if $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED); + *$self->{LOG}->debug(2, "$function_name: array values sorted: ", join(",", @$attr_value)); + } + $formatted_value = join " ", @$attr_value; + + } elsif ($value_fmt == LINE_VALUE_HASH_KEYS) { + $formatted_value = join " ", sort keys %$attr_value; + + } elsif (($value_fmt == LINE_VALUE_AS_IS) || ($value_fmt == LINE_VALUE_STRING_HASH)) { + $formatted_value = $attr_value; + + } else { + *$self->{LOG}->error("$function_name: invalid value format ($value_fmt) (internal error)"); + } + + # Quote value if necessary + if (($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR)) { + if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\g1$/)) + || ($value_fmt == LINE_VALUE_BOOLEAN) + || ($formatted_value eq '')) + { + *$self->{LOG}->debug(2, "$function_name: quoting value '$formatted_value'"); + $formatted_value = '"' . $formatted_value . '"'; + } + } + + *$self->{LOG}->debug(2, "$function_name: formatted value >>>$formatted_value<<<"); + return $formatted_value; } @@ -457,46 +469,47 @@ Arguments : =cut -sub _formatConfigLine { - my $function_name = "_formatConfigLine"; - my ($self, $keyword, $value, $line_fmt) = @_; - - unless ( $keyword ) { - *$self->{LOG}->error("$function_name: 'keyword' argument missing (internal error)"); - return 1; - } - unless ( defined($value) ) { - *$self->{LOG}->error("$function_name: 'value' argument missing (internal error)"); - return 1; - } - unless ( defined($line_fmt) ) { - *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); - return 1; - } - - my $config_line = ""; - - if ( $line_fmt == LINE_FORMAT_SH_VAR ) { - $config_line = "$keyword=$value"; - } elsif ( $line_fmt == LINE_FORMAT_ENV_VAR ) { - $config_line = "export $keyword=$value"; - } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SETENV ) { - $config_line = "setenv $keyword = $value"; - } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SET ) { - $config_line = "set $keyword = $value"; - } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL ) { - $config_line = $keyword; - $config_line .= " $value" if $value; - # In trust (shift.conf) format, there should be only one blank between - # tokens and no trailing spaces. - $config_line =~ s/\s\s+/ /g; - $config_line =~ s/\s+$//; - } else { - *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); - } - - *$self->{LOG}->debug(2,"$function_name: Configuration line : >>$config_line<<"); - return $config_line; +sub _formatConfigLine +{ + my $function_name = "_formatConfigLine"; + my ($self, $keyword, $value, $line_fmt) = @_; + + unless ($keyword) { + *$self->{LOG}->error("$function_name: 'keyword' argument missing (internal error)"); + return 1; + } + unless (defined($value)) { + *$self->{LOG}->error("$function_name: 'value' argument missing (internal error)"); + return 1; + } + unless (defined($line_fmt)) { + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); + return 1; + } + + my $config_line = ""; + + if ($line_fmt == LINE_FORMAT_SH_VAR) { + $config_line = "$keyword=$value"; + } elsif ($line_fmt == LINE_FORMAT_ENV_VAR) { + $config_line = "export $keyword=$value"; + } elsif ($line_fmt == LINE_FORMAT_KEY_VAL_SETENV) { + $config_line = "setenv $keyword = $value"; + } elsif ($line_fmt == LINE_FORMAT_KEY_VAL_SET) { + $config_line = "set $keyword = $value"; + } elsif ($line_fmt == LINE_FORMAT_KEY_VAL) { + $config_line = $keyword; + $config_line .= " $value" if $value; + # In trust (shift.conf) format, there should be only one blank between + # tokens and no trailing spaces. + $config_line =~ s/\s\s+/ /g; + $config_line =~ s/\s+$//; + } else { + *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); + } + + *$self->{LOG}->debug(2, "$function_name: Configuration line : >>$config_line<<"); + return $config_line; } @@ -519,55 +532,56 @@ Arguments : =cut -sub _buildLinePattern { - my $function_name = "_buildLinePattern"; - my ($self, $config_param, $line_fmt, $config_value) = @_; - - unless ( $config_param ) { - *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); - return undef; - } - unless ( defined($line_fmt) ) { - *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); - return undef; - } - if ( defined($config_value ) ) { - *$self->{LOG}->debug(2,"$function_name: configuration value '$config_value' will be added to the pattern"); - $config_value =~ s/\\/\\\\/g; - $config_value =~ s/([\-\+\?\.\*\[\]()\^\$])/\\$1/g; - $config_value =~ s/\s+/\\s+/g; - } else { - $config_value = ""; - } - - # config_param is generally a keyword and in this case it contains no whitespace. - # A special case is when config_param (the rule keyword) is used to match a line - # without specifying a rule: in this case it may contains whitespaces. Remove strict - # matching of them (match any type/number of whitespaces at the same position). - # Look at %trust_config_rules in ncm-dpmlfc Perl module for an example. - $config_param =~ s/\s+/\\s+/g; - - my $config_param_pattern; - if ( $line_fmt == LINE_FORMAT_SH_VAR ) { - $config_param_pattern = "#?\\s*$config_param=".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_ENV_VAR ) { - $config_param_pattern = "#?\\s*export $config_param=".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SETENV ) { - $config_param_pattern = "#?\\s*setenv\\s+$config_param\\s*=\\s*".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL_SET ) { - $config_param_pattern = "#?\\s*set\\s+$config_param\\s*=\\s*".$config_value; - } elsif ( $line_fmt == LINE_FORMAT_KEY_VAL ) { - $config_param_pattern = "#?\\s*$config_param"; - # Avoid adding a whitespace requirement if there is no config_value - if ( $config_value ne "" ) { - $config_param_pattern .= "\\s+" . $config_value; +sub _buildLinePattern +{ + my $function_name = "_buildLinePattern"; + my ($self, $config_param, $line_fmt, $config_value) = @_; + + unless ($config_param) { + *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); + return undef; + } + unless (defined($line_fmt)) { + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); + return undef; + } + if (defined($config_value)) { + *$self->{LOG}->debug(2, "$function_name: configuration value '$config_value' will be added to the pattern"); + $config_value =~ s/\\/\\\\/g; + $config_value =~ s/([\-\+\?\.\*\[\]()\^\$])/\\$1/g; + $config_value =~ s/\s+/\\s+/g; + } else { + $config_value = ""; + } + + # config_param is generally a keyword and in this case it contains no whitespace. + # A special case is when config_param (the rule keyword) is used to match a line + # without specifying a rule: in this case it may contains whitespaces. Remove strict + # matching of them (match any type/number of whitespaces at the same position). + # Look at %trust_config_rules in ncm-dpmlfc Perl module for an example. + $config_param =~ s/\s+/\\s+/g; + + my $config_param_pattern; + if ($line_fmt == LINE_FORMAT_SH_VAR) { + $config_param_pattern = "#?\\s*$config_param=" . $config_value; + } elsif ($line_fmt == LINE_FORMAT_ENV_VAR) { + $config_param_pattern = "#?\\s*export $config_param=" . $config_value; + } elsif ($line_fmt == LINE_FORMAT_KEY_VAL_SETENV) { + $config_param_pattern = "#?\\s*setenv\\s+$config_param\\s*=\\s*" . $config_value; + } elsif ($line_fmt == LINE_FORMAT_KEY_VAL_SET) { + $config_param_pattern = "#?\\s*set\\s+$config_param\\s*=\\s*" . $config_value; + } elsif ($line_fmt == LINE_FORMAT_KEY_VAL) { + $config_param_pattern = "#?\\s*$config_param"; + # Avoid adding a whitespace requirement if there is no config_value + if ($config_value ne "") { + $config_param_pattern .= "\\s+" . $config_value; + } + } else { + *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); + return undef; } - } else { - *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); - return undef; - } - return $config_param_pattern + return $config_param_pattern; } @@ -584,46 +598,47 @@ Arguments : =cut -sub _removeConfigLine { - my $function_name = "_removeConfigLine"; - my ($self, $config_param, $line_fmt) = @_; - - unless ( $config_param ) { - *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); - return 1; - } - unless ( defined($line_fmt) ) { - *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); - return 1; - } - - # Build a pattern to look for. - my $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt); - - *$self->{LOG}->debug(1,"$function_name: commenting out lines matching pattern >>>".$config_param_pattern."<<<"); - # All matching lines must be commented out, except if they are already commented out. - # The code used is a customized version of FileEditor::replace() that lacks support for backreferences - # in the replacement value (here we want to rewrite the same line commented out but we don't know the - # current line contents, only a regexp matching it). - my @lns; - my $line_count = 0; - $self->seek_begin(); - while (my $l = <$self>) { - if ($l =~ qr/^$config_param_pattern/ && $l !~ qr/^\s*#/) { - *$self->{LOG}->debug(2,"$function_name: commenting out matching line >>>".$l."<<<"); - $line_count++; - push (@lns, '#'.$l); +sub _removeConfigLine +{ + my $function_name = "_removeConfigLine"; + my ($self, $config_param, $line_fmt) = @_; + + unless ($config_param) { + *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); + return 1; + } + unless (defined($line_fmt)) { + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); + return 1; + } + + # Build a pattern to look for. + my $config_param_pattern = $self->_buildLinePattern($config_param, $line_fmt); + + *$self->{LOG}->debug(1, "$function_name: commenting out lines matching pattern >>>" . $config_param_pattern . "<<<"); + # All matching lines must be commented out, except if they are already commented out. + # The code used is a customized version of FileEditor::replace() that lacks support for backreferences + # in the replacement value (here we want to rewrite the same line commented out but we don't know the + # current line contents, only a regexp matching it). + my @lns; + my $line_count = 0; + $self->seek_begin(); + while (my $l = <$self>) { + if ($l =~ qr/^$config_param_pattern/ && $l !~ qr/^\s*#/) { + *$self->{LOG}->debug(2, "$function_name: commenting out matching line >>>" . $l . "<<<"); + $line_count++; + push(@lns, '#' . $l); + } else { + push(@lns, $l); + } + } + if ($line_count == 0) { + *$self->{LOG}->debug(1, "$function_name: No line found matching the pattern"); } else { - push (@lns, $l); + *$self->{LOG}->debug(1, "$function_name: $line_count lines commented out"); } - } - if ( $line_count == 0 ) { - *$self->{LOG}->debug(1, "$function_name: No line found matching the pattern"); - } else { - *$self->{LOG}->debug(1, "$function_name: $line_count lines commented out"); - } - $self->set_contents (join("", @lns)); - + $self->set_contents(join("", @lns)); + } @@ -642,53 +657,58 @@ Arguments : =cut -sub _updateConfigLine { - my $function_name = "_updateConfigLine"; - my ($self, $config_param, $config_value, $line_fmt, $multiple) = @_; - - unless ( $config_param ) { - *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); - return 1; - } - unless ( defined($config_value) ) { - *$self->{LOG}->error("$function_name: 'config_value' argument missing (internal error)"); - return 1; - } - unless ( defined($line_fmt) ) { - *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); - return 1; - } - unless ( defined($multiple) ) { - $multiple = 0; - } - - my $config_param_pattern; - my $new_line = $self->_formatConfigLine($config_param,$config_value,$line_fmt); - - # Build a pattern to look for. - if ( $multiple ) { - *$self->{LOG}->debug(2,"$function_name: 'multiple' flag enabled"); - $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt,$config_value); - } else { - $config_param_pattern = $self->_buildLinePattern($config_param,$line_fmt); - if ( ($line_fmt == LINE_FORMAT_KEY_VAL) && $config_value ) { - $config_param_pattern .= "\\s+"; # If the value is defined in these formats, impose a whitespace at the end +sub _updateConfigLine +{ + my $function_name = "_updateConfigLine"; + my ($self, $config_param, $config_value, $line_fmt, $multiple) = @_; + + unless ($config_param) { + *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); + return 1; + } + unless (defined($config_value)) { + *$self->{LOG}->error("$function_name: 'config_value' argument missing (internal error)"); + return 1; + } + unless (defined($line_fmt)) { + *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); + return 1; + } + unless (defined($multiple)) { + $multiple = 0; + } + + my $config_param_pattern; + my $new_line = $self->_formatConfigLine($config_param, $config_value, $line_fmt); + + # Build a pattern to look for. + if ($multiple) { + *$self->{LOG}->debug(2, "$function_name: 'multiple' flag enabled"); + $config_param_pattern = $self->_buildLinePattern($config_param, $line_fmt, $config_value); + } else { + $config_param_pattern = $self->_buildLinePattern($config_param, $line_fmt); + if (($line_fmt == LINE_FORMAT_KEY_VAL) && $config_value) { + $config_param_pattern .= "\\s+"; # If the value is defined in these formats, impose a whitespace at the end + } } - } - # Update the matching configuration lines - if ( $new_line ) { - my $comment = ""; - if ( ($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR) ) { - $comment = $LINE_QUATTOR_COMMENT; + # Update the matching configuration lines + if ($new_line) { + my $comment = ""; + if (($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR)) { + $comment = $LINE_QUATTOR_COMMENT; + } + *$self->{LOG}->debug(1, + "$function_name: checking expected configuration line ($new_line) with pattern >>>" + . $config_param_pattern + . "<<<"); + $self->add_or_replace_lines( + qr/^\s*$config_param_pattern/, + qr/^\s*$new_line$/, + $new_line . $comment . "\n", + ENDING_OF_FILE, + ); } - *$self->{LOG}->debug(1,"$function_name: checking expected configuration line ($new_line) with pattern >>>".$config_param_pattern."<<<"); - $self->add_or_replace_lines(qr/^\s*$config_param_pattern/, - qr/^\s*$new_line$/, - $new_line.$comment."\n", - ENDING_OF_FILE, - ); - } } @@ -717,107 +737,108 @@ Return value: undef if the rule condition is not met or a hash with the followin =cut -sub _parse_rule { - my $function_name = "_parse_rule"; - my ($self, $rule, $config_options, $parser_options) = @_; - my %rule_info; +sub _parse_rule +{ + my $function_name = "_parse_rule"; + my ($self, $rule, $config_options, $parser_options) = @_; + my %rule_info; - unless ( $rule ) { - *$self->{LOG}->error("$function_name: 'rule' argument missing (internal error)"); - $rule_info{error_msg} = "rule parser internal error (missing argument)"; - return \%rule_info; - } - unless ( $config_options ) { - *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); - $rule_info{error_msg} = "rule parser internal error (missing argument)"; - return \%rule_info; - } - unless ( defined($parser_options) ) { - *$self->{LOG}->debug(2,"$function_name: 'parser_options' undefined"); - $parser_options = {}; - } - if ( defined($parser_options->{always_rules_only}) ) { - *$self->{LOG}->debug(1,"$function_name: 'always_rules_only' option set to ".$parser_options->{always_rules_only}); - } else { - *$self->{LOG}->debug(1,"$function_name: 'always_rules_only' option not defined: assuming $LINE_OPT_DEF_ALWAYS_RULES_ONLY"); - $parser_options->{always_rules_only} = $LINE_OPT_DEF_ALWAYS_RULES_ONLY; - } - - (my $condition, my $tmp) = split /->/, $rule; - if ( $tmp ) { - $rule = $tmp; - } else { - $condition = ""; - } - *$self->{LOG}->debug(1,"$function_name: condition=>>>$condition<<<, rule=>>>$rule<<<"); - - # Check if only rules with ALWAYS condition must be applied. - # ALWAYS is a special condition that is used to flag the only rules that - # must be applied if the option always_rules_only is set. When this option - # is not set, this condition has no effect and is just reset to an empty conditions. - if ( $parser_options->{always_rules_only} ) { - if ( $condition ne $RULE_CONDITION_ALWAYS ) { - *$self->{LOG}->debug(1,"$function_name: rule ignored ($RULE_CONDITION_ALWAYS condition not set)"); - return; + unless ($rule) { + *$self->{LOG}->error("$function_name: 'rule' argument missing (internal error)"); + $rule_info{error_msg} = "rule parser internal error (missing argument)"; + return \%rule_info; } - } - if ( $condition eq $RULE_CONDITION_ALWAYS ) { - $condition = ''; - } - - # Check if rule condition is met if one is defined - if ( $condition ne "" ) { - *$self->{LOG}->debug(1,"$function_name: checking condition >>>$condition<<<"); - - # Condition may be negated if it starts with a !: remove it from the condition value. - # If the condition is negated, when the condition is true the rule must not be applied. - my $negate = 0; - if ( $condition =~ /^!/ ) { - $negate = 1; - $condition =~ s/^!//; + unless ($config_options) { + *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); + $rule_info{error_msg} = "rule parser internal error (missing argument)"; + return \%rule_info; } - my ($cond_attribute,$cond_option_set) = split /:/, $condition; - unless ( $cond_option_set ) { - $cond_option_set = $cond_attribute; - $cond_attribute = ""; + unless (defined($parser_options)) { + *$self->{LOG}->debug(2, "$function_name: 'parser_options' undefined"); + $parser_options = {}; } - *$self->{LOG}->debug(2,"$function_name: condition option set = '$cond_option_set', ". - "condition attribute = '$cond_attribute', negate=$negate"); - my $cond_satisfied = 1; # Assume condition is satisfied - if ( $cond_attribute ) { - # Due to Perl autovivification, testing directly exists($config_options->{$cond_option_set}->{$cond_attribute}) will spring - # $config_options->{$cond_option_set} into existence if it doesn't exist. - my $cond_true = $config_options->{$cond_option_set} && - exists($config_options->{$cond_option_set}->{$cond_attribute}); - if ( $negate ) { - $cond_satisfied = 0 if $cond_true; - } else { - $cond_satisfied = 0 unless $cond_true; - } - } elsif ( $cond_option_set ) { - if ( $negate ) { - $cond_satisfied = 0 if exists($config_options->{$cond_option_set}); - } else { - $cond_satisfied = 0 unless exists($config_options->{$cond_option_set}); - } + if (defined($parser_options->{always_rules_only})) { + *$self->{LOG}->debug(1, "$function_name: 'always_rules_only' option set to " . $parser_options->{always_rules_only}); + } else { + *$self->{LOG}->debug(1, "$function_name: 'always_rules_only' option not defined: assuming $LINE_OPT_DEF_ALWAYS_RULES_ONLY"); + $parser_options->{always_rules_only} = $LINE_OPT_DEF_ALWAYS_RULES_ONLY; } - if ( !$cond_satisfied ) { - # When the condition is not satisfied and if option remove_if_undef is set, - # remove configuration line (if present). - *$self->{LOG}->debug(1,"$function_name: condition not satisfied, flag set to remove matching configuration lines"); - $rule_info{remove_matching_lines} = 1; - return \%rule_info; + + (my $condition, my $tmp) = split /->/, $rule; + if ($tmp) { + $rule = $tmp; + } else { + $condition = ""; + } + *$self->{LOG}->debug(1, "$function_name: condition=>>>$condition<<<, rule=>>>$rule<<<"); + + # Check if only rules with ALWAYS condition must be applied. + # ALWAYS is a special condition that is used to flag the only rules that + # must be applied if the option always_rules_only is set. When this option + # is not set, this condition has no effect and is just reset to an empty conditions. + if ($parser_options->{always_rules_only}) { + if ($condition ne $RULE_CONDITION_ALWAYS) { + *$self->{LOG}->debug(1, "$function_name: rule ignored ($RULE_CONDITION_ALWAYS condition not set)"); + return; + } + } + if ($condition eq $RULE_CONDITION_ALWAYS) { + $condition = ''; + } + + # Check if rule condition is met if one is defined + if ($condition ne "") { + *$self->{LOG}->debug(1, "$function_name: checking condition >>>$condition<<<"); + + # Condition may be negated if it starts with a !: remove it from the condition value. + # If the condition is negated, when the condition is true the rule must not be applied. + my $negate = 0; + if ($condition =~ /^!/) { + $negate = 1; + $condition =~ s/^!//; + } + my ($cond_attribute, $cond_option_set) = split /:/, $condition; + unless ($cond_option_set) { + $cond_option_set = $cond_attribute; + $cond_attribute = ""; + } + *$self->{LOG}->debug(2, "$function_name: condition option set = '$cond_option_set', " + . "condition attribute = '$cond_attribute', negate=$negate"); + my $cond_satisfied = 1; # Assume condition is satisfied + if ($cond_attribute) { + # Due to Perl autovivification, testing directly exists($config_options->{$cond_option_set}->{$cond_attribute}) will spring + # $config_options->{$cond_option_set} into existence if it doesn't exist. + my $cond_true = $config_options->{$cond_option_set} + && exists($config_options->{$cond_option_set}->{$cond_attribute}); + if ($negate) { + $cond_satisfied = 0 if $cond_true; + } else { + $cond_satisfied = 0 unless $cond_true; + } + } elsif ($cond_option_set) { + if ($negate) { + $cond_satisfied = 0 if exists($config_options->{$cond_option_set}); + } else { + $cond_satisfied = 0 unless exists($config_options->{$cond_option_set}); + } + } + if (!$cond_satisfied) { + # When the condition is not satisfied and if option remove_if_undef is set, + # remove configuration line (if present). + *$self->{LOG}->debug(1, "$function_name: condition not satisfied, flag set to remove matching configuration lines"); + $rule_info{remove_matching_lines} = 1; + return \%rule_info; + } } - } - my @option_sets; - ($rule_info{attribute}, my $option_sets_str) = split /:/, $rule; - if ( $option_sets_str ) { - @option_sets = split /\s*,\s*/, $option_sets_str; - } - $rule_info{option_sets} = \@option_sets; + my @option_sets; + ($rule_info{attribute}, my $option_sets_str) = split /:/, $rule; + if ($option_sets_str) { + @option_sets = split /\s*,\s*/, $option_sets_str; + } + $rule_info{option_sets} = \@option_sets; - return \%rule_info; + return \%rule_info; } @@ -838,252 +859,284 @@ Supported entries for options hash: =cut -sub _apply_rules { - my $function_name = "_apply_rules"; - my ($self, $config_rules, $config_options, $parser_options) = @_; - - unless ( $config_rules ) { - *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); - return 1; - } - unless ( $config_options ) { - *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); - return 1; - } - unless ( defined($parser_options) ) { - *$self->{LOG}->debug(2,"$function_name: 'parser_options' undefined"); - $parser_options = {}; - } - if ( defined($parser_options->{remove_if_undef}) ) { - *$self->{LOG}->debug(1,"$function_name: 'remove_if_undef' option set to ".$parser_options->{remove_if_undef}); - } else { - *$self->{LOG}->debug(1,"$function_name: 'remove_if_undef' option not defined: assuming $LINE_OPT_DEF_REMOVE_IF_UNDEF"); - $parser_options->{remove_if_undef} = $LINE_OPT_DEF_REMOVE_IF_UNDEF; - } - - - # Loop over all config rule entries. - # Config rules are stored in a hash whose key is the variable to write - # and whose value is the rule itself. - # If the variable name start with a '-', this means that the matching configuration - # line must be commented out unconditionally. - # Each rule format is '[condition->]attribute:option_set[,option_set,...];line_fmt' where - # condition: either a role that must be enabled or ALWAYS if the rule must be applied - # when 'always_rules_only' is true. A role is enabled if 'role_enabled' is - # true in the corresponding option set. - # option_set and attribute: attribute in option set that must be substituted - # line_fmt: the format to use when building the line - # An empty rule is valid and means that the keyword part must be - # written as is, using the line_fmt specified. - - my $rule_id = 0; - foreach my $keyword (sort keys %$config_rules) { - my $rule = $config_rules->{$keyword}; - $rule = '' unless defined($rule); - $rule_id++; - - # Initialize parser_options for this rule according the default for this file - my $rule_parsing_options = { %{$parser_options} }; - - # Check if the keyword is prefixed by: - # - a '-': in this case the corresponding line must be unconditionally - # commented out if it is present - # - a '*': in this case the corresponding line must be commented out if - # it is present and the option is undefined - my $comment_line = 0; - if ( $keyword =~ /^-/ ) { - $keyword =~ s/^-//; - $comment_line = 1; - } elsif ( $keyword =~ /^\?/ ) { - $keyword =~ s/^\?//; - $rule_parsing_options->{remove_if_undef} = 1; - *$self->{LOG}->debug(2,"$function_name: 'remove_if_undef' option set for the current rule"); - } +sub _apply_rules +{ + my $function_name = "_apply_rules"; + my ($self, $config_rules, $config_options, $parser_options) = @_; - # Split different elements of the rule - ($rule, my $line_fmt, my $value_fmt) = split /;/, $rule; - unless ( $line_fmt ) { - $line_fmt = $LINE_FORMAT_DEFAULT; + unless ($config_rules) { + *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); + return 1; } - my $value_opt; - if ( $value_fmt ) { - ($value_fmt, $value_opt) = split /:/, $value_fmt; - }else { - $value_fmt = LINE_VALUE_AS_IS; + unless ($config_options) { + *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); + return 1; } - unless ( defined($value_opt) ) { - # $value_opt is a bitmask. Set to 0 if not specified. - $value_opt = 0; + unless (defined($parser_options)) { + *$self->{LOG}->debug(2, "$function_name: 'parser_options' undefined"); + $parser_options = {}; } - - - # If the keyword was "negated", remove (comment out) configuration line if present and enabled - if ( $comment_line ) { - *$self->{LOG}->debug(1,"$function_name: keyword '$keyword' negated, removing configuration line"); - $self->_removeConfigLine($keyword,$line_fmt); - next; + if (defined($parser_options->{remove_if_undef})) { + *$self->{LOG}->debug(1, "$function_name: 'remove_if_undef' option set to " . $parser_options->{remove_if_undef}); + } else { + *$self->{LOG}->debug(1, "$function_name: 'remove_if_undef' option not defined: assuming $LINE_OPT_DEF_REMOVE_IF_UNDEF"); + $parser_options->{remove_if_undef} = $LINE_OPT_DEF_REMOVE_IF_UNDEF; } - # Parse rule if it is non empty - my $rule_info; - if ( $rule ne '' ) { - *$self->{LOG}->debug(1,"$function_name: processing rule $rule_id (variable=>>>$keyword<<<, rule=>>>$rule<<<, fmt=$line_fmt)"); - $rule_info = $self->_parse_rule($rule,$config_options,$rule_parsing_options); - next unless $rule_info; - *$self->{LOG}->debug(2,"$function_name: information returned by rule parser: ".join(" ",sort(keys(%$rule_info)))); - - if ( exists($rule_info->{error_msg}) ) { - *$self->{LOG}->error("Error parsing rule >>>$rule<<<: ".$rule_info->{error_msg}); - # FIXME: decide whether an invalid rule is just ignored or causes any modification to be prevented. - # $self->cancel() - next; - } elsif ( $rule_info->{remove_matching_lines} ) { - if ( $rule_parsing_options->{remove_if_undef} ) { - *$self->{LOG}->debug(1,"$function_name: removing configuration lines for keyword '$keyword'"); - $self->_removeConfigLine($keyword,$line_fmt); - } else { - *$self->{LOG}->debug(1,"$function_name: remove_if_undef not set, ignoring line to remove"); + # Loop over all config rule entries. + # Config rules are stored in a hash whose key is the variable to write + # and whose value is the rule itself. + # If the variable name start with a '-', this means that the matching configuration + # line must be commented out unconditionally. + # Each rule format is '[condition->]attribute:option_set[,option_set,...];line_fmt' where + # condition: either a role that must be enabled or ALWAYS if the rule must be applied + # when 'always_rules_only' is true. A role is enabled if 'role_enabled' is + # true in the corresponding option set. + # option_set and attribute: attribute in option set that must be substituted + # line_fmt: the format to use when building the line + # An empty rule is valid and means that the keyword part must be + # written as is, using the line_fmt specified. + + my $rule_id = 0; + foreach my $keyword (sort keys %$config_rules) { + my $rule = $config_rules->{$keyword}; + $rule = '' unless defined($rule); + $rule_id++; + + # Initialize parser_options for this rule according the default for this file + my $rule_parsing_options = {%{$parser_options}}; + + # Check if the keyword is prefixed by: + # - a '-': in this case the corresponding line must be unconditionally + # commented out if it is present + # - a '*': in this case the corresponding line must be commented out if + # it is present and the option is undefined + my $comment_line = 0; + if ($keyword =~ /^-/) { + $keyword =~ s/^-//; + $comment_line = 1; + } elsif ($keyword =~ /^\?/) { + $keyword =~ s/^\?//; + $rule_parsing_options->{remove_if_undef} = 1; + *$self->{LOG}->debug(2, "$function_name: 'remove_if_undef' option set for the current rule"); } - next; - } - } - # Build the value to be substitued for each option set specified. - # option_set=GLOBAL is a special case indicating a global option instead of an - # attribute in a specific option set. - my $config_value = ""; - my $attribute_present = 1; - my $config_updated = 0; - my @array_values; - if ( $rule_info->{attribute} ) { - foreach my $option_set (@{$rule_info->{option_sets}}) { - my $attr_value; - *$self->{LOG}->debug(1,"$function_name: retrieving '".$rule_info->{attribute}."' value in option set $option_set"); - if ( $option_set eq $RULE_OPTION_SET_GLOBAL ) { - if ( exists($config_options->{$rule_info->{attribute}}) ) { - $attr_value = $config_options->{$rule_info->{attribute}}; - } else { - *$self->{LOG}->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in global option set"); - $attribute_present = 0; - } + # Split different elements of the rule + ($rule, my $line_fmt, my $value_fmt) = split /;/, $rule; + unless ($line_fmt) { + $line_fmt = $LINE_FORMAT_DEFAULT; + } + my $value_opt; + if ($value_fmt) { + ($value_fmt, $value_opt) = split /:/, $value_fmt; } else { - # See comment above about Perl autovivification and impact on testing attribute existence - if ( $config_options->{$option_set} && exists($config_options->{$option_set}->{$rule_info->{attribute}}) ) { - $attr_value = $config_options->{$option_set}->{$rule_info->{attribute}}; - } else { - *$self->{LOG}->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' not found in option set '$option_set'"); - $attribute_present = 0; - } + $value_fmt = LINE_VALUE_AS_IS; + } + unless (defined($value_opt)) { + # $value_opt is a bitmask. Set to 0 if not specified. + $value_opt = 0; } - # If attribute is not defined in the present configuration, check if there is a matching - # line in the config file for the keyword and comment it out. This requires option - # remove_if_undef to be set. - # Note that this will never match instance parameters and will not remove entries - # no longer part of the configuration in a still existing LINE_VALUE_ARRAY or - # LINE_VALUE_STRING_HASH. - unless ( $attribute_present ) { - if ( $rule_parsing_options->{remove_if_undef} ) { - *$self->{LOG}->debug(1,"$function_name: attribute '".$rule_info->{attribute}."' undefined, removing configuration line"); - $self->_removeConfigLine($keyword,$line_fmt); - } - next; + + # If the keyword was "negated", remove (comment out) configuration line if present and enabled + if ($comment_line) { + *$self->{LOG}->debug(1, "$function_name: keyword '$keyword' negated, removing configuration line"); + $self->_removeConfigLine($keyword, $line_fmt); + next; } - - # Instance parameters are specific, as this is a nlist of instance - # with the value being a nlist of parameters for the instance. - # Also the variable name must be updated to contain the instance name. - # One configuration line must be written/updated for each instance. - if ( $value_fmt == LINE_VALUE_INSTANCE_PARAMS ) { - foreach my $instance (sort keys %{$attr_value}) { - my $params = $attr_value->{$instance}; - *$self->{LOG}->debug(1,"$function_name: formatting instance '$instance' parameters ($params)"); - $config_value = $self->_formatAttributeValue($params, - $line_fmt, - $value_fmt, - $value_opt, - ); - my $config_param = $keyword; - my $instance_uc = uc($instance); - $config_param =~ s/%%INSTANCE%%/$instance_uc/; - *$self->{LOG}->debug(2,"New variable name generated: >>>$config_param<<<"); - $self->_updateConfigLine($config_param,$config_value,$line_fmt); - } - $config_updated = 1; - } elsif ( $value_fmt == LINE_VALUE_STRING_HASH ) { - # With this value format, several lines with the same keyword are generated, - # one for each key/value pair. - foreach my $k (sort keys %$attr_value) { - my $v = $attr_value->{$k}; - # Value is made by joining key and value as a string - # Keys may be escaped if they contain characters like '/': unescaping a non-escaped - # string is generally harmless. - my $tmp = unescape($k)." $v"; - *$self->{LOG}->debug(1,"$function_name: formatting (string hash) attribute '".$rule_info->{attribute}."' value ($tmp, value_fmt=$value_fmt)"); - $config_value = $self->_formatAttributeValue($tmp, - $line_fmt, - $value_fmt, - $value_opt, - ); - $self->_updateConfigLine($keyword,$config_value,$line_fmt,1); - } - $config_updated = 1; - } elsif ( $value_fmt == LINE_VALUE_ARRAY ) { - # Arrays are not processed immediately. First, all the values from all the options sets - # are collected into one array that will be processed later according to LINE_VALUE_OPT_xxx - # options specified (if any). - @array_values = (@array_values, @$attr_value) - } else { - *$self->{LOG}->debug(1,"$function_name: formatting attribute '".$rule_info->{attribute}."' value ($attr_value, value_fmt=$value_fmt)"); - $config_value .= ' ' if $config_value; - $config_value .= $self->_formatAttributeValue($attr_value, - $line_fmt, - $value_fmt, - $value_opt, - ); - *$self->{LOG}->debug(2,"$function_name: adding attribute '".$rule_info->{attribute}."' from option set '".$option_set. - "' to value (config_value=".$config_value.")"); + + + # Parse rule if it is non empty + my $rule_info; + if ($rule ne '') { + *$self->{LOG} + ->debug(1, "$function_name: processing rule $rule_id (variable=>>>$keyword<<<, rule=>>>$rule<<<, fmt=$line_fmt)"); + $rule_info = $self->_parse_rule($rule, $config_options, $rule_parsing_options); + next unless $rule_info; + *$self->{LOG}->debug(2, "$function_name: information returned by rule parser: " . join(" ", sort(keys(%$rule_info)))); + + if (exists($rule_info->{error_msg})) { + *$self->{LOG}->error("Error parsing rule >>>$rule<<<: " . $rule_info->{error_msg}); + # FIXME: decide whether an invalid rule is just ignored or causes any modification to be prevented. + # $self->cancel() + next; + } elsif ($rule_info->{remove_matching_lines}) { + if ($rule_parsing_options->{remove_if_undef}) { + *$self->{LOG}->debug(1, "$function_name: removing configuration lines for keyword '$keyword'"); + $self->_removeConfigLine($keyword, $line_fmt); + } else { + *$self->{LOG}->debug(1, "$function_name: remove_if_undef not set, ignoring line to remove"); + } + next; + } } - } - } else { - # $rule_info->{attribute} empty means an empty rule : in this case,just write the configuration param. - *$self->{LOG}->debug(1,"$function_name: no attribute specified in rule '$rule'"); - } - # There is a delayed formatting of arrays after collecting all the values from all - # the option sets in the rule. Formatting is done taking into account the relevant - # LINE_VALUE_OPT_xxx specified (bitmask). - if ( $value_fmt == LINE_VALUE_ARRAY ) { - if ( $value_opt & LINE_VALUE_OPT_SINGLE ) { - # With this value format, several lines with the same keyword are generated, - # one for each array value (if value_opt is not LINE_VALUE_OPT_SINGLE, all - # the values are concatenated on one line). - *$self->{LOG}->debug(1,"$function_name: formatting (array) attribute '".$rule_info->{attribute}."as LINE_VALUE_OPT_SINGLE"); - foreach my $val (@array_values) { - $config_value = $self->_formatAttributeValue($val, + # Build the value to be substitued for each option set specified. + # option_set=GLOBAL is a special case indicating a global option instead of an + # attribute in a specific option set. + my $config_value = ""; + my $attribute_present = 1; + my $config_updated = 0; + my @array_values; + if ($rule_info->{attribute}) { + foreach my $option_set (@{$rule_info->{option_sets}}) { + my $attr_value; + *$self->{LOG} + ->debug(1, "$function_name: retrieving '" . $rule_info->{attribute} . "' value in option set $option_set"); + if ($option_set eq $RULE_OPTION_SET_GLOBAL) { + if (exists($config_options->{$rule_info->{attribute}})) { + $attr_value = $config_options->{$rule_info->{attribute}}; + } else { + *$self->{LOG} + ->debug(1, "$function_name: attribute '" . $rule_info->{attribute} . "' not found in global option set"); + $attribute_present = 0; + } + } else { + # See comment above about Perl autovivification and impact on testing attribute existence + if ($config_options->{$option_set} && exists($config_options->{$option_set}->{$rule_info->{attribute}})) { + $attr_value = $config_options->{$option_set}->{$rule_info->{attribute}}; + } else { + *$self->{LOG}->debug(1, + "$function_name: attribute '" + . $rule_info->{attribute} + . "' not found in option set '$option_set'"); + $attribute_present = 0; + } + } + + # If attribute is not defined in the present configuration, check if there is a matching + # line in the config file for the keyword and comment it out. This requires option + # remove_if_undef to be set. + # Note that this will never match instance parameters and will not remove entries + # no longer part of the configuration in a still existing LINE_VALUE_ARRAY or + # LINE_VALUE_STRING_HASH. + unless ($attribute_present) { + if ($rule_parsing_options->{remove_if_undef}) { + *$self->{LOG}->debug(1, + "$function_name: attribute '" + . $rule_info->{attribute} + . "' undefined, removing configuration line"); + $self->_removeConfigLine($keyword, $line_fmt); + } + next; + } + + # Instance parameters are specific, as this is a nlist of instance + # with the value being a nlist of parameters for the instance. + # Also the variable name must be updated to contain the instance name. + # One configuration line must be written/updated for each instance. + if ($value_fmt == LINE_VALUE_INSTANCE_PARAMS) { + foreach my $instance (sort keys %{$attr_value}) { + my $params = $attr_value->{$instance}; + *$self->{LOG}->debug(1, "$function_name: formatting instance '$instance' parameters ($params)"); + $config_value = + $self->_formatAttributeValue( + $params, $line_fmt, - LINE_VALUE_AS_IS, + $value_fmt, $value_opt, ); - $self->_updateConfigLine($keyword,$config_value,$line_fmt,1); - } - $config_updated = 1; - } else { - $config_value = $self->_formatAttributeValue(\@array_values, + my $config_param = $keyword; + my $instance_uc = uc($instance); + $config_param =~ s/%%INSTANCE%%/$instance_uc/; + *$self->{LOG}->debug(2, "New variable name generated: >>>$config_param<<<"); + $self->_updateConfigLine($config_param, $config_value, $line_fmt); + } + $config_updated = 1; + } elsif ($value_fmt == LINE_VALUE_STRING_HASH) { + # With this value format, several lines with the same keyword are generated, + # one for each key/value pair. + foreach my $k (sort keys %$attr_value) { + my $v = $attr_value->{$k}; + # Value is made by joining key and value as a string + # Keys may be escaped if they contain characters like '/': unescaping a non-escaped + # string is generally harmless. + my $tmp = unescape($k) . " $v"; + *$self->{LOG}->debug(1, + "$function_name: formatting (string hash) attribute '" + . $rule_info->{attribute} + . "' value ($tmp, value_fmt=$value_fmt)"); + $config_value = + $self->_formatAttributeValue( + $tmp, $line_fmt, $value_fmt, $value_opt, ); - } - } + $self->_updateConfigLine($keyword, $config_value, $line_fmt, 1); + } + $config_updated = 1; + } elsif ($value_fmt == LINE_VALUE_ARRAY) { + # Arrays are not processed immediately. First, all the values from all the options sets + # are collected into one array that will be processed later according to LINE_VALUE_OPT_xxx + # options specified (if any). + @array_values = (@array_values, @$attr_value); + } else { + *$self->{LOG}->debug(1, + "$function_name: formatting attribute '" + . $rule_info->{attribute} + . "' value ($attr_value, value_fmt=$value_fmt)"); + $config_value .= ' ' if $config_value; + $config_value .= $self->_formatAttributeValue( + $attr_value, + $line_fmt, + $value_fmt, + $value_opt, + ); + *$self->{LOG}->debug(2, + "$function_name: adding attribute '" + . $rule_info->{attribute} + . "' from option set '" + . $option_set + . "' to value (config_value=" + . $config_value + . ")"); + } + } + } else { + # $rule_info->{attribute} empty means an empty rule : in this case,just write the configuration param. + *$self->{LOG}->debug(1, "$function_name: no attribute specified in rule '$rule'"); + } + + # There is a delayed formatting of arrays after collecting all the values from all + # the option sets in the rule. Formatting is done taking into account the relevant + # LINE_VALUE_OPT_xxx specified (bitmask). + if ($value_fmt == LINE_VALUE_ARRAY) { + if ($value_opt & LINE_VALUE_OPT_SINGLE) { + # With this value format, several lines with the same keyword are generated, + # one for each array value (if value_opt is not LINE_VALUE_OPT_SINGLE, all + # the values are concatenated on one line). + *$self->{LOG}->debug(1, + "$function_name: formatting (array) attribute '" + . $rule_info->{attribute} + . "as LINE_VALUE_OPT_SINGLE"); + foreach my $val (@array_values) { + $config_value = $self->_formatAttributeValue( + $val, + $line_fmt, + LINE_VALUE_AS_IS, + $value_opt, + ); + $self->_updateConfigLine($keyword, $config_value, $line_fmt, 1); + } + $config_updated = 1; + } else { + $config_value = $self->_formatAttributeValue( + \@array_values, + $line_fmt, + $value_fmt, + $value_opt, + ); + } + } - # Instance parameters, string hashes have already been written - if ( !$config_updated && $attribute_present ) { - $self->_updateConfigLine($keyword,$config_value,$line_fmt); - } + # Instance parameters, string hashes have already been written + if (!$config_updated && $attribute_present) { + $self->_updateConfigLine($keyword, $config_value, $line_fmt); + } - } + } } @@ -1094,4 +1147,4 @@ sub _apply_rules { =cut -1; # Required for PERL modules +1; # Required for PERL modules From fc9e50ec691c93edca1703ae035b61c025a4163c Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Mon, 25 Apr 2016 09:19:11 +0200 Subject: [PATCH 13/22] RuleBasedEditor: updateFile() returns 1 on success (instead of 0) --- src/main/perl/RuleBasedEditor.pm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index 03dcaa08..ec576adf 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -313,7 +313,8 @@ Supported entries for options hash: remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) Return value - always 0 + sucess: 1 + argument error: undef =cut @@ -324,11 +325,11 @@ sub updateFile unless ($config_rules) { *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); - return 1; + return; } unless ($config_options) { *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); - return 1; + return; } unless (defined($parser_options)) { *$self->{LOG}->debug(2, "$function_name: 'parser_options' undefined"); @@ -353,7 +354,7 @@ sub updateFile $parser_options ); - return 0; + return 1; } From e3176781d39e8eae419f45c21c58832c5b532cc7 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Mon, 25 Apr 2016 11:59:32 +0200 Subject: [PATCH 14/22] FileEditor: remove unnecessary 'use' for modules in 'use parent' --- src/main/perl/FileEditor.pm | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/main/perl/FileEditor.pm b/src/main/perl/FileEditor.pm index 630ec6f7..9e3a6cba 100644 --- a/src/main/perl/FileEditor.pm +++ b/src/main/perl/FileEditor.pm @@ -7,9 +7,7 @@ package CAF::FileEditor; use strict; use warnings; -use CAF::FileWriter; use LC::File; -use Exporter; use Fcntl qw(:seek); use parent qw(CAF::FileWriter Exporter); From fb50d1d3efcba9d32451aec5044189183cb75cb7 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Mon, 25 Apr 2016 12:34:31 +0200 Subject: [PATCH 15/22] RuleBasedEditor: improve pod documentation - Addresses @stdwerid's second serie of comments in #151. - No code change --- src/main/perl/RuleBasedEditor.pm | 79 +++++++++++++++++--------------- 1 file changed, 41 insertions(+), 38 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index ec576adf..efd682db 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -8,81 +8,84 @@ =head1 DESCRIPTION This module implements a rule-based editor that is used to modify the content -of an existing file without taking care of the whole file. Each rule -driving the edition process is applied to all matching lines. The input for -updating the file is the Quattor configuration and conditions can be defined -based on the contents of this configuration. +of an existing file. Each rule driving the editing process is applied to all +lines wose "keyword" is matching the one specified in the rule. The input for +updating the file is a hash typically built from the Quattor configuration when +the rule-based editor is called from a configuration module. Conditions can be defined +based on the contents of this configuration. Lines in the configuration file +that don't match any rule are kept unmodified. This module is a subclass of the L: it extends the base methods of -the CAF FileEditor. In addition to the constructor it has only one public method. -The methods provided in this module can be used at the same time as the -base methods of the L. +the L. It has only one public method (it uses the L constructor). +The methods provided in this module can be combined with L +methods to edit a file. -Rules used to edit the file are defined as hashes: each entry defines a rule. +Rules used to edit the file are defined in a hash: each entry (key/value pair) defines a rule. Multiple rules can be applied to the same file: it is important that they are -orthogonal, else the result is unpredictable. The order used to apply rules is undefined. -The result of applying the rules with the same configuration is idempotent when starting -from the same initial file but sucessive edition of a file (with different configuration values) -may not necessarily be idempotent (in general they are). +orthogonal, else the result is unpredictable. The order used to apply rules is the alphabetical +order of keywords. Applying the rules to the same configuration always give the same result +but the changes are not necessarily idempotent (order in which successive edits occured +may matter, depending on the actual rules). The hash entry key represents the line keyword in configuration file and hash value is the parsing rule for the keyword value. Parsing rule format is : [condition->]option_name:option_set[,option_set,...];line_fmt[;value_fmt[:value_fmt_opt]] -If the line keyword (hash key) is starting with a '-', this means that the matching -configuration line must be removed/commented out (instead of added/updated) from the -configuration file if present. If it is starting with a '?', this means that the -matching line must be removed/commented out if the option is undefined. +If the line keyword (hash key) starts with a '-', the matching +configuration line will be removed/commented out (instead of added/updated) from the +configuration file if present. If it starts with a '?', the +matching line will be removed/commented out if the option is undefined. =over =item condition -an option or an option set that must exist for the rule to be applied. -Both option_set and option_name:option_set are accepted (see below). -Only one option set is allowed and only its existence, not its value is tested. -In addition, the condition may be negated (option or option_set must -not exist) by prepending it with '!'. +An option or an option set (see below) that must exist for the rule to be applied. +Both C and C are accepted. +One option set only is allowed and only its existence (not its value) is tested. +It is possible to negate the condition (option or option_set must not exist) +by prepending it with '!'. =item option_name -the name of an option that will be retrieved from the configuration. +The name of an option that will be retrieved from the configuration. An option is +a key in the option set hash. =item option_set -the name of an option set where the option is located in (for example 'dpnsHost:dpm' -means C option of 'dpm' option set. An option set is a sub-hash in the configuration -hash. C is a special value for 'option_set' indicating that the option is a global option, -instead of belonging to a specific option set (global options are at the top level of the option +The name of an option set where the option is located in (for example 'dpnsHost:dpm' +means C option of C option set). An option set is a sub-hash in the configuration +hash. C is a special value for C indicating that the option is a global option, +instead of belonging to a specific option set (global options are at the top level of the configuration hash). =item line_fmt -defines the format used to represent the key/value pair. 3 formats are +Defines the format used to represent the key/value pair. The following formats are supported (see LINE_FORMAT_xxx constants below): =over -=item +=item * -a SH shell environment variable definition (export key=val). +A SH shell environment variable definition (export key=val). -=item +=item * -a SH shell variable definition (key=val). +A SH shell variable definition (key=val). -=item +=item * -a 'keyword value' line, as used by Xrootd or Apache config files. +A 'keyword value' line, as used by Xrootd or Apache config files. -=item +=item * -a 'setenv keyword value' line, as used by Xrootd config files mainly. It can also be used in a CSH shell script. +A 'setenv keyword value' line, as used by Xrootd config files mainly. It can also be used in a CSH shell script. -=item +=item * -a 'set keyword value' line, as used by Xrootd config files mainly. It doesn't work in a CSH shell script (C<=> missing). +A 'set keyword value' line, as used by Xrootd config files mainly. It doesn't work in a CSH shell script (C<=> missing). =back @@ -885,7 +888,7 @@ sub _apply_rules } - # Loop over all config rule entries. + # Loop over all config rule entries, sorted by keyword alphabetical order. # Config rules are stored in a hash whose key is the variable to write # and whose value is the rule itself. # If the variable name start with a '-', this means that the matching configuration From 2478919143fb1ed0f5e74d71245586b09238e015 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Mon, 25 Apr 2016 20:26:45 +0200 Subject: [PATCH 16/22] RuleBasedEditor: cleanup in tests - Replace use of testapp by Test::Quattor::Object --- src/test/perl/rbe_build_line_pattern.t | 17 ++-------- src/test/perl/rbe_remove_variable.t | 24 ++++---------- src/test/perl/rbe_rule_parser.t | 43 +++++++++---------------- src/test/perl/rbe_value_format.t | 19 +++-------- src/test/perl/test-cafrulebasededitor.t | 11 ++----- 5 files changed, 32 insertions(+), 82 deletions(-) diff --git a/src/test/perl/rbe_build_line_pattern.t b/src/test/perl/rbe_build_line_pattern.t index 6f7161d0..b1878946 100644 --- a/src/test/perl/rbe_build_line_pattern.t +++ b/src/test/perl/rbe_build_line_pattern.t @@ -7,13 +7,13 @@ use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; -use testapp; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; use Test::More tests => 8; use Test::NoWarnings; use Test::Quattor; +use Test::Quattor::Object; use Carp qw(confess); Test::NoWarnings::clear_warnings(); @@ -29,23 +29,12 @@ Basic test for rule-based editor (line pattern build) Readonly my $FILENAME => '/my/file'; -our %opts = (); -our $path; -my ($log, $str); -my $this_app = testapp->new ($0, qw (--verbose)); +my $obj = Test::Quattor::Object->new(); $SIG{__DIE__} = \&confess; -*testapp::error = sub { - my $self = shift; - $self->{ERROR} = @_; -}; - -open ($log, ">", \$str); -$this_app->set_report_logfile ($log); - -my $fh = CAF::RuleBasedEditor->open($FILENAME, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($FILENAME, log => $obj); ok(defined($fh), $FILENAME." was opened"); diff --git a/src/test/perl/rbe_remove_variable.t b/src/test/perl/rbe_remove_variable.t index b57174a1..7e58897d 100644 --- a/src/test/perl/rbe_remove_variable.t +++ b/src/test/perl/rbe_remove_variable.t @@ -7,13 +7,13 @@ use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; -use testapp; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; use Test::More tests => 12; use Test::NoWarnings; use Test::Quattor; +use Test::Quattor::Object; use Carp qw(confess); Test::NoWarnings::clear_warnings(); @@ -154,20 +154,10 @@ set_caf_file_close_diff(1); our %opts = (); our $path; -my ($log, $str); -my $this_app = testapp->new ($0, qw (--verbose)); +my $obj = Test::Quattor::Object->new(); $SIG{__DIE__} = \&confess; -*testapp::error = sub { - my $self = shift; - $self->{ERROR} = @_; -}; - - -open ($log, ">", \$str); -$this_app->set_report_logfile ($log); - my $changes; my $fh; @@ -175,7 +165,7 @@ my $fh; # Test negated keywords my $dpm_options = {}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_1, $dpm_options, @@ -186,7 +176,7 @@ $fh->close(); # Test removal of a config line is config option is not defined $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_2, $dpm_options, @@ -197,7 +187,7 @@ $fh->close(); # Test removal of a config line is rule condition is not met $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_3, $dpm_options, @@ -209,7 +199,7 @@ $fh->close(); # when keyword is prefixed by ? $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_4, $dpm_options); @@ -220,7 +210,7 @@ $fh->close(); # Test removal of config lines appearing multiple times $dpm_options = {"dpm" => {"globusThreadModel" => "pthread"}}; set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%config_rules_1, $dpm_options, diff --git a/src/test/perl/rbe_rule_parser.t b/src/test/perl/rbe_rule_parser.t index eea3f459..7cc12688 100644 --- a/src/test/perl/rbe_rule_parser.t +++ b/src/test/perl/rbe_rule_parser.t @@ -7,13 +7,13 @@ use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; -use testapp; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; use Test::More tests => 30; use Test::NoWarnings; use Test::Quattor; +use Test::Quattor::Object; use Carp qw(confess); Test::NoWarnings::clear_warnings(); @@ -337,21 +337,10 @@ my $all_options = {%$dpm_options, %$dmlite_options}; $CAF::Object::NoAction = 1; set_caf_file_close_diff(1); -our %opts = (); -our $path; -my ($log, $str); -my $this_app = testapp->new ($0, qw (--verbose)); +my $obj = Test::Quattor::Object->new(); $SIG{__DIE__} = \&confess; -*testapp::error = sub { - my $self = shift; - $self->{ERROR} = @_; -}; - - -open ($log, ">", \$str); -$this_app->set_report_logfile ($log); my $changes; my $fh; @@ -361,7 +350,7 @@ set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); # Test simple variable substitution set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_1); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dpm_config_rules_1, $dpm_options); @@ -371,7 +360,7 @@ $fh->close(); # Test potentially ambiguous config (duplicated lines, similar keywords) set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_2); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dpm_config_rules_1, $dpm_options); @@ -381,7 +370,7 @@ $fh->close(); # Test array displayed as list set_file_contents($DPM_CONF_FILE,$DPM_INITIAL_CONF_3); -my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_CONF_FILE, log => $obj); ok(defined($fh), $DPM_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dpm_config_rules_2, $dpm_options); @@ -391,7 +380,7 @@ $fh->close(); # Test 'keyword value" format (a la Apache) set_file_contents($DMLITE_CONF_FILE,$DMLITE_INITIAL_CONF_1); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%dav_config_rules, $dmlite_options); @@ -402,7 +391,7 @@ $fh->close(); # Test rule conditions set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions, $all_options); @@ -410,7 +399,7 @@ is("$fh", $COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents (rule $fh->close(); set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_neg_conds, $all_options); @@ -418,7 +407,7 @@ is("$fh", $NEG_COND_TEST_EXPECTED_1, $DMLITE_CONF_FILE." has expected contents ( $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions, $all_options); @@ -426,7 +415,7 @@ is("$fh", $COND_TEST_INITIAL, $DMLITE_CONF_FILE." has expected contents (initial $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions_2, $all_options); @@ -436,7 +425,7 @@ $fh->close(); my %parser_options; $parser_options{remove_if_undef} = 1; set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_conditions, $all_options, @@ -445,7 +434,7 @@ is("$fh", $COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents (init $fh->close(); set_file_contents($DMLITE_CONF_FILE,$COND_TEST_INITIAL); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_with_neg_conds, $all_options, @@ -454,7 +443,7 @@ is("$fh", $NEG_COND_TEST_EXPECTED_2, $DMLITE_CONF_FILE." has expected contents ( $fh->close(); set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_always, $dmlite_options); @@ -463,7 +452,7 @@ $fh->close(); $parser_options{always_rules_only} = 1; set_file_contents($DMLITE_CONF_FILE,''); -my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DMLITE_CONF_FILE, log => $obj); ok(defined($fh), $DMLITE_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_always, $dmlite_options, @@ -474,7 +463,7 @@ $fh->close(); # Rule with only a keyword set_file_contents($DPM_SHIFT_CONF_FILE,''); -my $fh = CAF::RuleBasedEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_SHIFT_CONF_FILE, log => $obj); ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_no_rule, $dpm_options); @@ -484,7 +473,7 @@ $fh->close(); # Rule with multiple condition sets and multiple-word keyword set_file_contents($DPM_SHIFT_CONF_FILE,''); -my $fh = CAF::RuleBasedEditor->open($DPM_SHIFT_CONF_FILE, log => $this_app); +my $fh = CAF::RuleBasedEditor->open($DPM_SHIFT_CONF_FILE, log => $obj); ok(defined($fh), $DPM_SHIFT_CONF_FILE." was opened"); $changes = $fh->updateFile(\%rules_multi_cond_sets, $dpm_options); diff --git a/src/test/perl/rbe_value_format.t b/src/test/perl/rbe_value_format.t index 70f6b797..16c49d0f 100644 --- a/src/test/perl/rbe_value_format.t +++ b/src/test/perl/rbe_value_format.t @@ -7,13 +7,13 @@ use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; -use testapp; use CAF::RuleBasedEditor qw(:rule_constants); use Readonly; use CAF::Object; use Test::More tests => 20; use Test::NoWarnings; use Test::Quattor; +use Test::Quattor::Object; use Carp qw(confess); Test::NoWarnings::clear_warnings(); @@ -29,24 +29,13 @@ Basic test for rule-based editor (value formatting) Readonly my $FILENAME => '/my/file'; -our %opts = (); -our $path; -my ($log, $str); -my $this_app = testapp->new ($0, qw (--verbose)); +my $obj = Test::Quattor::Object->new(); $SIG{__DIE__} = \&confess; -*testapp::error = sub { - my $self = shift; - $self->{ERROR} = @_; -}; - - -open ($log, ">", \$str); -$this_app->set_report_logfile ($log); my $formatted_value; -my $rbe_fh = CAF::RuleBasedEditor->open($FILENAME, log => $this_app); +my $rbe_fh = CAF::RuleBasedEditor->open($FILENAME, log => $obj); ok(defined($rbe_fh), $FILENAME." was opened"); # LINE_VALUE_BOOLEAN @@ -151,7 +140,7 @@ Readonly my @TEST_ARRAY => ('confFile', 'logFile', 'unused', 'logKeep', 'logFile Readonly my $FORMATTED_ARRAY => 'confFile logFile unused logKeep logFile'; Readonly my $FORMATTED_ARRAY_SORTED => 'confFile logFile logFile logKeep unused'; Readonly my $FORMATTED_ARRAY_UNIQUE => 'confFile logFile logKeep unused'; -my $rbe_fh = CAF::RuleBasedEditor->open($FILENAME, log => $this_app); +my $rbe_fh = CAF::RuleBasedEditor->open($FILENAME, log => $obj); ok(defined($rbe_fh), $FILENAME." was opened"); $formatted_value = $rbe_fh->_formatAttributeValue(\@TEST_ARRAY, LINE_FORMAT_KEY_VAL, diff --git a/src/test/perl/test-cafrulebasededitor.t b/src/test/perl/test-cafrulebasededitor.t index 4e34424d..d4df6a41 100644 --- a/src/test/perl/test-cafrulebasededitor.t +++ b/src/test/perl/test-cafrulebasededitor.t @@ -3,9 +3,9 @@ use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/modules"; -use testapp; use CAF::RuleBasedEditor; use Test::More; +use Test::Quattor::Object; use Carp qw(confess); use File::Path; use File::Temp qw(tempfile); @@ -27,17 +27,10 @@ our $text = TEXT; our %opts = (); our $path; -my ($log, $str); -my $this_app = testapp->new ($0, qw (--verbose)); +my $obj = Test::Quattor::Object->new(); $SIG{__DIE__} = \&confess; -*testapp::error = sub { - my $self = shift; - $self->{ERROR} = @_; -}; - -open ($log, ">", \$str); my $fh = CAF::RuleBasedEditor->new ($filename); isa_ok ($fh, "CAF::RuleBasedEditor", "Correct class after new method"); isa_ok ($fh, "CAF::FileEditor", "Correct class inheritance after new method"); From 23469cb603514dd46079efb1e011e69e7da5ed04 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sun, 1 May 2016 22:45:33 +0200 Subject: [PATCH 17/22] RuleBasedEditor: address @ned21 comments in PR 151 - Document return value for all methods - Comments clarification - fix inappropriate return value for some methods (1 instead of undef) --- src/main/perl/RuleBasedEditor.pm | 47 +++++++++++++++++++++++--------- 1 file changed, 34 insertions(+), 13 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index efd682db..eefcbaa2 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -373,12 +373,16 @@ sub updateFile This function formats an attribute value based on the value format specified. -Arguments : +Arguments: attr_value : attribue value line_fmt : line format (see LINE_FORMAT_xxx constants) value_fmt : value format (see LINE_VALUE_xxx constants) value_opt : value interpretation/formatting options (bitmask, see LINE_VALUE_OPT_xxx constants) +Return value: + A string corresponding to the value formatted according to the format specified by arguments + or undef in case of an internal error (missing arguments) + =cut sub _formatAttributeValue @@ -388,19 +392,19 @@ sub _formatAttributeValue unless (defined($attr_value)) { *$self->{LOG}->error("$function_name: 'attr_value' argument missing (internal error)"); - return 1; + return undef; } unless (defined($line_fmt)) { *$self->{LOG}->error("$function_name: 'list_fmt' argument missing (internal error)"); - return 1; + return undef; } unless (defined($value_fmt)) { *$self->{LOG}->error("$function_name: 'value_fmt' argument missing (internal error)"); - return 1; + return undef; } unless (defined($value_opt)) { *$self->{LOG}->error("$function_name: 'value_opt' argument missing (internal error)"); - return 1; + return undef; } *$self->{LOG}->debug(2, @@ -471,6 +475,10 @@ Arguments : value : keyword value (can be empty) line_fmt : line format (see LINE_FORMAT_xxx constants) +Return value: + A string corresponding to the line formatted according to line_fmt + or undef in case of an internal error (missing arguments) + =cut sub _formatConfigLine @@ -480,15 +488,15 @@ sub _formatConfigLine unless ($keyword) { *$self->{LOG}->error("$function_name: 'keyword' argument missing (internal error)"); - return 1; + return undef; } unless (defined($value)) { *$self->{LOG}->error("$function_name: 'value' argument missing (internal error)"); - return 1; + return undef; } unless (defined($line_fmt)) { *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); - return 1; + return undef; } my $config_line = ""; @@ -534,6 +542,10 @@ Arguments : config_value: when defined, make it part of the pattern (used when multiple lines with the same keyword are allowed) +Return value: + A string containing the pattern to use to match the line in the file or undef + in case of an internal error (missing argument). + =cut sub _buildLinePattern @@ -600,6 +612,9 @@ Arguments : config_param: parameter to update line_fmt : line format (see LINE_FORMAT_xxx constants) +Return value: + None or 1 in case of an internal error (missing argument) + =cut sub _removeConfigLine @@ -659,6 +674,9 @@ Arguments : line_fmt : line format (see LINE_FORMAT_xxx constants) multiple : if true, multiple lines with the same keyword can exist (D: false) +Return value: + None or 1 in case of an internal error (missing argument) + =cut sub _updateConfigLine @@ -861,6 +879,9 @@ Supported entries for options hash: always_rules_only: if true, apply only rules with ALWAYS condition (D: false) remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) +Return value: + None or 1 in case of an internal error (missing argument) + =cut sub _apply_rules @@ -895,8 +916,9 @@ sub _apply_rules # line must be commented out unconditionally. # Each rule format is '[condition->]attribute:option_set[,option_set,...];line_fmt' where # condition: either a role that must be enabled or ALWAYS if the rule must be applied - # when 'always_rules_only' is true. A role is enabled if 'role_enabled' is - # true in the corresponding option set. + # when 'always_rules_only' is true. A role is defined by an option set (see + # Description at the beginning of this file, basically a sub-hash in the config) + # and it is enabled if 'role_enabled' is true in the corresponding option set. # option_set and attribute: attribute in option set that must be substituted # line_fmt: the format to use when building the line # An empty rule is valid and means that the keyword part must be @@ -914,7 +936,7 @@ sub _apply_rules # Check if the keyword is prefixed by: # - a '-': in this case the corresponding line must be unconditionally # commented out if it is present - # - a '*': in this case the corresponding line must be commented out if + # - a '?': in this case the corresponding line must be commented out if # it is present and the option is undefined my $comment_line = 0; if ($keyword =~ /^-/) { @@ -962,8 +984,7 @@ sub _apply_rules if (exists($rule_info->{error_msg})) { *$self->{LOG}->error("Error parsing rule >>>$rule<<<: " . $rule_info->{error_msg}); - # FIXME: decide whether an invalid rule is just ignored or causes any modification to be prevented. - # $self->cancel() + # An invalid rule is just ignored next; } elsif ($rule_info->{remove_matching_lines}) { if ($rule_parsing_options->{remove_if_undef}) { From c9b50c26e6311017971b1415d8e79a983e4a1759 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sun, 8 May 2016 19:43:27 +0200 Subject: [PATCH 18/22] RuleBaseEditor: rename method _removeConfigLine into _commentConfigLine --- src/main/perl/RuleBasedEditor.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index eefcbaa2..63690ee0 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -603,7 +603,7 @@ sub _buildLinePattern =pod -=item _removeConfigLine +=item _commentConfigLine This function comments out a configuration line matching the configuration parameter. Match operation takes into account the line format. @@ -617,9 +617,9 @@ Return value: =cut -sub _removeConfigLine +sub _commentConfigLine { - my $function_name = "_removeConfigLine"; + my $function_name = "_commentConfigLine"; my ($self, $config_param, $line_fmt) = @_; unless ($config_param) { @@ -968,7 +968,7 @@ sub _apply_rules # If the keyword was "negated", remove (comment out) configuration line if present and enabled if ($comment_line) { *$self->{LOG}->debug(1, "$function_name: keyword '$keyword' negated, removing configuration line"); - $self->_removeConfigLine($keyword, $line_fmt); + $self->_commentConfigLine($keyword, $line_fmt); next; } @@ -989,7 +989,7 @@ sub _apply_rules } elsif ($rule_info->{remove_matching_lines}) { if ($rule_parsing_options->{remove_if_undef}) { *$self->{LOG}->debug(1, "$function_name: removing configuration lines for keyword '$keyword'"); - $self->_removeConfigLine($keyword, $line_fmt); + $self->_commentConfigLine($keyword, $line_fmt); } else { *$self->{LOG}->debug(1, "$function_name: remove_if_undef not set, ignoring line to remove"); } @@ -1042,7 +1042,7 @@ sub _apply_rules "$function_name: attribute '" . $rule_info->{attribute} . "' undefined, removing configuration line"); - $self->_removeConfigLine($keyword, $line_fmt); + $self->_commentConfigLine($keyword, $line_fmt); } next; } From 0b1529f27a168b34f427cdabfc9e3665b6011315 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sun, 8 May 2016 19:38:35 +0200 Subject: [PATCH 19/22] RuleBasedEditor: comment clarifications and typo fixes - Also add handling of undef return value by some methods after an internal error --- src/main/perl/RuleBasedEditor.pm | 185 +++++++++++++++---------- src/test/perl/rbe_build_line_pattern.t | 10 +- 2 files changed, 119 insertions(+), 76 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index 63690ee0..857182f8 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -41,12 +41,20 @@ matching line will be removed/commented out if the option is undefined. =item condition -An option or an option set (see below) that must exist for the rule to be applied. -Both C and C are accepted. +An option or an option set (see below) that must exist for the rule to be applied +or the keyword C. +Both C and C are accepted. option and option set +in the condition are normally different from the C and C +parameters in the rule as this is the default behaviour to apply the rule only if +they exist. One option set only is allowed and only its existence (not its value) is tested. It is possible to negate the condition (option or option_set must not exist) by prepending it with '!'. +C is a special condition that means that rules must be applied whether +the C exist in the configuration or not. When they don't exist +the result is to comment out the matching configuration lines. + =item option_name The name of an option that will be retrieved from the configuration. An option is @@ -77,15 +85,15 @@ A SH shell variable definition (key=val). =item * -A 'keyword value' line, as used by Xrootd or Apache config files. +A 'keyword value' line, as used by Apache config files (similar to Config::General). =item * -A 'setenv keyword value' line, as used by Xrootd config files mainly. It can also be used in a CSH shell script. +A 'setenv keyword=value' line, as used by Xrootd config files mainly. It doesn't work in a CSH shell script (C<=> present). =item * -A 'set keyword value' line, as used by Xrootd config files mainly. It doesn't work in a CSH shell script (C<=> missing). +A 'set keyword=value' line, as used in a a CSH shell script to define a shell variable. =back @@ -154,34 +162,37 @@ There is a different group of constants for each part of the rule. =item * -LINE_FORMAT_SH_VAR: key=val (e.g. SH shell family) +LINE_FORMAT_SH_VAR: key=val (e.g. SH shell family). A comment is added at the +end of the line if it is modified by L. =item * -LINE_FORMAT_ENV_VAR: export key=val (e.g. SH shell family) +LINE_FORMAT_ENV_VAR: export key=val (e.g. SH shell family). A comment is added at the +end of the line if it is modified by L. + =item * LINE_FORMAT_KEY_VAL: key val (e.g. Xrootd, Apache) =item * -LINE_FORMAT_KEY_VAL_SETENV: setenv key val (used by Xrootd in particular) +LINE_FORMAT_KEY_VAL_SETENV: setenv key=val (used by Xrootd in particular) =item * -LINE_FORMAT_KEY_VAL_SET: set key val (used by Xrootd in particular) +LINE_FORMAT_KEY_VAL_SET: set key=val (CSH shell variable) =back =cut use enum qw( - LINE_FORMAT_SH_VAR=1 - LINE_FORMAT_ENV_VAR - LINE_FORMAT_KEY_VAL - LINE_FORMAT_KEY_VAL_SETENV - LINE_FORMAT_KEY_VAL_SET - ); + LINE_FORMAT_SH_VAR=1 + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET + ); =pod @@ -220,13 +231,13 @@ LINE_VALUE_INSTANCE_PARAMS: specific to L =cut use enum qw( - LINE_VALUE_AS_IS - LINE_VALUE_BOOLEAN - LINE_VALUE_ARRAY - LINE_VALUE_HASH_KEYS - LINE_VALUE_STRING_HASH - LINE_VALUE_INSTANCE_PARAMS - ); + LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + LINE_VALUE_INSTANCE_PARAMS + ); =pod @@ -253,10 +264,10 @@ LINE_VALUE_OPT_SORTED: values are sorted =cut use enum qw( - BITMASK: LINE_VALUE_OPT_SINGLE - LINE_VALUE_OPT_UNIQUE - LINE_VALUE_OPT_SORTED - ); + BITMASK: LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); # Internal constants Readonly my $LINE_FORMAT_DEFAULT => LINE_FORMAT_SH_VAR; @@ -270,21 +281,21 @@ Readonly my $RULE_OPTION_SET_GLOBAL => 'GLOBAL'; # Export constants used to build rules # Needs to be updated when a constant is added or removed Readonly my @RULE_CONSTANTS => qw( - LINE_FORMAT_SH_VAR - LINE_FORMAT_ENV_VAR - LINE_FORMAT_KEY_VAL - LINE_FORMAT_KEY_VAL_SETENV - LINE_FORMAT_KEY_VAL_SET - LINE_VALUE_AS_IS - LINE_VALUE_BOOLEAN - LINE_VALUE_INSTANCE_PARAMS - LINE_VALUE_ARRAY - LINE_VALUE_HASH_KEYS - LINE_VALUE_STRING_HASH - LINE_VALUE_OPT_SINGLE - LINE_VALUE_OPT_UNIQUE - LINE_VALUE_OPT_SORTED - ); + LINE_FORMAT_SH_VAR + LINE_FORMAT_ENV_VAR + LINE_FORMAT_KEY_VAL + LINE_FORMAT_KEY_VAL_SETENV + LINE_FORMAT_KEY_VAL_SET + LINE_VALUE_AS_IS + LINE_VALUE_BOOLEAN + LINE_VALUE_INSTANCE_PARAMS + LINE_VALUE_ARRAY + LINE_VALUE_HASH_KEYS + LINE_VALUE_STRING_HASH + LINE_VALUE_OPT_SINGLE + LINE_VALUE_OPT_UNIQUE + LINE_VALUE_OPT_SORTED + ); our @EXPORT_OK; @@ -309,11 +320,12 @@ Update configuration file contents, applying configuration rules. Arguments : config_rules: config rules corresponding to the file to build config_options: configuration parameters used to build actual configuration - options: a hash setting options to modify the behaviour of this function + options: a hashref defining options to modify the behaviour of this function Supported entries for options hash: - always_rules_only: if true, apply only rules with ALWAYS condition (D: false) - remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) + always_rules_only: if true, apply only rules with ALWAYS condition (D: false). See introduction + about the ALWAYS condition. + remove_if_undef: if true, remove matching configuration line if rule condition is not met (D: false) Return value sucess: 1 @@ -374,7 +386,7 @@ sub updateFile This function formats an attribute value based on the value format specified. Arguments: - attr_value : attribue value + attr_value : attribute value (type interpreted based on C) line_fmt : line format (see LINE_FORMAT_xxx constants) value_fmt : value format (see LINE_VALUE_xxx constants) value_opt : value interpretation/formatting options (bitmask, see LINE_VALUE_OPT_xxx constants) @@ -411,11 +423,16 @@ sub _formatAttributeValue "$function_name: formatting attribute value >>>$attr_value<<< (line fmt=$line_fmt, value fmt=$value_fmt, value_opt=$value_opt)" ); + #FIXME: replace this if..elsif.. block by a dispatch table that would be easier to extend, + #possibly with code out of CAF::RuleBasedEditor. Dispatch table may need to be implemented + #in a few other methods. my $formatted_value; if ($value_fmt == LINE_VALUE_BOOLEAN) { $formatted_value = $attr_value ? 'yes' : 'no'; } elsif ($value_fmt == LINE_VALUE_INSTANCE_PARAMS) { + # LINE_VALUE_INSTANCE_PARAMS is a value format specific to XrootD (http://xrootd.org). + # The value is a hash containing 3 keys that are used to construct a command option line. $formatted_value = ''; # Don't return undef if no matching attributes is found # Instance parameters are described in a nlist $formatted_value .= " -l $attr_value->{logFile}" if $attr_value->{logFile}; @@ -423,6 +440,8 @@ sub _formatAttributeValue $formatted_value .= " -k $attr_value->{logKeep}" if $attr_value->{logKeep}; } elsif ($value_fmt == LINE_VALUE_ARRAY) { + # An array can contain several occurences of the same value. By default they are all kept + # in the index order. Some LINE_VALUE_OPT_xxx options allow to change this default behaviour. *$self->{LOG}->debug(2, "$function_name: array values received: ", join(",", @$attr_value)); if ($value_opt & LINE_VALUE_OPT_UNIQUE) { my %values = map(($_ => 1), @$attr_value); @@ -431,7 +450,7 @@ sub _formatAttributeValue } # LINE_VALUE_OPT_UNIQUE implies LINE_VALUE_OPT_SORTED if ($value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED)) { - $attr_value = [sort(@$attr_value)] if $value_opt & (LINE_VALUE_OPT_UNIQUE | LINE_VALUE_OPT_SORTED); + $attr_value = [sort(@$attr_value)]; *$self->{LOG}->debug(2, "$function_name: array values sorted: ", join(",", @$attr_value)); } $formatted_value = join " ", @$attr_value; @@ -444,9 +463,11 @@ sub _formatAttributeValue } else { *$self->{LOG}->error("$function_name: invalid value format ($value_fmt) (internal error)"); + return undef; } - # Quote value if necessary + # Quote value if necessary (only for shell variables). + # If you do not want the line interpolated, use explicit single quotes. if (($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR)) { if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\g1$/)) || ($value_fmt == LINE_VALUE_BOOLEAN) @@ -472,7 +493,7 @@ quoted if the line format is not LINE_FORMAT_KEY_VAL. Arguments : keyword : line keyword - value : keyword value (can be empty) + value : keyword value (can be an empty string) line_fmt : line format (see LINE_FORMAT_xxx constants) Return value: @@ -511,10 +532,10 @@ sub _formatConfigLine $config_line = "set $keyword = $value"; } elsif ($line_fmt == LINE_FORMAT_KEY_VAL) { $config_line = $keyword; - $config_line .= " $value" if $value; - # In trust (shift.conf) format, there should be only one blank between - # tokens and no trailing spaces. - $config_line =~ s/\s\s+/ /g; + $config_line .= " $value" if defined($value); + # In this format, ensure that there is only one blank between + # tokens and no trailing spaces as it is important in some use cases. + $config_line =~ s/\s+/ /g; $config_line =~ s/\s+$//; } else { *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); @@ -533,7 +554,7 @@ This function builds a pattern that will match an existing configuration line fo the configuration parameter specified. The pattern built takes into account the line format. Every whitespace in the pattern (configuration parameter) are replaced by \s+. If the line format is LINE_FORMAT_KEY_VAL, no whitespace is -imposed at the end of the pattern, as these format can be used to write a configuration +imposed at the end of the pattern, as this format can be used to write a configuration directive as a keyword with no value. Arguments : @@ -544,7 +565,7 @@ Arguments : Return value: A string containing the pattern to use to match the line in the file or undef - in case of an internal error (missing argument). + in case of an internal error (missing argument or an invalid line format). =cut @@ -572,7 +593,7 @@ sub _buildLinePattern # config_param is generally a keyword and in this case it contains no whitespace. # A special case is when config_param (the rule keyword) is used to match a line - # without specifying a rule: in this case it may contains whitespaces. Remove strict + # without specifying a rule: in this case it may contain whitespaces. Remove strict # matching of them (match any type/number of whitespaces at the same position). # Look at %trust_config_rules in ncm-dpmlfc Perl module for an example. $config_param =~ s/\s+/\\s+/g; @@ -581,7 +602,7 @@ sub _buildLinePattern if ($line_fmt == LINE_FORMAT_SH_VAR) { $config_param_pattern = "#?\\s*$config_param=" . $config_value; } elsif ($line_fmt == LINE_FORMAT_ENV_VAR) { - $config_param_pattern = "#?\\s*export $config_param=" . $config_value; + $config_param_pattern = "#?\\s*export\\s+$config_param=" . $config_value; } elsif ($line_fmt == LINE_FORMAT_KEY_VAL_SETENV) { $config_param_pattern = "#?\\s*setenv\\s+$config_param\\s*=\\s*" . $config_value; } elsif ($line_fmt == LINE_FORMAT_KEY_VAL_SET) { @@ -613,7 +634,7 @@ Arguments : line_fmt : line format (see LINE_FORMAT_xxx constants) Return value: - None or 1 in case of an internal error (missing argument) + undef or 1 in case of an internal error (missing argument) =cut @@ -633,6 +654,10 @@ sub _commentConfigLine # Build a pattern to look for. my $config_param_pattern = $self->_buildLinePattern($config_param, $line_fmt); + unless ( defined($config_param_pattern) ) { + *$self->{LOG}->error("$function_name: _buildLinePattern() encountered an internal error. Cannot comment out lines matching $config_param"); + return; + } *$self->{LOG}->debug(1, "$function_name: commenting out lines matching pattern >>>" . $config_param_pattern . "<<<"); # All matching lines must be commented out, except if they are already commented out. @@ -670,12 +695,12 @@ line formatting based on the line format. Arguments : config_param: parameter to update - config_value : parameter value (can be empty) + config_value : parameter value (can be an empty string) line_fmt : line format (see LINE_FORMAT_xxx constants) multiple : if true, multiple lines with the same keyword can exist (D: false) Return value: - None or 1 in case of an internal error (missing argument) + undef or 1 in case of an internal error (missing argument) =cut @@ -702,21 +727,39 @@ sub _updateConfigLine my $config_param_pattern; my $new_line = $self->_formatConfigLine($config_param, $config_value, $line_fmt); + unless ( defined($new_line) ) { + *$self->{LOG}->error("$function_name: _formatConfigLine() encountered an internal error. Cannot update lines matching $config_param"); + return; + } # Build a pattern to look for. + # When multiple lines for the same keyword can exist, update only those matching the specific value. if ($multiple) { *$self->{LOG}->debug(2, "$function_name: 'multiple' flag enabled"); $config_param_pattern = $self->_buildLinePattern($config_param, $line_fmt, $config_value); + unless ( defined($config_param_pattern) ) { + *$self->{LOG}->error("$function_name: _buildLinePattern() encountered an internal error. Cannot update lines matching $config_param"); + return; + } } else { $config_param_pattern = $self->_buildLinePattern($config_param, $line_fmt); - if (($line_fmt == LINE_FORMAT_KEY_VAL) && $config_value) { - $config_param_pattern .= "\\s+"; # If the value is defined in these formats, impose a whitespace at the end + unless ( defined($config_param_pattern) ) { + *$self->{LOG}->error("$function_name: _buildLinePattern() encountered an internal error. Cannot update lines matching $config_param"); + return; + } + if (($line_fmt == LINE_FORMAT_KEY_VAL) && defined($config_value)) { + # For this format, if the value is defined impose a whitespace at the end to prevent matching a keyword starting + # with the same letters. + $config_param_pattern .= "\\s+"; } } # Update the matching configuration lines - if ($new_line) { + if ( $new_line ) { my $comment = ""; + # For shell variables, add a comment at the end of the line indicating it was edited by Quattor + # Not done for other formats as comments at the end of the line are not supported in many + # configuration files. if (($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR)) { $comment = $LINE_QUATTOR_COMMENT; } @@ -724,8 +767,7 @@ sub _updateConfigLine "$function_name: checking expected configuration line ($new_line) with pattern >>>" . $config_param_pattern . "<<<"); - $self->add_or_replace_lines( - qr/^\s*$config_param_pattern/, + $self->add_or_replace_lines(qr/^\s*$config_param_pattern/, qr/^\s*$new_line$/, $new_line . $comment . "\n", ENDING_OF_FILE, @@ -745,11 +787,12 @@ information about the error. Arguments : rule: rule to parse config_options: configuration parameters used to build actual configuration - parser_options: a hash setting options to modify the behaviour of this method + parser_options: a hashref defining options to modify the behaviour of this function Supported entries for options hash: - always_rules_only: if true, apply only rules with ALWAYS condition (D: false) - remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) + always_rules_only: if true, apply only rules with ALWAYS condition (D: false). See introduction + about the ALWAYS condition. + remove_if_undef: if true, remove matching configuration line if rule condition is not met (D: false) Return value: undef if the rule condition is not met or a hash with the following information: error_msg: a non empty string if an error happened during parsing @@ -786,7 +829,7 @@ sub _parse_rule $parser_options->{always_rules_only} = $LINE_OPT_DEF_ALWAYS_RULES_ONLY; } - (my $condition, my $tmp) = split /->/, $rule; + my ($condition, $tmp) = split /->/, $rule; if ($tmp) { $rule = $tmp; } else { @@ -812,7 +855,7 @@ sub _parse_rule if ($condition ne "") { *$self->{LOG}->debug(1, "$function_name: checking condition >>>$condition<<<"); - # Condition may be negated if it starts with a !: remove it from the condition value. + # Condition is negated if it starts with a !: remove it from the condition value. # If the condition is negated, when the condition is true the rule must not be applied. my $negate = 0; if ($condition =~ /^!/) { @@ -877,10 +920,10 @@ Arguments : Supported entries for options hash: always_rules_only: if true, apply only rules with ALWAYS condition (D: false) - remove_if_undef: if true, remove matching configuration line is rule condition is not met (D: false) + remove_if_undef: if true, remove matching configuration line if rule condition is not met (D: false) Return value: - None or 1 in case of an internal error (missing argument) + undef or 1 in case of an internal error (missing argument) =cut diff --git a/src/test/perl/rbe_build_line_pattern.t b/src/test/perl/rbe_build_line_pattern.t index b1878946..86b5377c 100644 --- a/src/test/perl/rbe_build_line_pattern.t +++ b/src/test/perl/rbe_build_line_pattern.t @@ -40,7 +40,7 @@ ok(defined($fh), $FILENAME." was opened"); # Build a line pattern without a parameter value Readonly my $KEYWORD => 'DPNS_HOST'; -Readonly my $LINE_PATTERN_ENV_VAR => '#?\s*export DPNS_HOST='; +Readonly my $LINE_PATTERN_ENV_VAR => '#?\s*export\s+DPNS_HOST='; Readonly my $LINE_PATTERN_KEY_VALUE => '#?\s*DPNS_HOST'; my $escaped_pattern = $fh->_buildLinePattern($KEYWORD, LINE_FORMAT_ENV_VAR); @@ -51,15 +51,15 @@ is($escaped_pattern, $LINE_PATTERN_KEY_VALUE, "Key/value pattern ok"); # Build a line pattern without a parameter value Readonly my $VALUE_1 => 'dpns.example.com'; -Readonly my $EXPECTED_PATTERN_1 => '#?\s*export DPNS_HOST=dpns\.example\.com'; +Readonly my $EXPECTED_PATTERN_1 => '#?\s*export\s+DPNS_HOST=dpns\.example\.com'; Readonly my $VALUE_2 => 0; -Readonly my $EXPECTED_PATTERN_2 => '#?\s*export DPNS_HOST=0'; +Readonly my $EXPECTED_PATTERN_2 => '#?\s*export\s+DPNS_HOST=0'; Readonly my $VALUE_3 => '^dp$n-s.*ex] a+m(ple[.c)o+m?'; -Readonly my $EXPECTED_PATTERN_3 => '#?\s*export DPNS_HOST=\^dp\$n\-s\.\*ex\]\s+a\+m\(ple\[\.c\)o\+m\?'; +Readonly my $EXPECTED_PATTERN_3 => '#?\s*export\s+DPNS_HOST=\^dp\$n\-s\.\*ex\]\s+a\+m\(ple\[\.c\)o\+m\?'; # Test \ escaping separately as it also needs the expected value also needs to be escaped for the test # to be successful! Readonly my $VALUE_4 => 'a\b'; -Readonly my $EXPECTED_PATTERN_4 => '#?\s*export DPNS_HOST=a\\\\b'; +Readonly my $EXPECTED_PATTERN_4 => '#?\s*export\s+DPNS_HOST=a\\\\b'; $escaped_pattern = $fh->_buildLinePattern($KEYWORD, LINE_FORMAT_ENV_VAR, $VALUE_1); From f0c06fb9077c678df81eee52b27e4fea41adb0bb Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sun, 8 May 2016 22:41:14 +0200 Subject: [PATCH 20/22] RuleBasedEditor: cleanup of method return values --- src/main/perl/RuleBasedEditor.pm | 52 ++++++++++++++++---------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index 857182f8..3f434c7c 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -363,13 +363,12 @@ sub updateFile BEGINNING_OF_FILE, ); - $self->_apply_rules( - $config_rules, - $config_options, - $parser_options - ); + my $status = $self->_apply_rules($config_rules, + $config_options, + $parser_options + ); - return 1; + return $status; } @@ -404,19 +403,19 @@ sub _formatAttributeValue unless (defined($attr_value)) { *$self->{LOG}->error("$function_name: 'attr_value' argument missing (internal error)"); - return undef; + return; } unless (defined($line_fmt)) { *$self->{LOG}->error("$function_name: 'list_fmt' argument missing (internal error)"); - return undef; + return; } unless (defined($value_fmt)) { *$self->{LOG}->error("$function_name: 'value_fmt' argument missing (internal error)"); - return undef; + return; } unless (defined($value_opt)) { *$self->{LOG}->error("$function_name: 'value_opt' argument missing (internal error)"); - return undef; + return; } *$self->{LOG}->debug(2, @@ -433,7 +432,7 @@ sub _formatAttributeValue } elsif ($value_fmt == LINE_VALUE_INSTANCE_PARAMS) { # LINE_VALUE_INSTANCE_PARAMS is a value format specific to XrootD (http://xrootd.org). # The value is a hash containing 3 keys that are used to construct a command option line. - $formatted_value = ''; # Don't return undef if no matching attributes is found + $formatted_value = ''; # Don't return if no matching attributes is found # Instance parameters are described in a nlist $formatted_value .= " -l $attr_value->{logFile}" if $attr_value->{logFile}; $formatted_value .= " -c $attr_value->{configFile}" if $attr_value->{configFile}; @@ -463,7 +462,7 @@ sub _formatAttributeValue } else { *$self->{LOG}->error("$function_name: invalid value format ($value_fmt) (internal error)"); - return undef; + return; } # Quote value if necessary (only for shell variables). @@ -509,15 +508,15 @@ sub _formatConfigLine unless ($keyword) { *$self->{LOG}->error("$function_name: 'keyword' argument missing (internal error)"); - return undef; + return; } unless (defined($value)) { *$self->{LOG}->error("$function_name: 'value' argument missing (internal error)"); - return undef; + return; } unless (defined($line_fmt)) { *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); - return undef; + return; } my $config_line = ""; @@ -576,11 +575,11 @@ sub _buildLinePattern unless ($config_param) { *$self->{LOG}->error("$function_name: 'config_param' argument missing (internal error)"); - return undef; + return; } unless (defined($line_fmt)) { *$self->{LOG}->error("$function_name: 'line_fmt' argument missing (internal error)"); - return undef; + return; } if (defined($config_value)) { *$self->{LOG}->debug(2, "$function_name: configuration value '$config_value' will be added to the pattern"); @@ -615,7 +614,7 @@ sub _buildLinePattern } } else { *$self->{LOG}->error("$function_name: invalid line format ($line_fmt). Internal inconsistency."); - return undef; + return; } return $config_param_pattern; @@ -871,10 +870,10 @@ sub _parse_rule . "condition attribute = '$cond_attribute', negate=$negate"); my $cond_satisfied = 1; # Assume condition is satisfied if ($cond_attribute) { - # Due to Perl autovivification, testing directly exists($config_options->{$cond_option_set}->{$cond_attribute}) will spring - # $config_options->{$cond_option_set} into existence if it doesn't exist. + # Due to Perl autovivification, testing directly exists($config_options->{$cond_option_set}->{$cond_attribute}) will spring + # $config_options->{$cond_option_set} into existence if it doesn't exist. my $cond_true = $config_options->{$cond_option_set} - && exists($config_options->{$cond_option_set}->{$cond_attribute}); + && exists($config_options->{$cond_option_set}->{$cond_attribute}); if ($negate) { $cond_satisfied = 0 if $cond_true; } else { @@ -888,8 +887,8 @@ sub _parse_rule } } if (!$cond_satisfied) { - # When the condition is not satisfied and if option remove_if_undef is set, - # remove configuration line (if present). + # When the condition is not satisfied and option remove_if_undef is set, + # remove (comment out) configuration line (if present). *$self->{LOG}->debug(1, "$function_name: condition not satisfied, flag set to remove matching configuration lines"); $rule_info{remove_matching_lines} = 1; return \%rule_info; @@ -923,7 +922,8 @@ Supported entries for options hash: remove_if_undef: if true, remove matching configuration line if rule condition is not met (D: false) Return value: - undef or 1 in case of an internal error (missing argument) + success: 1 + undef in case of an internal error (missing argument) =cut @@ -934,11 +934,11 @@ sub _apply_rules unless ($config_rules) { *$self->{LOG}->error("$function_name: 'config_rules' argument missing (internal error)"); - return 1; + return; } unless ($config_options) { *$self->{LOG}->error("$function_name: 'config_options' argument missing (internal error)"); - return 1; + return; } unless (defined($parser_options)) { *$self->{LOG}->debug(2, "$function_name: 'parser_options' undefined"); From a3a4a0365ef9d599943c6f826f8360280f3140d4 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Sun, 8 May 2016 23:02:23 +0200 Subject: [PATCH 21/22] RuleBasedEditor: additional comment cleanups and clarifications - Also includes some code reformatting --- src/main/perl/RuleBasedEditor.pm | 120 ++++++++++++++----------------- 1 file changed, 55 insertions(+), 65 deletions(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index 3f434c7c..ba135203 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -70,34 +70,9 @@ hash). =item line_fmt -Defines the format used to represent the key/value pair. The following formats are -supported (see LINE_FORMAT_xxx constants below): - -=over - -=item * - -A SH shell environment variable definition (export key=val). - -=item * - -A SH shell variable definition (key=val). - -=item * - -A 'keyword value' line, as used by Apache config files (similar to Config::General). - -=item * - -A 'setenv keyword=value' line, as used by Xrootd config files mainly. It doesn't work in a CSH shell script (C<=> present). - -=item * - -A 'set keyword=value' line, as used in a a CSH shell script to define a shell variable. - -=back - -Inline comments are not supported in 'keyword value' family of formats. +Defines the format used to represent the keyword/value pair. Several format are supported covering +the most usual ones (SH shell script, Apache, ...). For the exact list, see the definition of +LINE_FORMAT_xxx constants and the associated documentation below. =item value_fmt @@ -184,6 +159,8 @@ LINE_FORMAT_KEY_VAL_SET: set key=val (CSH shell variable) =back +Inline comments are not supported for the LINE_FORMAT_KEY_VAL_xxx formats. + =cut use enum qw( @@ -253,7 +230,7 @@ LINE_VALUE_OPT_SINGLE: each value must be a separate instance of the keyword (mu =item -LINE_VALUE_OPT_UNIQUE: each values are concataneted as a space-separated string +LINE_VALUE_OPT_UNIQUE: each values are concatenated as a space-separated string =item @@ -303,6 +280,14 @@ our %EXPORT_TAGS; push @EXPORT_OK, @RULE_CONSTANTS; $EXPORT_TAGS{rule_constants} = \@RULE_CONSTANTS; +=pod + +$FILE_INTRO_xxx: constants defining the expected header lines in the configuration file + +=cut + +Readonly my $FILE_INTRO_PATTERN => "# This file is managed by Quattor"; +Readonly my $FILE_INTRO_TXT => "# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor"; # Backup file extension Readonly my $BACKUP_FILE_EXT => ".old"; @@ -318,8 +303,8 @@ Readonly my $BACKUP_FILE_EXT => ".old"; Update configuration file contents, applying configuration rules. Arguments : - config_rules: config rules corresponding to the file to build - config_options: configuration parameters used to build actual configuration + config_rules: a hashref containing config rules corresponding to the file to build + config_options: a hashref for configuration parameters used to build actual configuration options: a hashref defining options to modify the behaviour of this function Supported entries for options hash: @@ -329,7 +314,7 @@ Supported entries for options hash: Return value sucess: 1 - argument error: undef + argument error or error duing rule processing: undef =cut @@ -354,12 +339,10 @@ sub updateFile $self->seek_begin(); # Check that config file has an appropriate header - Readonly my $INTRO_PATTERN => "# This file is managed by Quattor"; - my $intro = "# This file is managed by Quattor - DO NOT EDIT lines generated by Quattor"; $self->add_or_replace_lines( - qr/^$INTRO_PATTERN/, - qr/^$intro$/, - $intro . "\n#\n", + qr/^$FILE_INTRO_PATTERN/, + qr/^$FILE_INTRO_TXT$/, + $FILE_INTRO_TXT . "\n#\n", BEGINNING_OF_FILE, ); @@ -433,7 +416,7 @@ sub _formatAttributeValue # LINE_VALUE_INSTANCE_PARAMS is a value format specific to XrootD (http://xrootd.org). # The value is a hash containing 3 keys that are used to construct a command option line. $formatted_value = ''; # Don't return if no matching attributes is found - # Instance parameters are described in a nlist + # Instance parameters are described in a hash $formatted_value .= " -l $attr_value->{logFile}" if $attr_value->{logFile}; $formatted_value .= " -c $attr_value->{configFile}" if $attr_value->{configFile}; $formatted_value .= " -k $attr_value->{logKeep}" if $attr_value->{logKeep}; @@ -663,6 +646,7 @@ sub _commentConfigLine # The code used is a customized version of FileEditor::replace() that lacks support for backreferences # in the replacement value (here we want to rewrite the same line commented out but we don't know the # current line contents, only a regexp matching it). + # FIXME: should be updated when https://github.com/quattor/CAF/issues/125 is fixed. my @lns; my $line_count = 0; $self->seek_begin(); @@ -914,7 +898,10 @@ Apply configuration rules. This method is the real workhorse of the rule-based e Arguments : config_rules: config rules corresponding to the file to build - config_options: configuration parameters used to build actual configuration + config_options: configuration parameters used to build actual configuration. Note that keys in the + config_options hash are interpreted as escaped (generally harmless if they are not as the + killing sequence, '_'+ 2 hex digit, is unlikely to occur in this context. Use camel case + for keys to prevent problems). parser_options: a hash setting options to modify the behaviour of this function Supported entries for options hash: @@ -974,7 +961,7 @@ sub _apply_rules $rule_id++; # Initialize parser_options for this rule according the default for this file - my $rule_parsing_options = {%{$parser_options}}; + my $rule_parsing_options = {%$parser_options}; # Check if the keyword is prefixed by: # - a '-': in this case the corresponding line must be unconditionally @@ -1010,8 +997,10 @@ sub _apply_rules # If the keyword was "negated", remove (comment out) configuration line if present and enabled if ($comment_line) { - *$self->{LOG}->debug(1, "$function_name: keyword '$keyword' negated, removing configuration line"); - $self->_commentConfigLine($keyword, $line_fmt); + *$self->{LOG}->debug(1, "$function_name: keyword '$keyword' negated, removing/commenting configuration line"); + unless ( $self->_commentConfigLine($keyword, $line_fmt) ) { + *$self->{LOG}->error("$function_name: _commentConfigLine() encountered an internal error, lines matching '$keyword' not removed"); + } next; } @@ -1019,20 +1008,24 @@ sub _apply_rules # Parse rule if it is non empty my $rule_info; if ($rule ne '') { - *$self->{LOG} - ->debug(1, "$function_name: processing rule $rule_id (variable=>>>$keyword<<<, rule=>>>$rule<<<, fmt=$line_fmt)"); + *$self->{LOG}->debug(1, "$function_name: processing rule $rule_id (variable=>>>$keyword<<<, rule=>>>$rule<<<, fmt=$line_fmt)"); $rule_info = $self->_parse_rule($rule, $config_options, $rule_parsing_options); next unless $rule_info; *$self->{LOG}->debug(2, "$function_name: information returned by rule parser: " . join(" ", sort(keys(%$rule_info)))); if (exists($rule_info->{error_msg})) { + # FIXME: decide whether an invalid rule is considered an error or just a warning. The latter would + # allow the caller to decide what to do exactly rather than impose an error (meaning a + # potential dependency failure) *$self->{LOG}->error("Error parsing rule >>>$rule<<<: " . $rule_info->{error_msg}); # An invalid rule is just ignored next; } elsif ($rule_info->{remove_matching_lines}) { if ($rule_parsing_options->{remove_if_undef}) { - *$self->{LOG}->debug(1, "$function_name: removing configuration lines for keyword '$keyword'"); - $self->_commentConfigLine($keyword, $line_fmt); + *$self->{LOG}->debug(1, "$function_name: removing/commenting configuration lines for keyword '$keyword'"); + unless ( $self->_commentConfigLine($keyword, $line_fmt) ) { + *$self->{LOG}->error("$function_name: _commentConfigLine() encountered an internal error, lines matching '$keyword' not removed"); + } } else { *$self->{LOG}->debug(1, "$function_name: remove_if_undef not set, ignoring line to remove"); } @@ -1040,7 +1033,7 @@ sub _apply_rules } } - # Build the value to be substitued for each option set specified. + # Build the value to be substituted for each option set specified. # option_set=GLOBAL is a special case indicating a global option instead of an # attribute in a specific option set. my $config_value = ""; @@ -1050,14 +1043,12 @@ sub _apply_rules if ($rule_info->{attribute}) { foreach my $option_set (@{$rule_info->{option_sets}}) { my $attr_value; - *$self->{LOG} - ->debug(1, "$function_name: retrieving '" . $rule_info->{attribute} . "' value in option set $option_set"); + *$self->{LOG}->debug(1, "$function_name: retrieving '" . $rule_info->{attribute} . "' value in option set $option_set"); if ($option_set eq $RULE_OPTION_SET_GLOBAL) { - if (exists($config_options->{$rule_info->{attribute}})) { + if ( $config_options->{$rule_info->{attribute}} ) { $attr_value = $config_options->{$rule_info->{attribute}}; } else { - *$self->{LOG} - ->debug(1, "$function_name: attribute '" . $rule_info->{attribute} . "' not found in global option set"); + *$self->{LOG}->debug(1, "$function_name: attribute '" . $rule_info->{attribute} . "' not found in global option set"); $attribute_present = 0; } } else { @@ -1090,21 +1081,19 @@ sub _apply_rules next; } - # Instance parameters are specific, as this is a nlist of instance - # with the value being a nlist of parameters for the instance. + # Instance parameters are specific, as this is a hash of instances + # with the value being a hash of parameters for the instance. # Also the variable name must be updated to contain the instance name. # One configuration line must be written/updated for each instance. if ($value_fmt == LINE_VALUE_INSTANCE_PARAMS) { foreach my $instance (sort keys %{$attr_value}) { my $params = $attr_value->{$instance}; *$self->{LOG}->debug(1, "$function_name: formatting instance '$instance' parameters ($params)"); - $config_value = - $self->_formatAttributeValue( - $params, - $line_fmt, - $value_fmt, - $value_opt, - ); + $config_value = $self->_formatAttributeValue($params, + $line_fmt, + $value_fmt, + $value_opt, + ); my $config_param = $keyword; my $instance_uc = uc($instance); $config_param =~ s/%%INSTANCE%%/$instance_uc/; @@ -1114,12 +1103,13 @@ sub _apply_rules $config_updated = 1; } elsif ($value_fmt == LINE_VALUE_STRING_HASH) { # With this value format, several lines with the same keyword are generated, - # one for each key/value pair. + # one for each keyword/value pair. foreach my $k (sort keys %$attr_value) { my $v = $attr_value->{$k}; - # Value is made by joining key and value as a string - # Keys may be escaped if they contain characters like '/': unescaping a non-escaped - # string is generally harmless. + # Value is made by joining key and value as a string. + # Keys may be escaped if they contain characters like '/'. Generally harmless if + # they are not, except if the unescaped key as a sequence '_' + 2 hex digits. + # Unlikely in this context: to prevent problems use camel case for keys. my $tmp = unescape($k) . " $v"; *$self->{LOG}->debug(1, "$function_name: formatting (string hash) attribute '" From 95b3896c9660668663a575e1a1b3540bbf35dcf6 Mon Sep 17 00:00:00 2001 From: Michel Jouvin Date: Mon, 9 May 2016 20:01:29 +0200 Subject: [PATCH 22/22] RuleBasedEditor: fix a regexp not compatible with perl 5.8 (SL5) --- src/main/perl/RuleBasedEditor.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/main/perl/RuleBasedEditor.pm b/src/main/perl/RuleBasedEditor.pm index ba135203..2d6e516d 100644 --- a/src/main/perl/RuleBasedEditor.pm +++ b/src/main/perl/RuleBasedEditor.pm @@ -451,7 +451,9 @@ sub _formatAttributeValue # Quote value if necessary (only for shell variables). # If you do not want the line interpolated, use explicit single quotes. if (($line_fmt == LINE_FORMAT_SH_VAR) || ($line_fmt == LINE_FORMAT_ENV_VAR)) { - if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\g1$/)) + # In the regexp, \g1 would have been better than \1 but is not supported + # in perl 5.8 (SL5). \1 seems to achieve the same result in this context. + if ( (($formatted_value =~ /\s+/) && ($formatted_value !~ /^(["']).*\1$/)) || ($value_fmt == LINE_VALUE_BOOLEAN) || ($formatted_value eq '')) {