Config-based KasmVNC

unix/KasmVNC/CliOption.pm

@@ -0,0 +1,199 @@
+package KasmVNC::CliOption;
+
+use strict;
+use warnings;
+use v5.10;
+use List::Util qw(first);
+use List::MoreUtils qw(all);
+use Switch;
+use Data::Dumper;
+
+use KasmVNC::DataClumpValidator;
+use KasmVNC::Utils;
+
+our $fetchValueSub;
+$KasmVNC::CliOption::dataClumpValidator = KasmVNC::DataClumpValidator->new();
+@KasmVNC::CliOption::isActiveCallbacks = ();
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+      name => $args->{name},
+      configKeys => $args->{configKeys},
+      deriveValueSub => $args->{deriveValueSub} || sub {
+        my $self = shift;
+        my @values = @{ listify($self->configValues()) };
+
+        @values = map { deriveBoolean($_) } @values;
+
+        join ",", @values;
+      },
+      isActiveSub => $args->{isActiveSub} || sub {
+        my $self = shift;
+
+        scalar $self->configValues() > 0;
+      },
+      errors => []
+    }, $class;
+}
+
+sub activate {
+  my $self = shift;
+
+  $self->makeKeysWithValuesAccessible();
+}
+
+sub beforeIsActive {
+  my $callback = shift;
+
+  push @KasmVNC::CliOption::isActiveCallbacks, $callback;
+}
+
+sub isActiveByCallbacks {
+  my $self = shift;
+
+  all { $_->($self) } @KasmVNC::CliOption::isActiveCallbacks;
+}
+
+sub makeKeysWithValuesAccessible {
+  my $self = shift;
+
+  foreach my $name (@{ $self->configKeyNames() }) {
+    my $value = $self->fetchValue($name);
+    $self->{$name} = $value if defined($value);
+  }
+}
+
+sub isActive {
+  my $self = shift;
+
+  $self->isActiveByCallbacks() && $self->{isActiveSub}->($self);
+}
+
+sub toString {
+  my $self = shift;
+
+  return unless $self->isActive();
+
+  my $derivedValue = $self->deriveValue();
+  if (defined($derivedValue)) {
+    return "-$self->{name} " . "'$derivedValue'";
+  }
+
+  "-$self->{name}";
+}
+
+sub toValue {
+  my $self = shift;
+
+  return unless $self->isActive();
+
+  $self->deriveValue();
+}
+
+sub deriveValue {
+  my $self = shift;
+
+  my $value = $self->{deriveValueSub}->($self);
+  $self->interpolateEnvVars($value);
+}
+
+sub interpolateEnvVars {
+  my $self = shift;
+  my $value = shift;
+
+  return $value unless defined($value);
+
+  while ($value =~ /\$\{(\w+)\}/) {
+    my $envValue = $ENV{$1};
+    $value =~ s/\Q$&\E/$envValue/;
+  }
+
+  $value;
+}
+
+sub errorMessages {
+  my $self = shift;
+
+  join "\n", @{ $self->{errors} };
+}
+
+# private
+
+sub isValid {
+  my $self = shift;
+
+  $self->validate() unless $self->{validated};
+
+  $self->isNoErrorsPresent();
+}
+
+sub validate {
+  my $self = shift;
+
+  $self->validateDataClump();
+  $self->validateConfigValues();
+
+  $self->{validated} = 1;
+}
+
+sub isNoErrorsPresent {
+  my $self = shift;
+
+  scalar @{ $self->{errors} } == 0;
+}
+
+sub validateDataClump {
+  my $self = shift;
+
+  $KasmVNC::CliOption::dataClumpValidator->validate($self);
+}
+
+sub configValues {
+  my $self = shift;
+
+  map { $self->fetchValue($_->{name}) } @{ $self->{configKeys} };
+}
+
+sub configValue {
+  my $self = shift;
+
+  die "Multiple or no config keys defined for $self->{name}"
+    if (scalar @{ $self->{configKeys} } != 1);
+
+  @{ listify($self->configValues()) }[0];
+}
+
+sub configKeyNames {
+  my $self = shift;
+
+  my @result = map { $_->{name} } @{ $self->{configKeys} };
+  \@result;
+}
+
+sub hasKey {
+  my $self = shift;
+  my $configKey = shift;
+
+  first { $_ eq $configKey } @{ $self->configKeyNames() };
+}
+
+sub addErrorMessage {
+  my ($self, $errorMessage) = @_;
+
+  push @{ $self->{errors} }, $errorMessage;
+}
+
+sub validateConfigValues {
+  my $self = shift;
+
+  map { $_->validate($self) } @{ $self->{configKeys} };
+}
+
+sub fetchValue {
+  my $self = shift;
+
+  &$fetchValueSub(shift);
+}
+
+1;

unix/KasmVNC/Config.pm

@@ -0,0 +1,86 @@
+package KasmVNC::Config;
+
+use strict;
+use warnings;
+use v5.10;
+use YAML::Tiny;
+use Data::Dumper;
+use Hash::Merge::Simple;
+use KasmVNC::Utils;
+
+sub merge {
+  my @configsToMerge = map { $_->{data} } @_;
+  my $mergedConfig = Hash::Merge::Simple::merge(@configsToMerge) // {};
+
+  KasmVNC::Config->new({ data => $mergedConfig });
+}
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+      filename => $args->{filename},
+      data => $args->{data}
+    }, $class;
+
+    $self->load() if $self->{filename};
+    $self;
+}
+
+sub load {
+  my $self = shift;
+
+  failIfConfigNotReadable($self->{filename});
+
+  $self->{data} = YAML::Tiny->read($self->{filename})->[0];
+}
+
+sub get {
+  my ($self, $absoluteKey) = @_;
+  my $path = absoluteKeyToHashPath($absoluteKey);
+  my $config = $self->{data};
+
+  my $value = eval "\$config$path";
+  return unless defined($value);
+
+  $value;
+}
+
+sub exists {
+  my ($self, $absoluteKey) = @_;
+  my $path = absoluteKeyToHashPath($absoluteKey);
+  my $config = $self->{data};
+
+  eval "exists \$config$path";
+}
+
+sub delete {
+  my ($self, $absoluteKey) = @_;
+  my $path = absoluteKeyToHashPath($absoluteKey);
+  my $config = $self->{data};
+
+  eval "delete \$config$path";
+}
+
+sub isEmpty {
+  my ($self, $absoluteKey) = @_;
+  my $path = absoluteKeyToHashPath($absoluteKey);
+  my $config = $self->{data};
+
+  $self->exists($absoluteKey) && isBlank($self->get($absoluteKey));
+}
+
+sub absoluteKeyToHashPath {
+  my $absoluteKey = shift;
+
+  my @keyParts = split(/\./, $absoluteKey);
+  @keyParts = map { "->{\"$_\"}" } @keyParts;
+  join "", @keyParts;
+}
+
+sub failIfConfigNotReadable {
+  my $config = shift;
+
+  -r $config || die "Couldn't load config: $config";
+}
+
+1;

unix/KasmVNC/ConfigKey.pm

@@ -0,0 +1,123 @@
+package KasmVNC::ConfigKey;
+
+use strict;
+use warnings;
+use v5.10;
+use Switch;
+use Data::Dumper;
+
+use KasmVNC::Utils;
+
+our $fetchValueSub;
+
+use constant {
+  INT => 0,
+  STRING => 1,
+  BOOLEAN => 2,
+  ANY => 4
+};
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+      name => $args->{name},
+      type => $args->{type},
+      validator => $args->{validator}
+    }, $class;
+}
+
+sub validate {
+  my $self = shift;
+  $self->{cliOption} = shift;
+
+  return if $self->isValueBlank();
+
+  if ($self->{validator}) {
+    $self->resolveValidatorFromFunction() if (ref $self->{validator} eq "CODE");
+
+    $self->{validator}->validate($self);
+    return;
+  }
+
+  switch($self->{type}) {
+    case INT {
+      $self->validateInt();
+    }
+    case BOOLEAN {
+      $self->validateBoolean();
+    }
+  }
+}
+
+sub resolveValidatorFromFunction {
+  my $self = shift;
+
+  $self->{validator} = $self->{validator}();
+}
+
+sub addErrorMessage {
+  my $self = shift;
+
+  my $errorMessage = $self->constructErrorMessage($_[0]);
+  $self->{cliOption}->addErrorMessage($errorMessage);
+}
+
+# private
+
+sub validateBoolean {
+  my $self = shift;
+
+  return if $self->isValidBoolean();
+  $self->addErrorMessage("must be true or false");
+}
+
+sub validateInt {
+  my $self = shift;
+
+  return if $self->isValidInt();
+
+  $self->addErrorMessage("must be an integer");
+}
+
+sub isValueBlank {
+  my $self = shift;
+
+  my $value = $self->value();
+  !defined($value) || $value eq "";
+}
+
+sub fetchValue {
+  my $self = shift;
+
+  &$fetchValueSub(shift);
+}
+
+sub constructErrorMessage {
+  my $self = shift;
+  my $staticErrorMessage = shift;
+
+  my $name = $self->{name};
+  my $value = join ", ", @{ listify($self->fetchValue($name)) };
+
+  "$name '$value': $staticErrorMessage";
+}
+
+sub isValidInt {
+  my $self = shift;
+
+  $self->value() =~ /^(-)?\d+$/;
+}
+
+sub isValidBoolean {
+  my $self = shift;
+
+  $self->value() =~ /^true|false$/;
+}
+
+sub value {
+  my $self = shift;
+
+  $self->fetchValue($self->{name});
+}
+
+our @EXPORT_OK = ('INT', 'STRING', 'BOOLEAN');

unix/KasmVNC/DataClumpValidator.pm

@@ -0,0 +1,48 @@
+package KasmVNC::DataClumpValidator;
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+    }, $class;
+}
+
+sub validate {
+  my $self = shift;
+  $self->{cliOption} = shift;
+
+  if ($self->isDataClump() && !$self->isWhole()) {
+    $self->{cliOption}->addErrorMessage($self->errorMessage());
+  }
+}
+
+# private
+
+sub isWhole {
+  my $self = shift;
+
+  my $numberOfValues = scalar $self->{cliOption}->configValues();
+  return 1 if $numberOfValues == 0;
+
+  scalar @{ $self->{cliOption}->{configKeys} } == $numberOfValues;
+}
+
+sub isDataClump {
+  my $self = shift;
+
+  scalar(@{ $self->{cliOption}->{configKeys} }) > 1;
+}
+
+sub errorMessage {
+  my $self = shift;
+
+  my $configKeys = join ", ", @{ $self->{cliOption}->configKeyNames() };
+
+  "$configKeys: either all keys or none must be present";
+}
+
+1;

unix/KasmVNC/EnumValidator.pm

@@ -0,0 +1,36 @@
+package KasmVNC::EnumValidator;
+
+use strict;
+use warnings;
+use v5.10;
+use List::MoreUtils qw(any);
+use Data::Dumper;
+use KasmVNC::Utils;
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+      allowedValues => $args->{allowedValues}
+    }, $class;
+}
+
+sub validate {
+  my $self = shift;
+  my $configKey = shift;
+  my @values = @{ listify($configKey->value()) };
+
+  foreach my $value (@values) {
+    unless (any { $_ eq $value } @{ $self->{allowedValues} }) {
+      $configKey->addErrorMessage($self->errorMessage());
+    }
+  }
+}
+
+sub errorMessage {
+  my $self = shift;
+
+  my $allowedValuesText = join ", ", @{ $self->{allowedValues} };
+  "must be one of [$allowedValuesText]"
+}
+
+1;

unix/KasmVNC/Logger.pm

@@ -0,0 +1,20 @@
+package KasmVNC::Logger;
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+    }, $class;
+}
+
+sub warn {
+  my $self = shift;
+
+  say { *STDERR } @_;
+}
+
+1;

unix/KasmVNC/PatternValidator.pm

@@ -0,0 +1,37 @@
+package KasmVNC::PatternValidator;
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+
+use KasmVNC::Utils;
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+      pattern => $args->{pattern},
+      errorMessage => $args->{errorMessage}
+    }, $class;
+}
+
+sub validate {
+  my $self = shift;
+  $self->{configKey} = shift;
+  my @values = @{ listify($self->{configKey}->value()) };
+
+  foreach my $value (@values) {
+    $self->validateValue($value);
+  }
+}
+
+sub validateValue {
+  my $self = shift;
+  my $value = shift;
+
+  unless ($value =~ $self->{pattern}) {
+    $self->{configKey}->addErrorMessage($self->{errorMessage});
+  }
+}
+
+1;

unix/KasmVNC/TextOption.pm

@@ -0,0 +1,40 @@
+package KasmVNC::TextOption;
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+      description => $args->{description},
+      callback => $args->{callback} || sub {},
+    }, $class;
+}
+
+use overload fallback => 1, q("") => sub {
+  my $self = shift;
+
+  $self->stringify();
+};
+
+sub stringify {
+  my $self = shift;
+
+  $self->{description};
+}
+
+sub description {
+  my $self = shift;
+
+  $self->{description};
+}
+
+sub callback {
+  my $self = shift;
+
+  $self->{callback};
+}
+
+1;

unix/KasmVNC/TextUI.pm

@@ -0,0 +1,55 @@
+package KasmVNC::TextUI;
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+
+@KasmVNC::TextUI::ISA = qw(Exporter);
+
+our @EXPORT = ('Prompt', 'askUserToChooseOption');
+
+sub askUserToChooseOption {
+  my %args = @_;
+  my $banner = $args{banner};
+  my $prompt = $args{prompt};
+  my $options = $args{options};
+
+  my $userInput;
+  my $i = 1;
+  my %numberedOptions = map { $i++ => $_ } @$options;
+
+  while (1) {
+    say $banner;
+
+    printOptions(\%numberedOptions);
+
+    $userInput = Prompt($prompt . ": ");
+    last if $numberedOptions{$userInput};
+
+    say "Invalid choice: '$userInput'";
+  }
+
+  $numberedOptions{$userInput};
+}
+
+sub printOptions {
+  my $choices = shift;
+
+  foreach my $choiceNumber (sort keys %$choices) {
+    say "[$choiceNumber] " . $choices->{$choiceNumber};
+  }
+  print "\n";
+}
+
+sub Prompt {
+  my $prompt = shift;
+
+  print($prompt);
+  my $userInput = <STDIN>;
+  $userInput =~ s/^\s+|\s+$//g;
+
+  return $userInput;
+}
+
+1;

unix/KasmVNC/User.pm

@@ -0,0 +1,54 @@
+package KasmVNC::User;
+
+use strict;
+use warnings;
+use v5.10;
+
+sub new {
+    my ($class, $args) = @_;
+
+    my $self = bless {
+      name => $args->{name},
+      permissions => $args->{permissions}
+    }, $class;
+}
+
+sub permissionsExplanation {
+  my $self = shift;
+
+  my %permissionExplanations = ("w" => "can use keyboard and mouse",
+    "o" => "can add/remove users",
+    "" => "can only view");
+  foreach (qw(ow wo)) {
+    $permissionExplanations{$_} = "can use keyboard and mouse, add/remove users";
+  }
+
+  $self->{permissions} =~ s/r//g;
+  $permissionExplanations{$self->{permissions}};
+}
+
+sub name {
+  my $self = shift;
+
+  $self->{name};
+}
+
+sub permissions {
+  my $self = shift;
+
+  $self->{permissions};
+}
+
+sub isOwner {
+  my $self = shift;
+
+  $self->permissions() =~ /o/;
+}
+
+sub toString {
+  my $self = shift;
+
+  $self->name() . " (" . $self->permissionsExplanation() . ")";
+}
+
+1;

unix/KasmVNC/Users.pm

@@ -0,0 +1,169 @@
+package KasmVNC::Users;
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+use List::MoreUtils qw(any);
+use KasmVNC::User;
+
+our $vncPasswdBin;
+our $logger;
+
+sub new {
+    my ($class, $args) = @_;
+    my $self = bless {
+      passwordFileName => $args->{passwordFileName},
+    }, $class;
+}
+
+sub loadFrom {
+  my ($self, $passwordFileName) = @_;
+
+  my $users = KasmVNC::Users->new({
+    passwordFileName => $passwordFileName,
+    vncPasswdBin => $vncPasswdBin
+  });
+  $users->load();
+
+  $users;
+}
+
+sub optionsToCliOptions {
+  my %options = @_;
+  my @cliOptons = ();
+
+  push(@cliOptons, "-u \"@{[$options{username}]}\"");
+  if ($options{permissions}) {
+    push(@cliOptons, "-" . $options{permissions});
+  }
+  if ($options{changePermissions}) {
+    push(@cliOptons, "-n");
+  }
+
+  join " ", @cliOptons;
+}
+
+sub runKasmvncpasswd {
+  my ($self, $options) = @_;
+  my @cliOptions = optionsToCliOptions(%{ $options });
+
+  system("$vncPasswdBin " . join(" ", @cliOptions) .  " " . $self->{passwordFileName});
+  $? ? 0 : 1;
+}
+
+sub findByPermissions {
+  my ($self, $permissions) = @_;
+
+  any { $_->{permissions} =~ /$permissions/ }
+    (values %{ $self->{store} });
+}
+
+sub fetchUser {
+  my ($self, $username) = @_;
+
+  $self->{store}->{$username};
+}
+
+sub userExists {
+  fetchUser @_;
+}
+
+sub addUser {
+  my ($self, $username, $permissions) = @_;
+
+  if ($self->userExists($username)) {
+    $logger->warn("User $username already exists");
+    return;
+  }
+
+  $self->runKasmvncpasswd({ username => $username, permissions => $permissions });
+}
+
+sub checkUserExists {
+  my ($self, $username) = @_;
+
+  unless ($self->fetchUser($username)) {
+    die "User \"$username\" doesn't exist";
+  }
+}
+
+sub addPermissions {
+  my ($self, $username, $permissions) = @_;
+
+  $self->checkUserExists($username);
+
+  my $user = $self->fetchUser($username);
+  $permissions .= $user->{permissions};
+
+  $self->changePermissions($username, $permissions);
+}
+
+sub changePermissions {
+  my ($self, $username, $permissions) = @_;
+
+  $self->checkUserExists($username);
+
+  $self->runKasmvncpasswd({ username => $username, permissions => $permissions,
+      changePermissions => 1 });
+}
+
+sub load {
+  my $self = shift;
+
+  $self->{store} = $self->_load();
+}
+
+sub reload {
+  my $self = shift;
+
+  $self->load();
+}
+
+sub count {
+  my $self = shift;
+
+  return scalar(keys %{ $self->{store} });
+}
+
+sub is_empty {
+  my $self = shift;
+
+  $self->count() eq 0;
+}
+
+sub _load {
+  my $self = shift;
+
+  my $store = {};
+
+  open(FH, '<', $self->{passwordFileName}) or return $store;
+
+  while(<FH>){
+    chomp $_;
+    my ($name, $__, $permissions) = split(':', $_);
+    $store->{$name} = KasmVNC::User->new({
+      name => $name,
+      permissions => $permissions
+    })
+  }
+
+  close(FH);
+
+  $store;
+}
+
+sub users {
+  my $self = shift;
+
+  values %{ $self->{store} }
+}
+
+sub toString {
+  my $self = shift;
+
+  my @userDescriptions = map { $_->toString() } $self->users();
+  join "\n", @userDescriptions;
+}
+
+1;

unix/KasmVNC/Utils.pm

@@ -0,0 +1,66 @@
+package KasmVNC::Utils;
+
+use strict;
+use warnings;
+use v5.10;
+use Data::Dumper;
+use Switch;
+
+use Exporter;
+
+@KasmVNC::Utils::ISA = qw(Exporter);
+
+our @EXPORT = ('listify', 'flatten', 'isBlank', 'isPresent', 'deriveBoolean',
+  'printStackTrace');
+
+sub listify {
+    # Implementation based on Hyper::Functions
+    if (scalar @_ > 1) {
+        return [ @_ ];
+    } elsif (defined $_[0]) {
+        my $ref_type = ref $_[0];
+        return ($ref_type && $ref_type eq 'ARRAY') ? $_[0] : [ $_[0] ];
+    } else {
+        return [];
+    }
+}
+
+sub flatten {
+  map { ref $_ ? flatten(@{$_}) : $_ } @_;
+}
+
+sub isBlank {
+  !isPresent(shift);
+}
+
+sub isPresent {
+  my $value = shift;
+  if (ref($value) eq "HASH") {
+    return scalar(keys %$value) > 0;
+  }
+
+  defined($value);
+}
+
+sub deriveBoolean {
+  my $value = shift;
+
+  switch($value) {
+    case 'true' {
+      return 1;
+    }
+    case 'false' {
+      return 0;
+    }
+    else {
+      return $value;
+    }
+  }
+}
+
+sub printStackTrace {
+  my $trace = Devel::StackTrace->new;
+  print { *STDERR } $trace->as_string;
+}
+
+1;