[X2Go-Commits] [x2goserver] 08/99: x2goserver/lib/x2goupdateoptionsstring: move most code to X2Go/Server/Agent/NX/Options.pm.
git-admin at x2go.org
git-admin at x2go.org
Mon Dec 28 06:10:36 CET 2020
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 at 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
More information about the x2go-commits
mailing list