#!/usr/bin/perl

# Copyright (C) 2018-2023 X2Go Project - https://wiki.x2go.org
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.

# Disable some Perl::Critic violations.
#
# I like parentheses.
## no critic (ProhibitParensWithBuiltins)
#
# It's recommended not to use the constant pragma, but we don't want to use
# non-core modules like Readonly.
## no critic (ValuesAndExpressions::ProhibitConstantPragma)

use strict;
use warnings;

# Enable full Unicode handling, if possible.
use 5.012;

# Enable UTF-8 encoded data in the script itself.
use utf8;

# Make text coding issues fatal.
use warnings  qw (FATAL utf8);

#use X2Go::Utils qw (is_int);
use English qw (-no_match_vars);
use Getopt::Long qw (GetOptionsFromArray);
use Pod::Usage;
use Storable qw (dclone);
use Data::Dumper qw (Dumper);
use X2Go::Server::Agent::NX::Options;
use MIME::Base64 qw (encode_base64);
use List::Util qw (max);
use Encode qw (encode decode);
use Encode::Locale;

# Set up automatic encoding.
if (-t STDIN) {
  binmode STDIN,  ":encoding(console_in)";
}
if (-t STDOUT) {
  binmode STDOUT, ":encoding(console_out)";
}
if (-t STDERR) {
  binmode STDERR, ":encoding(console_out)";
}

# Convert data in ARGV.
exit (Main (map { Encode::decode (locale => $_, (Encode::FB_CROAK | Encode::LEAVE_SRC)); } @ARGV));

BEGIN {
}

# No code past this point should be getting executed!

# These are actually supposed to be enums, but since Perl doesn't have a
# proper way of creating enums (at least not natively), we'll emulate that
# using list constants.
# The syntax is ( q{stringified mode name}, enum_value ).
#
# Make sure that enum_value is always a power of two!
use constant MODE_INVALID_DATA => ( q{invalid}, 0 );
use constant MODE_TRANSFORM_DATA => ( q{transform}, 1 );
use constant MODE_EXTRACT_DATA => ( q{extract}, 2 );
use constant MODES => ( \&MODE_TRANSFORM_DATA, \&MODE_EXTRACT_DATA );

# Helper function handling unknown options or ignoring the well-known
# separator. It scans for options until hitting the first non-option entry.
#
# Takes an array reference with unparsed options and a boolean value denoting
# whether the separating "--" pseudo-option should be skipped or not as its
# parameters.
#
# Returns an array reference containing a boolean value denoting whether a
# separating "--" pseudo-option has been found *and* skipping it was requested,
# and the sanitized version of the original array reference.
#
# On error, returns undef.
sub sanitize_program_options {
  my $ret = undef;
  my $error_detected = 0;
  my $found_separator = 0;

  my $args = shift;
  my $skip_separator = shift;

  if ((!(defined ($args))) || ('ARRAY' ne ref ($args))) {
    print {*STDERR} "Invalid argument array reference passed to program sanitization helper, erroring out.\n";
    $error_detected = 1;
  }

  if (!($error_detected)) {
    if (!(defined ($skip_separator))) {
      print {*STDERR} "No skip-separator parameter passed to program sanitization helper, erroring out.\n";
      $error_detected = 1;
    }
  }

  if (!($error_detected)) {
    $args = Storable::dclone ($args);

    ## no critic (ControlStructures::ProhibitCStyleForLoops)
    for (my $cur_arg = shift (@{$args}); defined ($cur_arg); $cur_arg = shift (@{$args})) {
    ## critic (ControlStructures::ProhibitCStyleForLoops)
      if (q{-} eq substr ($cur_arg, 0, 1)) {
        # Looks like an option so far. Let's continue scanning.

        if (1 == length ($cur_arg)) {
          # But isn't a real option. Add back to argument list and stop
          # processing.
          unshift (@{$args}, $cur_arg);
          last;
        }
        elsif ((2 == length ($cur_arg)) && (q{-} eq substr ($cur_arg, 1, 1))) {
          if ($skip_separator) {
            # Found separating "--" pseudo-option, but skipping requested. Only
            # set the boolean value for our return value and make sure that we
            # don't skip another separating pseudo-option if it comes up again
            # right next to this one.
            $found_separator = 1;
            $skip_separator = 0;
          }
          else {
            # Not skipping separating "--" pseudo-option - i.e., we'll treat this
            # as a non-option.
            unshift (@{$args}, $cur_arg);
            last;
          }
        }
        else {
          # Otherwise this is an actual option.
          # We either want to error out, if no previous separating "--"
          # pseudo-option was found, or ignore it.
          # The weird 0 + (...) construct here is forcing an arithmetic
          # context. Otherwise, the interpreter might use a string context,
          # in which the value "0" is dualvar'd to both an arithmetic 0 and
          # an empty string.
          my $separator_found = (0 + ((!($skip_separator)) | ($found_separator)));
          if ($separator_found) {
            # Put back into array. We'll handle this as not-an-option.
            unshift (@{$args}, $cur_arg);
            last;
          }
          else {
            print {*STDERR} q{Unknown option encountered: } . $cur_arg . "; erroring out.\n";
            $error_detected = 1;
            last;
          }
        }
      }
      else {
        # Definitely not an option, add back to array.
        unshift (@{$args}, $cur_arg);
        last;
      }
    }
  }

  if (!($error_detected)) {
    $ret = [ $found_separator, $args ];
  }

  return $ret;
}

# Helper function handling mode abbreviations.
#
# Takes a string, which represents a (potentially abbreviated) mode name as
# its only parameter.
#
# Returns an array reference containing a count, denoting how often the
# abbreviated mode matched the known modes and a reference to an internal mode
# element.
#
# On error, returns undef.
sub handle_mode_abbrev {
  my $ret = undef;
  my $error_detected = 0;
  my $found = 0;
  my $mode_parse = \&MODE_INVALID_DATA;

  my $mode = shift;

  if (!(defined ($mode))) {
    print {*STDERR} "Invalid mode argument passed to mode abbreviation selection helper, erroring out.\n";
    $error_detected = 1;
  }

  if (!($error_detected)) {
    my $length = length ($mode);

    if ($length < List::Util::max (map { length ((&{$_}())[0]); } (MODES))) {
      foreach my $elem (MODES) {
        if (substr ((&{$elem}())[0], 0, $length) eq $mode) {
          if (!($found)) {
            $mode_parse = $elem;
          }
          ++$found;
        }
      }
    }

    $ret = [ $found, $mode_parse ];
  }

  return $ret;
}

# Helper function handling the parsing and setting of program modes.
#
# Takes a string, which represents a (potentially abbreviated) mode name, a
# boolean denoting transformation mode and a boolean denoting extract mode as
# its parameters.
#
# Returns a mode enum element.
#
# On error, returns the mode number corresponding to MODE_INVALID.
sub handle_mode {
  my $ret = (MODE_INVALID_DATA)[1];
  my $error_detected = 0;
  my $mode_aggregate = 0;
  my $mode_parse = \&MODE_INVALID_DATA;

  my $mode = shift;
  my $transform = shift;
  my $extract = shift;

  if (!(defined ($mode))) {
    print {*STDERR} "Invalid mode argument passed to mode selection helper, erroring out.\n";
    $error_detected = 1;
  }

  if ((!($error_detected)) && (!(defined ($transform)))) {
    print {*STDERR} "Invalid transformation argument passed to mode selection helper, erroring out.\n";
    $error_detected = 1;
  }

  if ((!($error_detected)) && (!(defined ($extract)))) {
    print {*STDERR} "Invalid extract argument passed to mode selection helper, erroring out.\n";
    $error_detected = 1;
  }

  if (!($error_detected)) {
    # Next check for mutual exclusiveness regarding modes.
    if ($transform) {
      $mode_aggregate |= (&{(MODES)[0]}())[1];
    }

    if ($extract) {
      $mode_aggregate |= (&{(MODES)[1]}())[1];
    }

    if (($mode_aggregate) && ($mode_aggregate & ($mode_aggregate - 1))) {
      print {*STDERR} "Mutually exclusive modes specified, erroring out.\n";
      $error_detected = 1;
    }
  }

  if (!($error_detected)) {
    if ($mode ne q{}) {
      # Mode has been passed, support substrings of the actual modes.
      my $found = 0;

      my %modes = ();
      foreach my $elem (MODES) {
        $modes{(&{$elem}())[0]} = 1;
      }

      my $abbrev_ret = handle_mode_abbrev ($mode);

      if (!(defined ($abbrev_ret))) {
        print {*STDERR} 'Unable to parse given mode (' . $mode . ") as an abbreviation, erroring out.\n";
        $error_detected = 1;
      }
      elsif (2 != scalar (@{$abbrev_ret})) {
        print {*STDERR} 'Return value of abbreviation parsing for mode (' . $mode . ") has a wrong format, erroring out.\n";
        $error_detected = 1;
      }
      else {
        # Check data.
        my $first_reftype = ref ($abbrev_ret->[0]);
        my $second_reftype = ref ($abbrev_ret->[1]);
        if ((q{} ne $first_reftype) || (q{CODE} ne $second_reftype)) {
          print {*STDERR} 'Return value of abbreviation parsing for mode (' . $mode . ") has a wrong format.\n";
          print {*STDERR} 'Expected scalar (empty string), got "' . $first_reftype . '" and CODE, got "' . $second_reftype . q{"} . "\n";
          print {*STDERR} "Erroring out.\n";
          $error_detected = 1;
        }
        else {
          # Unpack return data.
          $found = shift (@{$abbrev_ret});
          $mode_parse = shift (@{$abbrev_ret});
        }
      }

      # Now check if value matches a known one.
      if ((!($error_detected)) && (!($found))) {
        foreach my $elem (MODES) {
          if (exists ($modes{(&{$elem}())[0]})) {
            $mode_parse = $elem;
            $found = 1;
            last;
          }
        }
      }

      if (!($error_detected)) {
        if (!($found)) {
          print {*STDERR} 'Invalid mode specified (' . $mode . "), erroring out.\n";
          $error_detected = 1;
        }
        elsif (1 < $found) {
          print {*STDERR} 'Supplied mode (' . $mode . ") is ambiguous, erroring out.\n";
          $error_detected = 1;
        }
      }
    }
    elsif ((!($transform)) && (!($extract))) {
      # No mode explicitly passed in, default to transformation mode.
      $mode_aggregate |= (&{(MODES)[0]}())[1];
    }
  }

  # Okay, now check for mutual exclusiveness and map to return value.
  if (!($error_detected)) {
    $ret = ($mode_aggregate | (&{$mode_parse}())[1]);

    if (($ret) && ($ret & ($ret - 1))) {
      print {*STDERR} "Mutually exclusive modes specified, erroring out.\n";
      $error_detected = 1;
    }
  }

  if ($error_detected) {
    $ret = (MODE_INVALID_DATA)[1];
  }

  return $ret;
}

# Helper function applying a transformation to an intermediate options string.
#
# Takes an intermediate options string, a transformation string and a boolean
# value indicating whether debugging is turned on or off as its parameters.
#
# Returns a modified intermediate options string.
#
# On error, returns undef.
sub apply_transformation {
  my $ret = undef;
  my $error_detected = 0;

  my $intermediate = shift;
  my $transform = shift;
  my $debug = shift;

  if (!(defined ($intermediate))) {
    print {*STDERR} "Invalid intermediate argument passed to transformation helper, erroring out.\n";
    $error_detected = 1;
  }

  if ((!($error_detected)) && (!(defined ($transform)))) {
    print {*STDERR} "Invalid transformation argument passed to transformation helper, erroring out.\n";
    $error_detected = 1;
  }

  if ((!($error_detected)) && (!(defined ($debug)))) {
    print {*STDERR} "Invalid debug argument passed to transformation helper, erroring out.\n";
    $error_detected = 1;
  }

  my $interpreted_transform_ref = undef;

  if (!($error_detected)) {
    if ($debug) {
      print {*STDERR} 'Parsing current raw transformation option: ' . Data::Dumper::Dumper ($transform);
    }

    $interpreted_transform_ref = X2Go::Server::Agent::NX::Options::interpret_transform ($transform);

    if (!(defined ($interpreted_transform_ref))) {
      print {*STDERR} "Invalid transformation passed, aborting.\n";
      $error_detected = 1;
    }
  }

  if (!($error_detected)) {
    my ($transform_mode, $sanitized_transform) = @{$interpreted_transform_ref};

    if ($debug) {
      print {*STDERR} 'Parsed raw transformation option into mode \'' . $transform_mode . '\' and sanitized transform option \'' . Data::Dumper::Dumper ($sanitized_transform) . "'\n";
    }

    $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";
      $error_detected = 1;
    }
  }

  if (!($error_detected)) {
    if ($debug) {
      print {*STDERR} 'Dumping transformed intermediate array: ' . Data::Dumper::Dumper ($intermediate);
    }

    $ret = $intermediate;
  }

  return $ret;
}

# Helper function extracting a key-value pair from an intermediate options
# string.
#
# Takes an intermediate options string, a key-value pair as a plain string to
# search for and a boolean value indicating whether debugging is turned on or
# off as its parameters.
#
# The provided key-value pair can actually either be a sole key, which is
# useful for checking if such a key exists and extracting its value, or a
# proper key-value pair with both components set, which can be used for
# checking for exactly this combination.
#
# Returns the extracted key-value pair as included in the intermediate options
# string as a plain string, or alternatively an empty string if the key-value
# pair was not found.
#
# On error, returns undef.
sub extract_data {
  my $ret = undef;
  my $error_detected = 0;

  my $intermediate = shift;
  my $kv = shift;
  my $debug = shift;

  if (!(defined ($intermediate))) {
    print {*STDERR} "Invalid intermediate argument passed to extraction helper, erroring out.\n";
    $error_detected = 1;
  }

  if ((!($error_detected)) && (!(defined ($kv)))) {
    print {*STDERR} "Invalid key-value pair argument passed to extraction helper, erroring out.\n";
    $error_detected = 1;
  }

  if ((!($error_detected)) && (!(defined ($debug)))) {
    print {*STDERR} "Invalid debug argument passed to extraction helper, erroring out.\n";
    $error_detected = 1;
  }

  if (!($error_detected)) {
    if ($debug) {
      print {*STDERR} 'Processing option to extract \'' . $kv . "'\n";
    }

    my $result = X2Go::Server::Agent::NX::Options::extract_element ($intermediate, $kv);

    print {*STDERR} 'Dumping returned value, length ' . scalar (@{$result}) . ': ' . Data::Dumper::Dumper ($result);

    if (!(defined ($result))) {
      print {*STDERR} "Unable to extract element, erroring out.\n";
      $error_detected = 1;
    }
    elsif (1 < scalar (@{$result})) {
      print {*STDERR} "More than one element returned during extraction, this is supposed to be impossible due to compaction.\n";
      $error_detected = 1;

      if ($debug) {
        print {*STDERR} 'Dumping returned value, length ' . scalar (@{$result}) . ': ' . Data::Dumper::Dumper ($result);
      }
    }
    elsif (0 == scalar (@{$result})) {
      # No such combination found, this is fine.
      # Return empty string.
      $ret = q{};
    }
    else {
      # Everything went fine, go ahead and create the resulting string.
      foreach my $entry (@{$result}) {
        foreach my $key (keys (%{$entry})) {
          $ret = $key;

          my $value = $entry->{$key};

          if (defined ($value)) {
            $ret .= q{=} . $value;
          }
        }
      }
    }
  }

  return $ret;
}

# Helper function encoding a string to its base64 form.
#
# Takes a string as its first and only parameter.
#
# Returns a base64-encoded representation of the original string.
#
# On error, returns undef.
sub encode_base64_internal {
  my $ret = undef;
  my $error_detected = 0;

  my $input = shift;

  if (!(defined ($input))) {
    print {*STDERR} "Invalid input argument passed to base64 encode helper, erroring out.\n";
    $error_detected = 1;
  }

  if (!($error_detected)) {
    # Convert into bytes.
    my $bytes = Encode::encode (locale => $input, (Encode::FB_CROAK | Encode::LEAVE_SRC));

    # Encode the data.
    $ret = MIME::Base64::encode_base64 ($bytes, q{});
  }

  return $ret;
}

# Helper function decoding a base64-encoded string to its original form.
#
# Takes a string as its first and only parameter.
#
# Returns the original representation of the base64-encoded string.
#
# On error, returns undef.
sub decode_base64_internal {
  my $ret = undef;
  my $error_detected = 0;

  my $input = shift;

  if (!(defined ($input))) {
    print {*STDERR} "Invalid input argument passed to base64 encode helper, erroring out.\n";
    $error_detected = 1;
  }

  if (!($error_detected)) {
    # Decode the data.
    my $decoded = MIME::Base64::decode_base64 ($input);

    # Convert into string.
    $ret = Encode::decode (locale => $decoded, (Encode::FB_CROAK | Encode::LEAVE_SRC));
  }

  return $ret;
}

# Main function, no code outside of it shall be executed.
#
# Expects @ARGV to be passed in.
## no critic (NamingConventions::Capitalization)
sub Main {
## critic (NamingConventions::Capitalization)
  my @program_arguments = @_;
  my $error_detected = 0;
  my $found_separator = 0;

  Getopt::Long::Configure ('gnu_getopt', 'no_auto_abbrev', 'pass_through');

  my $help = 0;
  my $man = 0;
  my $debug = 0;
  my $compact = 0;
  my $mode_transform = 0;
  my $mode_extract = 0;
  my $mode_arg = q{};
  my $base64 = 0;
  Getopt::Long::GetOptionsFromArray (\@program_arguments, 'help|?|h' => \$help,
                                                          'man' => \$man,
                                                          'debug|d' => \$debug,
                                                          'compact|c' => \$compact,
                                                          'transform|t' => \$mode_transform,
                                                          'extract|e' => \$mode_extract,
                                                          'mode|m=s' => \$mode_arg,
                                                          'base64|b' => \$base64) or Pod::Usage::pod2usage (2);

  if ($help) {
    Pod::Usage::pod2usage (1);
  }

  if ($man) {
    Pod::Usage::pod2usage (-verbose => 2, -exitval => 3);
  }

  my $mode = handle_mode ($mode_arg, $mode_transform, $mode_extract);

  if ($debug) {
    print {*STDERR} 'Parsed mode as: ' . $mode . "\n";
  }

  if ((MODE_INVALID_DATA)[1] == $mode) {
    $error_detected = 4;
  }

  my $sanitized_options = undef;

  if (!($error_detected)) {
    $sanitized_options = sanitize_program_options (\@program_arguments, (!($found_separator)));

    if (!(defined ($sanitized_options))) {
      Pod::Usage::pod2usage (-exitval => 'NOEXIT');
      $error_detected = 5;
    }
  }

  my $options = undef;

  if (!($error_detected)) {
    if ($debug) {
      print {*STDERR} 'Sanitized program options string as: ' . Data::Dumper::Dumper ($sanitized_options);
    }

    # The shift () operations here actually shift the outer array, not the
    # inner elements.
    # This can be very confusing.
    # The return value is an array consisting of a boolean value and an array
    # reference.
    #
    # Thus, shifting once returns the boolean value, while shifting again
    # returns the options array reference. Crucially, no shift () operation
    # here modifies the modified options array.
    $found_separator |= (0 + shift (@{$sanitized_options}));
    $sanitized_options = shift (@{$sanitized_options});
    @program_arguments = @{$sanitized_options};

    $options = shift (@program_arguments);

    if (!(defined ($options))) {
      print {*STDERR} "No options string given, aborting.\n";
      $error_detected = 6;
    }
  }

  my $intermediate = undef;

  if (!($error_detected)) {
    if ($debug) {
      print {*STDERR} 'Fetched options string as: ' . Data::Dumper::Dumper (\$options);
    }

    if ($base64) {
      my $decoded_options = decode_base64_internal ($options);

      if (!(defined ($options))) {
        print {*STDERR} 'Unable to decode base64 representation of options string \'' . $options . "', aborting.\n";
        $error_detected = 7;
      }
      else {
        if ($debug) {
          print {*STDERR} 'Decoded options string from base64 to \'' . $decoded_options . "'.\n";
        }

        $options = $decoded_options;
      }
    }

    $intermediate = X2Go::Server::Agent::NX::Options::parse_options ($options);

    if (!(defined ($intermediate))) {
      print {*STDERR} "Unable to parse options string, aborting.\n";
      $error_detected = 8;
    }
  }

  if (!($error_detected)) {
    $sanitized_options = sanitize_program_options (\@program_arguments, (!($found_separator)));

    if (!(defined ($sanitized_options))) {
      Pod::Usage::pod2usage (-exitval => 'NOEXIT');
      $error_detected = 9;
    }
  }

  if (!($error_detected)) {
    if ($debug) {
      print {*STDERR} 'Sanitized program options string as: ' . Data::Dumper::Dumper ($sanitized_options);
      print {*STDERR} 'Dumping intermediate array after initial parsing: ' . Data::Dumper::Dumper ($intermediate);
    }

    if (((MODE_EXTRACT_DATA)[1] == $mode) || ($compact)) {
      $intermediate = X2Go::Server::Agent::NX::Options::compact_intermediate ($intermediate);

      if (!(defined ($intermediate))) {
        print {*STDERR} "Unable to compact intermediate options representation, aborting.\n";
        $error_detected = 10;
      }
      elsif ($debug) {
        print {*STDERR} 'Dumping intermediate array after compacting: ' . Data::Dumper::Dumper ($intermediate);
      }
    }
  }

  my $out = undef;

  if (!($error_detected)) {
    $found_separator |= (0 + shift (@{$sanitized_options}));
    $sanitized_options = shift (@{$sanitized_options});
    @program_arguments = @{$sanitized_options};

    my $operation = 0;

    while (defined (my $cur_arg = shift (@program_arguments))) {
      $operation = 1;

      if ($base64) {
        my $decoded_arg = decode_base64_internal ($cur_arg);

        if (!(defined ($decoded_arg))) {
          print {*STDERR} 'Unable to decode base64 representation of argument \'' . $cur_arg . "', aborting.\n";
          $error_detected = 11;
          last;
        }
        else {
          if ($debug) {
            print {*STDERR} 'Decoded current argument from base64 to \'' . $decoded_arg . "'.\n";
          }

          $cur_arg = $decoded_arg;
        }
      }

      if ((MODE_TRANSFORM_DATA)[1] == $mode) {
        $intermediate = apply_transformation ($intermediate, $cur_arg, $debug);

        if (!(defined ($intermediate))) {
          print {*STDERR} 'Unable to apply transformation "' . $cur_arg . q{"} . ", aborting.\n";
          $error_detected = 12;
          last;
        }
      }
      elsif ((MODE_EXTRACT_DATA)[1] == $mode) {
        my $extract = extract_data ($intermediate, $cur_arg, $debug, $base64);

        if (!(defined ($extract))) {
          print {*STDERR} 'Unable to extract data for "' . $cur_arg . q{"} . ", aborting.\n";
          $error_detected = 13;
          last;
        }
        else {
          my $extract_encoded = encode_base64_internal ($extract);

          if (!(defined ($extract_encoded))) {
            print {*STDERR} 'Unable to base64-encode extracted key-value pair \'' . $extract . "', aborting.\n";
            $error_detected = 14;
            last;
          }

          if ($debug) {
            print {*STDERR} 'Base64-encoded extracted key-value pair to \'' . $extract_encoded . "'.\n";
          }

          if (!(defined ($out))) {
            # Create it.
            $out = $extract_encoded;
          }
          else {
            # Otherwise, append and make sure to separate fields.
            $out .= q{|} . $extract_encoded;
          }
        }
      }

      # Skip pseudo-option, if necessary.
      $sanitized_options = sanitize_program_options (\@program_arguments, (!($found_separator)));

      if (!(defined ($sanitized_options))) {
        Pod::Usage::pod2usage (-exitval => 'NOEXIT');
        $error_detected = 15;
        last;
      }
      elsif ($debug) {
        print {*STDERR} 'Sanitized program options string as: ' . Data::Dumper::Dumper ($sanitized_options);
      }

      $found_separator |= (0 + shift (@{$sanitized_options}));
      $sanitized_options = shift (@{$sanitized_options});
      @program_arguments = @{$sanitized_options};
    }

    if ((!($error_detected)) && (!($operation))) {
      print {*STDERR} "No operation carried out, aborting.\n";
      $error_detected = 16;
    }
  }

  if (!($error_detected)) {
    if ((MODE_TRANSFORM_DATA)[1] == $mode) {
      $out = X2Go::Server::Agent::NX::Options::intermediate_to_string ($intermediate);

      if (!(defined ($out))) {
        print {*STDERR} "Unable to transform intermediate back into string, aborting.\n";
        $error_detected = 17;
      }
      elsif ($base64) {
        my $out_encoded = encode_base64_internal ($out);

        if (!(defined ($out_encoded))) {
          print {*STDERR} 'Unable to base64-encode output string \'' . $out . "', aborting.\n";
          $error_detected = 18;
          last;
        }
        else {
          if ($debug) {
            print {*STDERR} 'Base64-encoded output string to \'' . $out_encoded . "'.\n";
          }

          $out = $out_encoded;
        }
      }
    }
  }

  if (!($error_detected)) {
    print {*STDOUT} $out . "\n";
  }

  return $error_detected;
}

__END__

=pod

=head1 NAME

x2gooptionsstring - X2Go Agent Options String Manipulator and Extractor

=head1 SYNOPSIS

=over

=item B<x2gooptionsstring> B<--help>|B<-h>|B<-?>

=item B<x2gooptionsstring> B<--man>

=item B<x2gooptionsstring> [<B<--mode>|B<-m>><B<=>| >B<t>[B<ransform>]|B<-t>] [B<--compact>|B<-c>] [B<--base64>|B<-b>] [B<--debug>|B<-d>] [B<-->] I<options_string> [B<+>]|B<->I<key>[B<=>I<value>] ...

=item B<x2gooptionsstring> <B<--mode>|B<-m>><B<=>| >B<e>[B<xtract>]|B<-e> [B<--base64>|B<-b>] [B<--debug>|B<-d>] [B<-->] I<options_string> I<key>[B<=>I<value>] ...

=back

=head1 DESCRIPTION

=for comment
Due to parser oddities, breaking a line during an L<dummy|text> formatter code
right after the separating pipe character will generate broken links.
Make sure to only break it during the description or, generally, on space
characters.
A workaround for this has been proposed in
https://github.com/Perl/perl5/issues/18305 .

B<x2gooptionsstring> is a utility for manipulating and extracting data from
options strings as passed to B<X2Go/NX Agent>.
For more information about supported options strings, refer to the L<OPTIONS
STRINGS section in the X2Go::Server::Agent::NX::Options
documentation|X2Go::Server::Agent::NX::Options/OPTIONS STRINGS>.

For full support of options string, which are allowed (but not recommended) to
include binary data, the special B<--base64>|B<-b> switch is supported.
If given, all arguments other than flags must be base64-encoded (making it
possible to pass binary data via shells, for instance).
The program's output, minus potentially debugging messages, will also be
base64-encoded.

Currently, two modes are supported:

=over

=item Transform (default)

Transformation mode is enabled by default if no mode has been explicitly
selected.

Call this program with optional flags, the options string as the first
parameter and the transformations to be carried out as additional parameters.
At least one additional parameter (i.e., a transformation) must be provided.
Transformations are described here briefly, but also in the L<TRANSFORMATIONS
section in the X2Go::Server::Agent::NX::Options
documentation|X2Go::Server::Agent::NX::Options/TRANSFORMATIONS>.

It can either add, remove or replace components.

To add or replace a component, pass I<key>[B<=>I<value>] or
B<+>I<key>[B<=>I<value>] as a parameter.
The latter syntax is useful if I<key> starts with a dash and would therefore
be interpreted as a removal operation.
If the options string does not include a B<key> key, it will be appended to
the end of the options string.
If it already exists, either with no value or a different value, the component
will be replaced with the provided value.

To fully remove a component, pass B<->I<key>.
To only remove it if it is set to a specific value, pass
B<->I<key>B<=>I<value>.

Use the B<--compact> option to minimize the original options string, removing
duplicated and empty entries.

Assuming no error happened, the resulting options string is written to
B<stdout>.

=item Extract

Extraction mode must be explicitly requested using the B<-e> or
<B<--mode>|B<-m>><B<=>| >B<e>[B<xtract>] flags.

Call this program with optional flags, the options string as the first
parameter and key-value pairs to be extracted as additional parameters.
At least one additional parameter (i.e., a key-value pair to extract) must be
provided.

A degenerated key-value pair without an explicit value can be used to test for
the existence of a key and extract its value at the same time.

A full, proper key-value pair can be used to test for the existence of a
key-value pair exactly as provided.

Assuming no error happened, the extracted key-value pairs will be written to
B<stdout>.
Each pair will be base64-encoded and, if multiple key-value pairs to extract
have been provided, delimited via B<pipe> characters (C<|>).

Key-value pairs which haven't been found in the original options string, as
well as potentially an empty key-value pair, will be represented as empty
fields.

=back

Refer to the L<OPTIONS PARSING section|/OPTIONS PARSING> for a description of
when and how to terminate options passed to this program.

=head1 OPTIONS

=over 8

=item B<--help>|B<-?>|B<-h>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--debug>|B<-d>

Enables noisy debug output.

=item B<-t>

Shorthand for B<--mode=transform>.

=item B<-e>

Shorthand for B<--mode=extract>.

=item <B<--mode>|B<-m>><B<=>| >I<mode string>

Selects a specific program mode.

Currently, the following mode strings are supported:

=over

=item *

transform

=item *

extract

=back

Mode strings can be abbreviated, as long as the abbreviation is uniquely
selecting one mode exactly.

=item B<--compact>|B<-c>

Remove duplicate and empty entries after the initial parsing.
The order of arguments is preserved in a first-seen fashion.

This option is only available in B<transformation mode>.
It will be silently ignored in B<extraction mode>, as compaction is a
pre-requisite and done automatically during extraction.

=item B<--base64>|B<-b>

Enable a special full base64 mode.

Any binary data can be given and output by this program in this mode, even
when operating on a shell.

Input parameters must always be provided encoded in base64 form.

Likewise, the program will always output data encoded in a base64 form.
Since key-value pairs returned in extraction mode are already base64-encoded
and delimited with a character that is not legal in the base64 encoding, this
flag does not modify the extraction's mode output (i.e., you will B<not> have
to decode the output data twice).

=back

=head2 OPTIONS PARSING

You can terminate program options parsing via a standard double-dash (B<-->)
pseudo-option.
It is B<highly recommended> to always do so.

If you pass removal transformation operations or an extraction key-value pair
starts with a dash (B<->), passing the options terminator is B<mandatory>, even
if no actual options are used.
Otherwise, transformation operations or extraction key-value pairs will be
interpreted as options to the program, which will almost certainly lead to an
error.

For example, passing C<-clipboard> as a transformation operation without a
previous options terminator will be interpreted as the option C<-c>, with the
rest of the string modified into C<-lipboard>.
Since this program does not accept an option called C<-l>, it will terminate
with an error.
Even if the program does not terminate with an error due to an unknown option
being supplied, a degradation into options is certainly not what the original
transformation operation was supposed to represent.

=head1 EXAMPLES

=head2 TRANSFORMATIONS

For an options string such as

 nx/nx,clipboard=both,foo:50

=over 2

calling C<x2gooptionsstring '--' 'nx/nx,clipboard=both,foo:50'
'-clipboard'> shall return

 nx/nx,foo:50

while calling C<x2gooptionsstring '--' 'nx/nx,clipboard=both,foo:50'
'-clipboard=server'> shall return

 nx/nx,clipboard=both,foo:50

Calling C<x2gooptionsstring '--' 'nx/nx,clipboard=both,foo:50' 'bar'>
shall return

 nx/nx,clipboard=both,foo,bar:50

and calling C<x2gooptionsstring '--' 'nx/nx,clipboard=both,foo:50'
'+-bar' 'foo=gulp' '-clipboard=client'> shall return

 nx/nx,clipboard=both,foo=gulp,-bar:50

=back

For an options string such as

 nx/nx,clipboard=both,foo=bar,bar=baz,foo=oof:50

=over 2

you can get a compacted version by cheating a bit and providing a
transformation which will certainly be a no-operation using
C<x2gooptionsstring '-c' '--'
'nx/nx,clipboard=both,foo=bar,bar=baz,,foo=oof,:50' '-'>, which shall return

 nx/nx,clipboard=both,foo=oof,bar=baz:50

=back

=head2 EXTRACTIONS

For an options string such as

 nx/nx,clipboard=both,foo=bar,-=-,,bar=baz,foo=oof:50

=over 2

Calling C<x2gooptionsstring '-e' '--'
'nx/nx,clipboard=both,foo=bar,-=-,bar=baz,foo=oof,:50' 'foo'> shall return

 Zm9vPW9vZg==

while calling C<x2gooptionsstring '-e' '--'
'nx/nx,clipboard=both,foo=bar,-=-,bar=baz,foo=oof,:50' 'bar' ''
'clipboard=none' '-'> shall return

 YmFyPWJheg==|||LT0t

=back

=head1 AUTHOR

This manual has been written by
Mihai Moldovan L<E<lt>ionic@ionic.deE<gt>|mailto:ionic@ionic.de> for the X2Go
project (L<https://www.x2go.org|https://www.x2go.org>).

=cut
