This is an automated email from the git hooks/post-receive script. x2go pushed a commit to branch master in repository x2goserver. commit 388d4e961e3e6c24e6f19a70c39e81269b663781 Author: Mihai Moldovan <ionic@ionic.de> Date: Fri Nov 6 07:35:23 2020 +0100 x2goserver/lib/x2goupdateoptionsstring: move most code to X2Go/Server/Agent/NX/Options.pm. --- X2Go/Server/Agent/NX/Options.pm | 643 +++++++++++++++++++++++++++++++++ debian/changelog | 2 + x2goserver/bin/x2goupdateoptionsstring | 640 +------------------------------- 3 files changed, 650 insertions(+), 635 deletions(-) diff --git a/X2Go/Server/Agent/NX/Options.pm b/X2Go/Server/Agent/NX/Options.pm index 5a1070fe..3acd65f0 100644 --- a/X2Go/Server/Agent/NX/Options.pm +++ b/X2Go/Server/Agent/NX/Options.pm @@ -17,4 +17,647 @@ package X2Go::Server::Agent::NX::Options; +# Disable some Perl::Critic violations. +## no critic (ProhibitParensWithBuiltins) + +use strict; +use warnings; + +use base 'Exporter'; +use English qw (-no_match_vars); +use Storable qw (dclone); + +our @EXPORT_OK = qw (parse_options interpret_transform transform_intermediate intermediate_to_string); + +# Accepts an option string and returns a reference to an array of hashes +# (actually hash references) corresponding to the parsed key-value pairs. +# +# Empty components are allowed, but will issue a warning message. In such a +# case, the hash at the corresponding array position will be empty. +# +# Keys that do not have a value assigned will be given a value of "undef" in +# order to be able to distinguish them from keys with an empty string as their +# value. +# +# Caveat: the last component will be split from the port definition. DO NOT +# SIMPLY JOIN THE LIST OR YOU WILL ADD A TRAILING COMMA! The port component +# hash retains the colon separator. +# +# On error, returns an undef reference. +sub parse_options { + my $ret = undef; + my @intermediate = (); + my $error_detected = 0; + my $options = shift; + my $next_discard = shift; + + if (defined ($next_discard)) { + print {*STDERR} "Multiple arguments passed in, all but the first one are ignored!\n"; + } + + if (!(defined ($options))) { + print {*STDERR} "No argument provided for options string, returning undef.\n"; + $error_detected = 1; + } + + if (!($error_detected)) { + my @components = split (/,/sxm, $options, -1); + foreach my $option (@components) { + # We use undef to denote that some component was not provided at all + # to disambiguate non-provided and empty strings. + my ($key, $value) = (undef, undef); + my %kv_hash = (); + + my @kv = split (/=/sxm, $option, 2); + + if (1 > scalar (@kv)) { + print {*STDERR} "Options string has empty component, this is deprecated. Adding empty element.\n"; + + push (@intermediate, \%kv_hash); + } + elsif (3 <= scalar (@kv)) { + print {*STDERR} "Options string has three or more components, this is a bug in $PROGRAM_NAME. Erroring out.\n"; + $error_detected = 1; + last; + } + else { + $key = shift (@kv); + $value = shift (@kv); + + # Add to hash - every hash will contain a single key-value pair only. + $kv_hash{$key} = $value; + + # Then add the hash as an entry in our return array - by reference. + push (@intermediate, \%kv_hash); + } + } + + # Special handling for the last option, which does not use a comma as the + # delimiter but a colon. + # + # Note that it can either be part of the key or the value. + if (!($error_detected)) { + if ((0 < scalar (@intermediate)) && (defined ($intermediate[0]))) { + my $last_hash_ref = pop (@intermediate); + my $hash_count = 0; + my $last_component = q{}; + my $in_value = 0; + my $last_component_key = undef; + + # Fetch last component and check for sanity. + # An empty hash is implicitly handled by initializing $last_component to + # an empty string, which will fail the splitting later on. + foreach my $key (keys %{$last_hash_ref}) { + ++$hash_count; + + if (1 < $hash_count) { + print {*STDERR} "More than one element found in last element's hash, this is a bug in $PROGRAM_NAME. Ignoring subsequent entries.\n"; + last; + } + + $last_component = $last_component_key = $key; + + if (defined ($last_hash_ref->{$key})) { + # If a value exists, the display specifier can not be part of the + # key. + $in_value = 1; + $last_component = $last_hash_ref->{$key}; + } + } + + # Don't use split() here. While we could use a more or less complex + # regex to extract the last(!) port specifier only, this would render + # the LIMIT parameter to split() useless (since additional capture + # groups are not part of the limit). + # Thus going the manual route here. + my $last_pos = rindex ($last_component, q{:}); + + if ($[ > $last_pos) { + print {*STDERR} "No display port seperator found in the options string. Erroring out.\n"; + $error_detected = 1; + } + else { + my $last_component_left = substr ($last_component, 0, $last_pos); + my $last_component_right = substr ($last_component, $last_pos); + + my %last_component_hash = (); + + if ($in_value) { + $last_component_hash{$last_component_key} = $last_component_left; + } + else { + # Sanity check on the key. If it's empty, issue a warning and don't + # use it. + if (0 == length ($last_component_left)) { + print {*STDERR} "Options string has empty component, this is deprecated. Adding empty element.\n"; + } + else { + $last_component_hash{$last_component_left} = undef; + } + } + + # Now add the last component hash to the array again. + push (@intermediate, \%last_component_hash); + + # Prepare a new hash object, with the key set to the display port part + # and value to undef to mark it invalid. + my %display_port_hash = (); + $display_port_hash{$last_component_right} = undef; + + # Add this to the return value as well. + push (@intermediate, \%display_port_hash); + } + } + } + } + + if (!($error_detected)) { + $ret = \@intermediate; + } + + return $ret; +} + +# Takes an intermediate options string representation array reference(!) and +# returns a string. +# This is essentially the opposite of parse_options. +# Parsing an options string and passing the result through this function again +# SHOULD (if initial options string has been a valid one to begin with) yield +# the initial options string again. +# On error, returns undef. +sub intermediate_to_string { + my $ret = undef; + my $error_detected = 0; + + my $options = shift; + + if ('ARRAY' ne ref ($options)) { + print {*STDERR} 'Invalid options reference type passed (' . ref ($options) . "), returning undef.\n"; + $error_detected = 1; + } + + if (!($error_detected)) { + if (1 == scalar (@{$options})) { + foreach my $entry (@{$options}) { + if (!defined ($entry)) { + print {*STDERR} "Invalid options array passed, returning undef.\n"; + $error_detected = 1; + } + } + } + } + + if (!($error_detected)) { + # Last entry should contain the display port part only. + # We can detect it through counting. + my $elements_left = @{$options}; + + # Handle entries iteratively, merging them into one string. + foreach my $entry (@{$options}) { + --$elements_left; + + if (!defined ($entry)) { + print {*STDERR} "Invalid options entry encountered, returning undef.\n"; + $error_detected = 1; + last; + } + + if ('HASH' ne ref ($entry)) { + print {*STDERR} 'Entry in array has invalid type (' . ref ($entry) ."), returning undef.\n"; + $error_detected = 1; + last; + } + + if (1 < scalar (keys (%{$entry}))) { + print {*STDERR} "More than one entry encountered in hash of current element, returning undef.\n"; + $error_detected = 1; + last; + } + + # Must be either empty or have one element, so... go for it. + if (0 == scalar (keys (%{$entry}))) { + if (0 != $elements_left) { + if (defined ($ret)) { + $ret .= q{,}; + } + else { + # Mark first entry as empty. Don't remove this, or else. + $ret = q{}; + } + } + else { + # Special handling for last element, which is always supposed to + # contain the display port. + print {*STDERR} "No entry found in display port hash, returning undef.\n"; + $error_detected = 1; + last; + } + } + else { + # This foreach loop may look weird because, at that point, we know that + # the hash contains one key exactly, but it's still an elegant way to + # fetch the key and pseudo-iterate over it. + foreach my $key (keys (%{$entry})) { + my $tmp = $key; + + if (0 != $elements_left) { + if (defined ($entry->{$key})) { + $tmp .= q{=} . $entry->{$key}; + } + } + + if (defined ($ret)) { + if (0 != $elements_left) { + $ret = join (q{,}, ($ret, $tmp)); + } + else { + $ret .= $tmp; + } + } + else { + $ret = $tmp; + } + } + } + } + } + + if ($error_detected) { + $ret = undef; + } + + return $ret; +} + +# Helper function that checks for errors in options passed as filter +# parameters (which, in turn, are the parameter this function expects). +# +# Returns true if all checks passed, false otherwise. +sub sanitize_input_filter { + my $ret = 1; + + my $work_option_key = shift; + my $work_option_value = shift; + my $cur_option = shift; + my $elems_left = shift; + + if (!((defined ($work_option_key)) && (defined ($cur_option)) && (defined ($elems_left)))) { + print {*STDERR} "Invalid options passed to filter, keeping entry.\n"; + $ret = 0; + } + + if ($ret) { + if ('HASH' ne ref ($cur_option)) { + print {*STDERR} "Option passed to filter is not a hash reference, keeping entry.\n"; + $ret = 0; + } + } + + if ($ret) { + if (1 < scalar (keys (%{$cur_option}))) { + print {*STDERR} "Option passed to filter has more than one entry in hash, keeping entry.\n"; + $ret = 0; + } + } + + return $ret; +} + +# Helper function that splits up the working option into a key and a value. +# +# Expects the working option as its only parameter. +# +# Returns a reference to an array with two entries - the key and the value. +# Caveat: the key cannot be undef (it's set to the empty string if it would +# be), but the value can be undef. +# +# In case of errors, returns a reference to undef. +sub sanitize_workoption_filter { + my $ret = undef; + my $error_detected = 0; + + my $working_option = shift; + + if (defined ($working_option)) { + my $work_key = undef; + my $work_value = undef; + my @work_kv = split (/=/smx, $working_option, 2); + + if (2 < scalar (@work_kv)) { + print {*STDERR} "Option-to-be-acted-upon string in filter has three or more components, this is a bug in $PROGRAM_NAME. Returning error.\n"; + $error_detected = 1; + } + + if (!($error_detected)) { + $work_key = shift (@work_kv); + + # Key can be undef if splitting failed, e.g., due to an empty input + # string. We don't consider this an error, so reset the key to an empty + # string. + if (!(defined ($work_key))) { + $work_key = q{}; + } + + $work_value = shift (@work_kv); + + $ret = [ $work_key, $work_value ]; + } + } + + return $ret; +} + +# Helper for a grep operation on the intermediate options array. +# +# Takes the option-to-remove's key and value, the current element and amount +# of elements left in the array as arguments and returns true if the element is +# not to be removed, false otherwise. +sub filter_option_remove { + my $ret = 1; + my $skip = 0; + my $to_remove_key = shift; + my $to_remove_value = shift; + my $cur_option = shift; + my $elems_left = shift; + + $skip = ((!(sanitize_input_filter ($to_remove_key, $to_remove_value, $cur_option, $elems_left))) + || (0 == $elems_left)); + + if (!($skip)) { + my $option_key = q{}; + my $option_value = undef; + + foreach my $tmp_option_key (keys (%{$cur_option})) { + $option_key = $tmp_option_key; + $option_value = $cur_option->{$tmp_option_key}; + } + + if ($to_remove_key eq $option_key) { + # Okay, we've got a match. But we might have to also check the value... + if (defined ($to_remove_value)) { + # Yep, value must match, too, but beware of undef values in the current + # option entry. + if ((defined ($option_value)) && ($to_remove_value eq $option_value)) { + # Everything matches, mark for removal. + $ret = 0; + } + } + else { + $ret = 0; + } + } + } + + return $ret; +} + +# Helper for a grep operation on the intermediate options array. +# +# Takes the option-to-find's key and value, the current element and amount of +# elements left in the array as arguments and returns true if the element has +# the same as the option we search for, false otherwise. +sub filter_find_key { + my $ret = 0; + my $skip = 0; + my $needle_key = shift; + my $needle_value = shift; + my $cur_option = shift; + my $elems_left = shift; + + $skip = ((!(sanitize_input_filter ($needle_key, $needle_value, $cur_option, $elems_left))) + || (0 == $elems_left)); + + if (!($skip)) { + # We don't care about the values this time around. + + my $option_key = q{}; + + foreach my $tmp_option_key (keys (%{$cur_option})) { + $option_key = $tmp_option_key; + } + + if ($option_key eq $needle_key) { + $ret = 1; + } + } + + return $ret; +} + +# Helper for a map operation on the intermediate options array. +# +# Takes the option-to-modify's key and value, the current element and amount of +# elements left in the array as arguments and returns the modified element or +# the original one, if modification was not necessary. +sub filter_option_modify { + my $skip = 0; + my $needle_key = shift; + my $needle_value = shift; + my $cur_option = shift; + my $elems_left = shift; + + my @ret = ( $cur_option ); + + $skip = ((!(sanitize_input_filter ($needle_key, $needle_value, $cur_option, $elems_left))) + || (0 == $elems_left)); + + if (!($skip)) { + my $option_key = q{}; + + foreach my $tmp_option_key (keys (%{$cur_option})) { + $option_key = $tmp_option_key; + } + + if ($option_key eq $needle_key) { + my $new_opt = { }; + + # Don't add empty options as an empty string key with undef value; even + # though that's technically legit we want to represent this situation by + # an empty hash. + if (!(($needle_key) || (defined ($needle_value)))) { + print {*STDERR} "Empty option addition/modification requested, this is deprecated. Adding empty hash.\n"; + } + else { + $new_opt->{$needle_key} = $needle_value; + } + + @ret = ( $new_opt ); + } + } + + return @ret; +} + +# Removes from, adds to or modifies an entry in the intermediate options array. +# +# Expects an intermediate options reference as its first parameter, a boolean +# value which should be set to true for removals or false for +# modifications/additions and the option-to-be-modified as a third parameter. +# +# For removals, the function behaves like this: +# - If only a key is specified, removes any entry that matches this key, +# regardless of its value. +# - If both a key and a value are specified, only matching combinations will +# be removed from the array. That is, if the array already contains such a +# key with either no value or a different value, it will be unaffected. +# +# Additions or modifications are handled like this: +# - If a given key is part of the intermediate representation, all such +# occurrences will be replaced by the new value. +# - Otherwise, the new value will be added at the end of the intermediate +# representation. +# +# Returns a reference to a modified *copy* of the intermediate options array. +# +# On error, returns a reference to undef. +sub transform_intermediate { + my $ret = undef; + my $error_detected = 0; + + my $options = shift; + my $remove = shift; + my $option = shift; + + if ('ARRAY' ne ref ($options)) { + print {*STDERR} 'Invalid options reference type passed (' . ref ($options) . "), erroring out.\n"; + $error_detected = 1; + } + + if (!($error_detected)) { + if (1 == scalar (@{$options})) { + foreach my $entry (@{$options}) { + if (!defined ($entry)) { + print {*STDERR} "Invalid options array passed, erroring out.\n"; + $error_detected = 1; + } + } + } + } + + if (!($error_detected)) { + if (!(defined ($remove))) { + print {*STDERR} "Invalid mode option boolean passed, erroring out.\n"; + $error_detected = 1; + } + } + + if (!($error_detected)) { + if (!(defined ($option))) { + print {*STDERR} "No or invalid new option passed, erroring out.\n"; + $error_detected = 1; + } + } + + my $work_option_key = undef; + my $work_option_value = undef; + + if (!($error_detected)) { + my $work_opt_kv = sanitize_workoption_filter ($option); + + if (!(defined ($work_opt_kv))) { + print {*STDERR} "Unable to split up working option into key and value pair, returning undef.\n"; + $error_detected = 1; + } + else { + $work_option_key = shift (@{$work_opt_kv}); + $work_option_value = shift (@{$work_opt_kv}); + } + } + + if (!($error_detected)) { + # Set return value to a *deep copy* of our original array. + $ret = dclone ($options); + + my $elements_left = @{$ret}; + + if ($remove) { + # Let the filter function handle the actual work. + @{$ret} = grep { filter_option_remove ($work_option_key, $work_option_value, $_, --$elements_left) } (@{$ret}); + + # Check to see if the intermediate representation is empty now (save for + # the display port entry) and add an empty element if it is. + if (1 == scalar (@{$ret})) { + print {*STDERR} "Removal operation led to option string being empty, adding empty element though deprecated.\n"; + unshift (@{$ret}, { }); + } + } + else { + # Yes, grep () isn't a great choice for a boolean comparison. It will do + # what we need just fine, but doesn't short-circuit after finding the + # first match, hence uselessly continuing through the full array. + # List::MoreUtils::any would be more appropriate here, but this would add + # another dependency and option strings are pretty small, so don't + # overoptimize here. + if (scalar (grep { filter_find_key ($work_option_key, $work_option_value, $_, --$elements_left) } (@{$ret}))) { + # Such an option already exists, we'll modify all occurrences. + $elements_left = @{$ret}; + $ret = [ map { filter_option_modify ($work_option_key, $work_option_value, $_, --$elements_left) } (@{$ret}) ]; + } + else { + my $new_opt = { $work_option_key => $work_option_value }; + + # No such option exists, we'll add it to the end of the current + # options. + # At least in theory. Practically, there's one special case: if the + # only "real" element is an empty one, for instance because the option + # string was empty to begin with save the display port specifier, then + # we want to replace this option instead. + if ((2 == scalar (@{$ret})) && (!(scalar (keys (%{$ret->[0]}))))) { + splice (@{$ret}, 0, 1, $new_opt); + } + else { + splice (@{$ret}, -1, 0, $new_opt); + } + } + } + } + + return $ret; +} + +# Helper function "interpreting" a transformation string. +# +# Takes the raw transformation string as its only parameter. +# +# Returns an array reference containing two elements: the transformation mode +# and a sanitized version of the transformation string, suitable for passing to +# transform_intermediate (). +# +# On error, returns undef. +sub interpret_transform { + my $ret = undef; + + my $transform = shift; + + if (defined ($transform)) { + my $mode = 0; + my $sanitized_transform = $transform; + + # Check if non-empty, empty transform strings can only mean an + # append/modify operation. + if ($transform) { + if (q{-} eq substr ($transform, 0, 1)) { + # Option starts with a dash, so must be a removal operation. + $mode = 1; + $sanitized_transform = substr ($sanitized_transform, 1); + } + elsif ((q{+}) eq substr ($transform, 0, 1)) { + # Options starting with a plus character are add/modify operations. The + # default mode option here is fine, but we'll need to strip the initial + # character. + $sanitized_transform = substr ($sanitized_transform, 1); + } + + # Everything else does not feature an explicit modifier, so we can take + # the transformation string verbatim. + # No need to actually do anything here, handled by the initialization. + } + + # Set up return value accordingly. + $ret = [ $mode, $sanitized_transform ]; + } + + return $ret; +} + 1; diff --git a/debian/changelog b/debian/changelog index d27e1b9a..71fad52d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -193,6 +193,8 @@ x2goserver (4.1.0.4-0x2go1.2) UNRELEASED; urgency=medium version of the options string manipulation code. - x2goserver/lib/x2goupdateoptionsstring: fix man page specification, options string was missing. + - x2goserver/lib/x2goupdateoptionsstring: move most code to + X2Go/Server/Agent/NX/Options.pm. * debian/control: + Build-depend upon lsb-release for distro version detection. * debian/x2goserver.manpages: diff --git a/x2goserver/bin/x2goupdateoptionsstring b/x2goserver/bin/x2goupdateoptionsstring index 6eefec9b..c472704f 100755 --- a/x2goserver/bin/x2goupdateoptionsstring +++ b/x2goserver/bin/x2goupdateoptionsstring @@ -29,6 +29,7 @@ use Getopt::Long qw (GetOptionsFromArray); use Pod::Usage; use Storable qw (dclone); use Data::Dumper qw (Dumper); +use X2Go::Server::Agent::NX::Options; exit (Main (@ARGV)); @@ -37,637 +38,6 @@ BEGIN { # No code past this point should be getting executed! -# Accepts an option string and returns a reference to an array of hashes -# (actually hash references) corresponding to the parsed key-value pairs. -# -# Empty components are allowed, but will issue a warning message. In such a -# case, the hash at the corresponding array position will be empty. -# -# Keys that do not have a value assigned will be given a value of "undef" in -# order to be able to distinguish them from keys with an empty string as their -# value. -# -# Caveat: the last component will be split from the port definition. DO NOT -# SIMPLY JOIN THE LIST OR YOU WILL ADD A TRAILING COMMA! The port component -# hash retains the colon separator. -# -# On error, returns an undef reference. -sub parse_options { - my $ret = undef; - my @intermediate = (); - my $error_detected = 0; - my $options = shift; - my $next_discard = shift; - - if (defined ($next_discard)) { - print {*STDERR} "Multiple arguments passed in, all but the first one are ignored!\n"; - } - - if (!(defined ($options))) { - print {*STDERR} "No argument provided for options string, returning undef.\n"; - $error_detected = 1; - } - - if (!($error_detected)) { - my @components = split (/,/sxm, $options, -1); - foreach my $option (@components) { - # We use undef to denote that some component was not provided at all - # to disambiguate non-provided and empty strings. - my ($key, $value) = (undef, undef); - my %kv_hash = (); - - my @kv = split (/=/sxm, $option, 2); - - if (1 > scalar (@kv)) { - print {*STDERR} "Options string has empty component, this is deprecated. Adding empty element.\n"; - - push (@intermediate, \%kv_hash); - } - elsif (3 <= scalar (@kv)) { - print {*STDERR} "Options string has three or more components, this is a bug in $PROGRAM_NAME. Erroring out.\n"; - $error_detected = 1; - last; - } - else { - $key = shift (@kv); - $value = shift (@kv); - - # Add to hash - every hash will contain a single key-value pair only. - $kv_hash{$key} = $value; - - # Then add the hash as an entry in our return array - by reference. - push (@intermediate, \%kv_hash); - } - } - - # Special handling for the last option, which does not use a comma as the - # delimiter but a colon. - # - # Note that it can either be part of the key or the value. - if (!($error_detected)) { - if ((0 < scalar (@intermediate)) && (defined ($intermediate[0]))) { - my $last_hash_ref = pop (@intermediate); - my $hash_count = 0; - my $last_component = q{}; - my $in_value = 0; - my $last_component_key = undef; - - # Fetch last component and check for sanity. - # An empty hash is implicitly handled by initializing $last_component to - # an empty string, which will fail the splitting later on. - foreach my $key (keys %{$last_hash_ref}) { - ++$hash_count; - - if (1 < $hash_count) { - print {*STDERR} "More than one element found in last element's hash, this is a bug in $PROGRAM_NAME. Ignoring subsequent entries.\n"; - last; - } - - $last_component = $last_component_key = $key; - - if (defined ($last_hash_ref->{$key})) { - # If a value exists, the display specifier can not be part of the - # key. - $in_value = 1; - $last_component = $last_hash_ref->{$key}; - } - } - - # Don't use split() here. While we could use a more or less complex - # regex to extract the last(!) port specifier only, this would render - # the LIMIT parameter to split() useless (since additional capture - # groups are not part of the limit). - # Thus going the manual route here. - my $last_pos = rindex ($last_component, q{:}); - - if ($[ > $last_pos) { - print {*STDERR} "No display port seperator found in the options string. Erroring out.\n"; - $error_detected = 1; - } - else { - my $last_component_left = substr ($last_component, 0, $last_pos); - my $last_component_right = substr ($last_component, $last_pos); - - my %last_component_hash = (); - - if ($in_value) { - $last_component_hash{$last_component_key} = $last_component_left; - } - else { - # Sanity check on the key. If it's empty, issue a warning and don't - # use it. - if (0 == length ($last_component_left)) { - print {*STDERR} "Options string has empty component, this is deprecated. Adding empty element.\n"; - } - else { - $last_component_hash{$last_component_left} = undef; - } - } - - # Now add the last component hash to the array again. - push (@intermediate, \%last_component_hash); - - # Prepare a new hash object, with the key set to the display port part - # and value to undef to mark it invalid. - my %display_port_hash = (); - $display_port_hash{$last_component_right} = undef; - - # Add this to the return value as well. - push (@intermediate, \%display_port_hash); - } - } - } - } - - if (!($error_detected)) { - $ret = \@intermediate; - } - - return $ret; -} - -# Takes an intermediate options string representation array reference(!) and -# returns a string. -# This is essentially the opposite of parse_options. -# Parsing an options string and passing the result through this function again -# SHOULD (if initial options string has been a valid one to begin with) yield -# the initial options string again. -# On error, returns undef. -sub intermediate_to_string { - my $ret = undef; - my $error_detected = 0; - - my $options = shift; - - if ('ARRAY' ne ref ($options)) { - print {*STDERR} 'Invalid options reference type passed (' . ref ($options) . "), returning undef.\n"; - $error_detected = 1; - } - - if (!($error_detected)) { - if (1 == scalar (@{$options})) { - foreach my $entry (@{$options}) { - if (!defined ($entry)) { - print {*STDERR} "Invalid options array passed, returning undef.\n"; - $error_detected = 1; - } - } - } - } - - if (!($error_detected)) { - # Last entry should contain the display port part only. - # We can detect it through counting. - my $elements_left = @{$options}; - - # Handle entries iteratively, merging them into one string. - foreach my $entry (@{$options}) { - --$elements_left; - - if (!defined ($entry)) { - print {*STDERR} "Invalid options entry encountered, returning undef.\n"; - $error_detected = 1; - last; - } - - if ('HASH' ne ref ($entry)) { - print {*STDERR} 'Entry in array has invalid type (' . ref ($entry) ."), returning undef.\n"; - $error_detected = 1; - last; - } - - if (1 < scalar (keys (%{$entry}))) { - print {*STDERR} "More than one entry encountered in hash of current element, returning undef.\n"; - $error_detected = 1; - last; - } - - # Must be either empty or have one element, so... go for it. - if (0 == scalar (keys (%{$entry}))) { - if (0 != $elements_left) { - if (defined ($ret)) { - $ret .= q{,}; - } - else { - # Mark first entry as empty. Don't remove this, or else. - $ret = q{}; - } - } - else { - # Special handling for last element, which is always supposed to - # contain the display port. - print {*STDERR} "No entry found in display port hash, returning undef.\n"; - $error_detected = 1; - last; - } - } - else { - # This foreach loop may look weird because, at that point, we know that - # the hash contains one key exactly, but it's still an elegant way to - # fetch the key and pseudo-iterate over it. - foreach my $key (keys (%{$entry})) { - my $tmp = $key; - - if (0 != $elements_left) { - if (defined ($entry->{$key})) { - $tmp .= q{=} . $entry->{$key}; - } - } - - if (defined ($ret)) { - if (0 != $elements_left) { - $ret = join (q{,}, ($ret, $tmp)); - } - else { - $ret .= $tmp; - } - } - else { - $ret = $tmp; - } - } - } - } - } - - if ($error_detected) { - $ret = undef; - } - - return $ret; -} - -# Helper function that checks for errors in options passed as filter -# parameters (which, in turn, are the parameter this function expects). -# -# Returns true if all checks passed, false otherwise. -sub sanitize_input_filter { - my $ret = 1; - - my $work_option_key = shift; - my $work_option_value = shift; - my $cur_option = shift; - my $elems_left = shift; - - if (!((defined ($work_option_key)) && (defined ($cur_option)) && (defined ($elems_left)))) { - print {*STDERR} "Invalid options passed to filter, keeping entry.\n"; - $ret = 0; - } - - if ($ret) { - if ('HASH' ne ref ($cur_option)) { - print {*STDERR} "Option passed to filter is not a hash reference, keeping entry.\n"; - $ret = 0; - } - } - - if ($ret) { - if (1 < scalar (keys (%{$cur_option}))) { - print {*STDERR} "Option passed to filter has more than one entry in hash, keeping entry.\n"; - $ret = 0; - } - } - - return $ret; -} - -# Helper function that splits up the working option into a key and a value. -# -# Expects the working option as its only parameter. -# -# Returns a reference to an array with two entries - the key and the value. -# Caveat: the key cannot be undef (it's set to the empty string if it would -# be), but the value can be undef. -# -# In case of errors, returns a reference to undef. -sub sanitize_workoption_filter { - my $ret = undef; - my $error_detected = 0; - - my $working_option = shift; - - if (defined ($working_option)) { - my $work_key = undef; - my $work_value = undef; - my @work_kv = split (/=/smx, $working_option, 2); - - if (2 < scalar (@work_kv)) { - print {*STDERR} "Option-to-be-acted-upon string in filter has three or more components, this is a bug in $PROGRAM_NAME. Returning error.\n"; - $error_detected = 1; - } - - if (!($error_detected)) { - $work_key = shift (@work_kv); - - # Key can be undef if splitting failed, e.g., due to an empty input - # string. We don't consider this an error, so reset the key to an empty - # string. - if (!(defined ($work_key))) { - $work_key = q{}; - } - - $work_value = shift (@work_kv); - - $ret = [ $work_key, $work_value ]; - } - } - - return $ret; -} - -# Helper for a grep operation on the intermediate options array. -# -# Takes the option-to-remove's key and value, the current element and amount -# of elements left in the array as arguments and returns true if the element is -# not to be removed, false otherwise. -sub filter_option_remove { - my $ret = 1; - my $skip = 0; - my $to_remove_key = shift; - my $to_remove_value = shift; - my $cur_option = shift; - my $elems_left = shift; - - $skip = ((!(sanitize_input_filter ($to_remove_key, $to_remove_value, $cur_option, $elems_left))) - || (0 == $elems_left)); - - if (!($skip)) { - my $option_key = q{}; - my $option_value = undef; - - foreach my $tmp_option_key (keys (%{$cur_option})) { - $option_key = $tmp_option_key; - $option_value = $cur_option->{$tmp_option_key}; - } - - if ($to_remove_key eq $option_key) { - # Okay, we've got a match. But we might have to also check the value... - if (defined ($to_remove_value)) { - # Yep, value must match, too, but beware of undef values in the current - # option entry. - if ((defined ($option_value)) && ($to_remove_value eq $option_value)) { - # Everything matches, mark for removal. - $ret = 0; - } - } - else { - $ret = 0; - } - } - } - - return $ret; -} - -# Helper for a grep operation on the intermediate options array. -# -# Takes the option-to-find's key and value, the current element and amount of -# elements left in the array as arguments and returns true if the element has -# the same as the option we search for, false otherwise. -sub filter_find_key { - my $ret = 0; - my $skip = 0; - my $needle_key = shift; - my $needle_value = shift; - my $cur_option = shift; - my $elems_left = shift; - - $skip = ((!(sanitize_input_filter ($needle_key, $needle_value, $cur_option, $elems_left))) - || (0 == $elems_left)); - - if (!($skip)) { - # We don't care about the values this time around. - - my $option_key = q{}; - - foreach my $tmp_option_key (keys (%{$cur_option})) { - $option_key = $tmp_option_key; - } - - if ($option_key eq $needle_key) { - $ret = 1; - } - } - - return $ret; -} - -# Helper for a map operation on the intermediate options array. -# -# Takes the option-to-modify's key and value, the current element and amount of -# elements left in the array as arguments and returns the modified element or -# the original one, if modification was not necessary. -sub filter_option_modify { - my $skip = 0; - my $needle_key = shift; - my $needle_value = shift; - my $cur_option = shift; - my $elems_left = shift; - - my @ret = ( $cur_option ); - - $skip = ((!(sanitize_input_filter ($needle_key, $needle_value, $cur_option, $elems_left))) - || (0 == $elems_left)); - - if (!($skip)) { - my $option_key = q{}; - - foreach my $tmp_option_key (keys (%{$cur_option})) { - $option_key = $tmp_option_key; - } - - if ($option_key eq $needle_key) { - my $new_opt = { }; - - # Don't add empty options as an empty string key with undef value; even - # though that's technically legit we want to represent this situation by - # an empty hash. - if (!(($needle_key) || (defined ($needle_value)))) { - print {*STDERR} "Empty option addition/modification requested, this is deprecated. Adding empty hash.\n"; - } - else { - $new_opt->{$needle_key} = $needle_value; - } - - @ret = ( $new_opt ); - } - } - - return @ret; -} - -# Removes from, adds to or modifies an entry in the intermediate options array. -# -# Expects an intermediate options reference as its first parameter, a boolean -# value which should be set to true for removals or false for -# modifications/additions and the option-to-be-modified as a third parameter. -# -# For removals, the function behaves like this: -# - If only a key is specified, removes any entry that matches this key, -# regardless of its value. -# - If both a key and a value are specified, only matching combinations will -# be removed from the array. That is, if the array already contains such a -# key with either no value or a different value, it will be unaffected. -# -# Additions or modifications are handled like this: -# - If a given key is part of the intermediate representation, all such -# occurrences will be replaced by the new value. -# - Otherwise, the new value will be added at the end of the intermediate -# representation. -# -# Returns a reference to a modified *copy* of the intermediate options array. -# -# On error, returns a reference to undef. -sub transform_intermediate { - my $ret = undef; - my $error_detected = 0; - - my $options = shift; - my $remove = shift; - my $option = shift; - - if ('ARRAY' ne ref ($options)) { - print {*STDERR} 'Invalid options reference type passed (' . ref ($options) . "), erroring out.\n"; - $error_detected = 1; - } - - if (!($error_detected)) { - if (1 == scalar (@{$options})) { - foreach my $entry (@{$options}) { - if (!defined ($entry)) { - print {*STDERR} "Invalid options array passed, erroring out.\n"; - $error_detected = 1; - } - } - } - } - - if (!($error_detected)) { - if (!(defined ($remove))) { - print {*STDERR} "Invalid mode option boolean passed, erroring out.\n"; - $error_detected = 1; - } - } - - if (!($error_detected)) { - if (!(defined ($option))) { - print {*STDERR} "No or invalid new option passed, erroring out.\n"; - $error_detected = 1; - } - } - - my $work_option_key = undef; - my $work_option_value = undef; - - if (!($error_detected)) { - my $work_opt_kv = sanitize_workoption_filter ($option); - - if (!(defined ($work_opt_kv))) { - print {*STDERR} "Unable to split up working option into key and value pair, returning undef.\n"; - $error_detected = 1; - } - else { - $work_option_key = shift (@{$work_opt_kv}); - $work_option_value = shift (@{$work_opt_kv}); - } - } - - if (!($error_detected)) { - # Set return value to a *deep copy* of our original array. - $ret = dclone ($options); - - my $elements_left = @{$ret}; - - if ($remove) { - # Let the filter function handle the actual work. - @{$ret} = grep { filter_option_remove ($work_option_key, $work_option_value, $_, --$elements_left) } (@{$ret}); - - # Check to see if the intermediate representation is empty now (save for - # the display port entry) and add an empty element if it is. - if (1 == scalar (@{$ret})) { - print {*STDERR} "Removal operation led to option string being empty, adding empty element though deprecated.\n"; - unshift (@{$ret}, { }); - } - } - else { - # Yes, grep () isn't a great choice for a boolean comparison. It will do - # what we need just fine, but doesn't short-circuit after finding the - # first match, hence uselessly continuing through the full array. - # List::MoreUtils::any would be more appropriate here, but this would add - # another dependency and option strings are pretty small, so don't - # overoptimize here. - if (scalar (grep { filter_find_key ($work_option_key, $work_option_value, $_, --$elements_left) } (@{$ret}))) { - # Such an option already exists, we'll modify all occurrences. - $elements_left = @{$ret}; - $ret = [ map { filter_option_modify ($work_option_key, $work_option_value, $_, --$elements_left) } (@{$ret}) ]; - } - else { - my $new_opt = { $work_option_key => $work_option_value }; - - # No such option exists, we'll add it to the end of the current - # options. - # At least in theory. Practically, there's one special case: if the - # only "real" element is an empty one, for instance because the option - # string was empty to begin with save the display port specifier, then - # we want to replace this option instead. - if ((2 == scalar (@{$ret})) && (!(scalar (keys (%{$ret->[0]}))))) { - splice (@{$ret}, 0, 1, $new_opt); - } - else { - splice (@{$ret}, -1, 0, $new_opt); - } - } - } - } - - return $ret; -} - -# Helper function "interpreting" a transformation string. -# -# Takes the raw transformation string as its only parameter. -# -# Returns an array reference containing two elements: the transformation mode -# and a sanitized version of the transformation string, suitable for passing to -# transform_intermediate (). -# -# On error, returns undef. -sub interpret_transform { - my $ret = undef; - - my $transform = shift; - - if (defined ($transform)) { - my $mode = 0; - my $sanitized_transform = $transform; - - # Check if non-empty, empty transform strings can only mean an - # append/modify operation. - if ($transform) { - if (q{-} eq substr ($transform, 0, 1)) { - # Option starts with a dash, so must be a removal operation. - $mode = 1; - $sanitized_transform = substr ($sanitized_transform, 1); - } - elsif ((q{+}) eq substr ($transform, 0, 1)) { - # Options starting with a plus character are add/modify operations. The - # default mode option here is fine, but we'll need to strip the initial - # character. - $sanitized_transform = substr ($sanitized_transform, 1); - } - - # Everything else does not feature an explicit modifier, so we can take - # the transformation string verbatim. - # No need to actually do anything here, handled by the initialization. - } - - # Set up return value accordingly. - $ret = [ $mode, $sanitized_transform ]; - } - - return $ret; -} - # Helper function handling unknown options or ignoring the well-known # separator. It scans for options until hitting the first non-option entry. # @@ -814,7 +184,7 @@ sub Main { print {*STDERR} 'Fetched options string as: ' . Dumper (\$options); } - $intermediate = parse_options ($options); + $intermediate = X2Go::Server::Agent::NX::Options::parse_options ($options); if (!(defined ($intermediate))) { print {*STDERR} "Unable to parse option string, aborting.\n"; @@ -860,7 +230,7 @@ sub Main { print {*STDERR} 'Parsing current raw transformation option: ' . Dumper ($cur_transform); } - my $interpreted_transform_ref = interpret_transform ($cur_transform); + my $interpreted_transform_ref = X2Go::Server::Agent::NX::Options::interpret_transform ($cur_transform); if (!(defined ($interpreted_transform_ref))) { print {*STDERR} "Invalid transformation passed, aborting.\n"; @@ -874,7 +244,7 @@ sub Main { print {*STDERR} 'Parsed raw transformation option into mode \'' . $transform_mode . '\' and sanitized transform option \'' . Dumper ($sanitized_transform) . "'\n"; } - $intermediate = transform_intermediate ($intermediate, $transform_mode, $sanitized_transform); + $intermediate = X2Go::Server::Agent::NX::Options::transform_intermediate ($intermediate, $transform_mode, $sanitized_transform); if (!(defined ($intermediate))) { print {*STDERR} "Error while transforming intermediate representation, aborting.\n"; @@ -904,7 +274,7 @@ sub Main { my $out = undef; if (!($error_detected)) { - $out = intermediate_to_string ($intermediate); + $out = X2Go::Server::Agent::NX::Options::intermediate_to_string ($intermediate); if (!(defined ($out))) { print {*STDERR} "Unable to transform intermediate back into string, aborting.\n"; -- Alioth's /home/x2go-admin/maintenancescripts/git/hooks/post-receive-email on /srv/git/code.x2go.org/x2goserver.git