KasmVNC/unix/vncserver

#!/usr/bin/env perl
#
#  Copyright (C) 2009-2010 D. R. Commander.  All Rights Reserved.
#  Copyright (C) 2005-2006 Sun Microsystems, Inc.  All Rights Reserved.
#  Copyright (C) 2002-2003 Constantin Kaplinsky.  All Rights Reserved.
#  Copyright (C) 2002-2005 RealVNC Ltd.
#  Copyright (C) 1999 AT&T Laboratories Cambridge.  All Rights Reserved.
#
#  This 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 software 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
#

#
# vncserver - wrapper script to start an X VNC server.
#

use v5.10;
use Time::HiRes qw (sleep);
use Switch;
use File::Basename;
use YAML::Tiny;
use List::Util qw(first);
use Data::Dumper;

use Hash::Merge::Simple;

use constant {
  NO_ARG_VALUE => 0,
  REQUIRED_ARG_VALUE => 1,
  OPTIONAL_ARG_VALUE => 2
};

CheckWeCanRunInThisEnvironment();

DefineFilePathsAndStuff();
LoadYAMLConfig();

ParseAndProcessCliOptions();

PrepareLoggingAndXvncKillingFramework();
DisableLegacyVncAuth();
AllowXProgramsToConnectToXvnc();

EnsureAtLeastOneKasmUserExists();
AskUserToChooseDeOrManualXstartup();

PrepareDefaultsForPassingToXvnc();
StartXvncOrExit();

PrintLogFilenameAndConfiguredUsersAndStuff();

CreateUserConfigIfNeeded();

if (! $skipxstartup) {
  CreateXstartupIfNeeded();
  RunXstartup();
}

PrintBrowserUrl();

exit;

###############################################################################
# Functions
###############################################################################

#
# Populate the global %config hash with settings from a specified
# vncserver configuration file if it exists
#
# Args: 1. file path
#       2. optional boolean flag to enable warning when a previously
#          set configuration setting is being overridden
#
sub LoadConfig {
  local ($configFile, $warnoverride) = @_;
  local ($toggle) = undef;

  if (stat($configFile)) {
    if (open(IN, $configFile)) {
      while (<IN>) {
        next if /^#/;
        if (my ($k, $v) = /^\s*(\w+)\s*=\s*(.+)$/) {
          $k = lc($k); # must normalize key case
          if ($warnoverride && $config{$k}) {
            print("Warning: $configFile is overriding previously defined '$k' to be '$v'\n");
          }
          # change username option to basicAuth and add colon as required by Xvnc, password will be taken from file
          if ($k = "username") {
            next;
          } else {
            $config{$k} = $v;
          }
        } elsif ($_ =~ m/^\s*(\S+)/) {
          # We can't reasonably warn on override of toggles (e.g. AlwaysShared)
          # because it would get crazy to do so. We'd have to check if the
          # current config file being loaded defined the logical opposite setting
          # (NeverShared vs. AlwaysShared, etc etc).
          $toggle = lc($1); # must normalize key case
          $config{$toggle} = $k;
        }
      }
      close(IN);
    }
  }
}

#
# CheckGeometryAndDepthAreSensible simply makes sure that the geometry and depth
# values are sensible.
#

sub CheckGeometryAndDepthAreSensible
{
  if ($geometry =~ /^(\d+)x(\d+)$/) {
    $width = $1; $height = $2;

    if (($width<1) || ($height<1)) {
      die "$prog: geometry $geometry is invalid\n";
    }

    $geometry = "${width}x$height";
  } else {
    die "$prog: geometry $geometry is invalid\n";
  }

  if ($depth && (($depth < 8) || ($depth > 32))) {
    die "Depth must be between 8 and 32\n";
  }
}


#
# GetLowestAvailableDisplayNumber gets the lowest available display number.  A
# display number n is taken if something is listening on the VNC server port
# (5900+n) or the X server port (6000+n).
#

sub GetLowestAvailableDisplayNumber
{
  foreach $n (1..99) {
    if (CheckVncIsntRunningOnDisplay($n)) {
      return $n+0; # Bruce Mah's workaround for bug in perl 5.005_02
    }
  }

  die "$prog: no free display number on $host.\n";
}


#
# CheckVncIsntRunningOnDisplay checks if the given display number is available.  A
# display number n is taken if something is listening on the VNC server port
# (5900+n) or the X server port (6000+n).
#

sub CheckVncIsntRunningOnDisplay
{
  local ($n) = @_;

  socket(S, $AF_INET, $SOCK_STREAM, 0) || die "$prog: socket failed: $!\n";
  eval 'setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1))';
  if (!bind(S, pack('S n x12', $AF_INET, 6000 + $n))) {
    close(S);
    return 0;
  }
  close(S);

  socket(S, $AF_INET, $SOCK_STREAM, 0) || die "$prog: socket failed: $!\n";
  eval 'setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1))';
  if (!bind(S, pack('S n x12', $AF_INET, 5900 + $n))) {
    close(S);
    return 0;
  }
  close(S);

  if (-e "/tmp/.X$n-lock") {
    warn "\nWarning: $host:$n is taken because of /tmp/.X$n-lock\n";
    warn "Remove this file if there is no X server $host:$n\n";
    return 0;
  }

  if (-e "/tmp/.X11-unix/X$n") {
    warn "\nWarning: $host:$n is taken because of /tmp/.X11-unix/X$n\n";
    warn "Remove this file if there is no X server $host:$n\n";
    return 0;
  }

  return 1;
}


#
# GetXDisplayDefaults uses xdpyinfo to find out the geometry, depth and pixel
# format of the current X display being used.  If successful, it sets the
# options as appropriate so that the X VNC server will use the same settings
# (minus an allowance for window manager decorations on the geometry).  Using
# the same depth and pixel format means that the VNC server won't have to
# translate pixels when the desktop is being viewed on this X display (for
# TrueColor displays anyway).
#

sub GetXDisplayDefaults
{
  local (@lines, @matchlines, $width, $height, $defaultVisualId, $i,
    $red, $green, $blue);

  $wmDecorationWidth = 4;     # a guess at typical size for window manager
  $wmDecorationHeight = 24;   # decoration size

  return if (!defined($ENV{DISPLAY}));

  @lines = `xdpyinfo 2>/dev/null`;

  return if ($? != 0);

  @matchlines = grep(/dimensions/, @lines);
  if (@matchlines) {
    ($width, $height) = ($matchlines[0] =~ /(\d+)x(\d+) pixels/);

    $width -= $wmDecorationWidth;
    $height -= $wmDecorationHeight;

    $geometry = "${width}x$height";
  }

  @matchlines = grep(/default visual id/, @lines);
  if (@matchlines) {
    ($defaultVisualId) = ($matchlines[0] =~ /id:\s+(\S+)/);

    for ($i = 0; $i < @lines; $i++) {
      if ($lines[$i] =~ /^\s*visual id:\s+$defaultVisualId$/) {
        if (($lines[$i+1] !~ /TrueColor/) ||
          ($lines[$i+2] !~ /depth/) ||
          ($lines[$i+4] !~ /red, green, blue masks/))
        {
          return;
        }
        last;
      }
    }

    return if ($i >= @lines);

    ($depth) = ($lines[$i+2] =~ /depth:\s+(\d+)/);
    ($red,$green,$blue)
    = ($lines[$i+4]
      =~ /masks:\s+0x([0-9a-f]+), 0x([0-9a-f]+), 0x([0-9a-f]+)/);

    $red = hex($red);
    $green = hex($green);
    $blue = hex($blue);

    if ($red > $blue) {
      $red = int(log($red) / log(2)) - int(log($green) / log(2));
      $green = int(log($green) / log(2)) - int(log($blue) / log(2));
      $blue = int(log($blue) / log(2)) + 1;
      $pixelformat = "rgb$red$green$blue";
    } else {
      $blue = int(log($blue) / log(2)) - int(log($green) / log(2));
      $green = int(log($green) / log(2)) - int(log($red) / log(2));
      $red = int(log($red) / log(2)) + 1;
      $pixelformat = "bgr$blue$green$red";
    }
  }
}


#
# quotedString returns a string which yields the original string when parsed
# by a shell.
#

sub quotedString
{
  local ($in) = @_;

  $in =~ s/\'/\'\"\'\"\'/g;

  return "'$in'";
}


#
# removeSlashes turns slashes into underscores for use as a file name.
#

sub removeSlashes
{
  local ($in) = @_;

  $in =~ s|/|_|g;

  return "$in";
}


#
# Usage
#

sub Usage
{
  die("\nusage: $prog [:<number>] [-name <desktop-name>] [-depth <depth>]\n".
    "                 [-geometry <width>x<height>]\n".
    "                 [-pixelformat rgbNNN|bgrNNN]\n".
    "                 [-fp <font-path>]\n".
    "                 [-fg]\n".
    "                 [-autokill]\n".
    "                 [-noxstartup]\n".
    "                 [-xstartup <file>]\n".
    "                 <Xvnc-options>...\n\n".
    "       $prog -kill <X-display>\n\n".
    "       $prog -list\n\n");
}


#
# List
#

sub List
{
  opendir(dir, $vncUserDir);
  my @filelist = readdir(dir);
  closedir(dir);
  print "\nKasmVNC server sessions:\n\n";
  print "X DISPLAY #\tPROCESS ID\n";
  foreach my $file (@filelist) {
    if ($file =~ /$host:(\d+)$\.pid/) {
      chop($tmp_pid = `cat $vncUserDir/$file`);
      if (IsProcessRunning($tmp_pid)) {
        print ":".$1."\t\t".`cat $vncUserDir/$file`;
      } else {
        unlink ($vncUserDir . "/" . $file);
      }
    }
  }
  exit 1;
}


#
# Kill
#

sub Kill
{
  $opt{'-kill'} =~ s/(:\d+)\.\d+$/$1/; # e.g. turn :1.0 into :1

  if ($opt{'-kill'} =~ /^:\d+$/) {
    $pidFile = "$vncUserDir/$host$opt{'-kill'}.pid";
  } else {
    if ($opt{'-kill'} !~ /^$host:/) {
      die "\nCan't tell if $opt{'-kill'} is on $host\n".
      "Use -kill :<number> instead\n\n";
    }
    $pidFile = "$vncUserDir/$opt{'-kill'}.pid";
  }

  if (! -r $pidFile) {
    die "\nCan't find file $pidFile\n".
    "You'll have to kill the Xvnc process manually\n\n";
  }

  $SIG{'HUP'} = 'IGNORE';
  chop($pid = `cat $pidFile`);
  warn "Killing Xvnc process ID $pid\n";

  if (IsProcessRunning($pid)) {
    system("kill $pid");
    WaitForTimeLimitOrSubReturningTrue(1, sub {
        !IsProcessRunning($pid)
      });
    if (IsProcessRunning($pid)) {
      print "Xvnc seems to be deadlocked.  Kill the process manually and then re-run\n";
      print "    ".$0." -kill ".$opt{'-kill'}."\n";
      print "to clean up the socket files.\n";
      exit
    }

  } else {
    warn "Xvnc process ID $pid already killed\n";
    $opt{'-kill'} =~ s/://;

    if (-e "/tmp/.X11-unix/X$opt{'-kill'}") {
      print "Xvnc did not appear to shut down cleanly.";
      print " Removing /tmp/.X11-unix/X$opt{'-kill'}\n";
      unlink "/tmp/.X11-unix/X$opt{'-kill'}";
    }
    if (-e "/tmp/.X$opt{'-kill'}-lock") {
      print "Xvnc did not appear to shut down cleanly.";
      print " Removing /tmp/.X$opt{'-kill'}-lock\n";
      unlink "/tmp/.X$opt{'-kill'}-lock";
    }
  }

  unlink $pidFile;
  exit;
}


#
# ParseOptionsAndRemoveMatchesFromARGV takes a list of possible options. Each
# option has a matching argument, indicating whether the option has a value
# following (can be required or optional), and sets up an associative array %opt
# of the values of the options given on the command line.  It removes all the
# arguments it uses from @ARGV and returns them in @optArgs.
#

sub ParseOptionsAndRemoveMatchesFromARGV
{
  local (@optval) = @_;
  local ($opt, @opts, %valFollows, @newargs);

  while (@optval) {
    $opt = shift(@optval);
    push(@opts,$opt);
    $valFollows{$opt} = shift(@optval);
  }

  @optArgs = ();
  %opt = ();

  arg: while (defined($arg = shift(@ARGV))) {
    foreach $opt (@opts) {
      if ($arg eq $opt) {
        push(@optArgs, $arg);
        switch($valFollows{$opt}) {
          case NO_ARG_VALUE {
            $opt{$opt} = 1;
            next arg;
          }
          case REQUIRED_ARG_VALUE {
            if (@ARGV == 0) {
              Usage();
            }

            $opt{$opt} = shift(@ARGV);
            push(@optArgs, $opt{$opt});

            next arg;
          }
          case OPTIONAL_ARG_VALUE {
            if (scalar @ARGV == 0 || $ARGV[0] =~ /^-/) {
              $opt{$opt} = 1;
              next arg;
            }

            $opt{$opt} = shift(@ARGV);
            push(@optArgs, $opt{$opt});

            next arg;
          }
        }
      }
    }
    push(@newargs,$arg);
  }

  @ARGV = @newargs;
}


# Routine to make sure we're operating in a sane environment.
sub CheckRequiredDependenciesArePresent
{
  local ($cmd);

  # Get the program name
  ($prog) = ($0 =~ m|([^/]+)$|);

  #
  # Check we have all the commands we'll need on the path.
  #

  cmd:
  foreach $cmd ("uname","xauth") {
    for (split(/:/,$ENV{PATH})) {
      if (-x "$_/$cmd") {
        next cmd;
      }
    }
    die "$prog: couldn't find \"$cmd\" on your PATH.\n";
  }

  if($exedir eq "") {
    cmd2:
    foreach $cmd ("Xvnc","vncpasswd") {
      for (split(/:/,$ENV{PATH})) {
        if (-x "$_/$cmd") {
          next cmd2;
        }
      }
      die "$prog: couldn't find \"$cmd\" on your PATH.\n";
    }
  }
  else {
    cmd3:
    foreach $cmd ($exedir."Xvnc",$exedir."vncpasswd") {
      for (split(/:/,$ENV{PATH})) {
        if (-x "$cmd") {
          next cmd3;
        }
      }
      die "$prog: couldn't find \"$cmd\".\n";
    }
  }

  if (!defined($ENV{HOME})) {
    die "$prog: The HOME environment variable is not set.\n";
  }

  #
  # Find socket constants. 'use Socket' is a perl5-ism, so we wrap it in an
  # eval, and if it fails we try 'require "sys/socket.ph"'.  If this fails,
  # we just guess at the values.  If you find perl moaning here, just
  # hard-code the values of AF_INET and SOCK_STREAM.  You can find these out
  # for your platform by looking in /usr/include/sys/socket.h and related
  # files.
  #

  chop($os = `uname`);
  chop($osrev = `uname -r`);

  eval 'use Socket';
  if ($@) {
    eval 'require "sys/socket.ph"';
    if ($@) {
      if (($os eq "SunOS") && ($osrev !~ /^4/)) {
        $AF_INET = 2;
        $SOCK_STREAM = 2;
      } else {
        $AF_INET = 2;
        $SOCK_STREAM = 1;
      }
    } else {
      $AF_INET = &AF_INET;
      $SOCK_STREAM = &SOCK_STREAM;
    }
  } else {
    $AF_INET = &AF_INET;
    $SOCK_STREAM = &SOCK_STREAM;
  }

  CheckUserHasAccessToDefaultCertOnDebian();
}

sub IsDebian {
  return -f "/etc/debian_version";
}

sub CheckUserHasAccessToDefaultCertOnDebian {
  if (!IsDebian()) {
    return;
  }

  my $certGroup = 'ssl-cert';
  if (system("groups | grep -qw $certGroup") != 0) {
    say <<EOF;
  Can't access TLS certificate.
  Please add your user to $certGroup via 'addgroup <user> $certGroup'
EOF
    exit(1);
  }
}

sub CreateXstartupIfNeeded
{
  if ((-e "$xstartupFile")) {
    return;
  }

  my $defaultXStartup
  = ("#!/bin/sh\n\n".
    "unset SESSION_MANAGER\n".
    "unset DBUS_SESSION_BUS_ADDRESS\n".
    "OS=`uname -s`\n".
    "if [ \$OS = 'Linux' ]; then\n".
    "  case \"\$WINDOWMANAGER\" in\n".
    "    \*gnome\*)\n".
    "      if [ -e /etc/SuSE-release ]; then\n".
    "        PATH=\$PATH:/opt/gnome/bin\n".
    "        export PATH\n".
    "      fi\n".
    "      ;;\n".
    "  esac\n".
    "fi\n".
    "if [ -x /etc/X11/xinit/xinitrc ]; then\n".
    "  exec /etc/X11/xinit/xinitrc\n".
    "fi\n".
    "if [ -f /etc/X11/xinit/xinitrc ]; then\n".
    "  exec sh /etc/X11/xinit/xinitrc\n".
    "fi\n".
    "[ -r \$HOME/.Xresources ] && xrdb \$HOME/.Xresources\n".
    "xsetroot -solid grey\n".
    "xterm -geometry 80x24+10+10 -ls -title \"\$VNCDESKTOP Desktop\" &\n".
    "twm\n");

  warn "Creating default startup script $xstartupFile\n";
  open(XSTARTUP, ">$xstartupFile");
  print XSTARTUP $defaultXStartup;
  close(XSTARTUP);
  chmod 0755, "$xstartupFile";
}

sub DetectAndExportDisplay {
  # If the unix domain socket exists then use that (DISPLAY=:n) otherwise use
  # TCP (DISPLAY=host:n)

  if (-e "/tmp/.X11-unix/X$displayNumber" ||
    -e "/usr/spool/sockets/X11/$displayNumber")
  {
    $ENV{DISPLAY}= ":$displayNumber";
  } else {
    $ENV{DISPLAY}= "$host:$displayNumber";
  }
}

sub RunXstartup {
  warn "Starting applications specified in $xstartupFile\n";
  DetectAndExportDisplay();
  $ENV{VNCDESKTOP}= $desktopName;

  if ($opt{'-fg'}) {
    if (! $skipxstartup) {
      system("$xstartupFile >> " . quotedString($desktopLog) . " 2>&1");
    }
    if (IsXvncRunning()) {
      $opt{'-kill'} = ':'.$displayNumber;
      Kill();
    }
  } else {
    if ($opt{'-autokill'}) {
      if (! $skipxstartup) {
        system("($xstartupFile; $0 -kill :$displayNumber) >> "
          . quotedString($desktopLog) . " 2>&1 &");
      }
    } else {
      if (! $skipxstartup) {
        system("$xstartupFile >> " . quotedString($desktopLog)
          . " 2>&1 &");
      }
    }
  }
}

sub DetectBinariesDir {
  my $result = "";
  my $slashndx = rindex($0, "/");

  if($slashndx>=0) {
    $result = substr($0, 0, $slashndx+1);
  }
  if ($result =~ m!unix/!) {
    $result = "/usr/bin/";
  }

  return $result;
}

sub DetectFontPath {
  if (-d "/etc/X11/fontpath.d") {
    $fontPath = "catalogue:/etc/X11/fontpath.d";
  }

  @fontpaths = ('/usr/share/X11/fonts', '/usr/share/fonts', '/usr/share/fonts/X11/');
  if (! -l "/usr/lib/X11") {push(@fontpaths, '/usr/lib/X11/fonts');}
  if (! -l "/usr/X11") {push(@fontpaths, '/usr/X11/lib/X11/fonts');}
  if (! -l "/usr/X11R6") {push(@fontpaths, '/usr/X11R6/lib/X11/fonts');}
  push(@fontpaths, '/usr/share/fonts/default');

  @fonttypes = ('misc',
    '75dpi',
    '100dpi',
    'Speedo',
    'Type1');

  foreach $_fpath (@fontpaths) {
    foreach $_ftype (@fonttypes) {
      if (-f "$_fpath/$_ftype/fonts.dir") {
        if (! -l "$_fpath/$_ftype") {
          $defFontPath .= "$_fpath/$_ftype,";
        }
      }
    }
  }

  if ($defFontPath) {
    if (substr($defFontPath, -1, 1) == ',') {
      chop $defFontPath;
    }
  }

  if ($fontPath eq "") {
    $fontPath = $defFontPath;
  }
}

sub ProcessCliOptions {
  Usage() if ($opt{'-help'} || $opt{'-h'} || $opt{'--help'});

  Kill() if ($opt{'-kill'});

  List() if ($opt{'-list'});

  # Uncomment this line if you want default geometry, depth and pixelformat
  # to match the current X display:
  # GetXDisplayDefaults();

  if ($opt{'-geometry'}) {
    $geometry = $opt{'-geometry'};
  }
  if ($opt{'-depth'}) {
    $depth = $opt{'-depth'};
    $pixelformat = "";
  }
  if ($opt{'-pixelformat'}) {
    $pixelformat = $opt{'-pixelformat'};
  }
  if ($opt{'-noxstartup'}) {
    $skipxstartup = 1;
  }
  if ($opt{'-xstartup'}) {
    $xstartupFile = $opt{'-xstartup'};
  }
  if ($opt{'-fp'}) {
    $fontPath = $opt{'-fp'};
    $fpArgSpecified = 1;
  }
  if ($opt{'-debug'}) {
    delete $opt{'-debug'};
    $opt{'-log'} = '*:stderr:100';
  }
}

sub CreateDotVncDir {
  if (!(-e $vncUserDir)) {
    if (!mkdir($vncUserDir,0755)) {
      die "$prog: Could not create $vncUserDir.\n";
    }
  }
}

sub DeWasSelectedEarlier {
  -e $de_was_selected_file;
}

sub AskUserToChooseDeOrManualXstartup {
  return if (IsDryRun());

  if (DeWasSelectedEarlier() && !$opt{'-select-de'}) {
    return;
  }

  ForgetSelectedDe();

  $selectDeCmd = ConstructSelectDeCmd();
  system($selectDeCmd) == 0 || die("Failed to execute $selectDeCmd\n");
}

sub ConstructSelectDeCmd {
  my $cmd = "$selectDeBin";
  my $specifiedDe = $opt{'-select-de'};

  if ($specifiedDe) {
    $cmd .= " --select-de";
    if ($specifiedDe != 1) {
      $cmd .= " $specifiedDe";
    }
  }

  $cmd;
}

sub ForgetSelectedDe {
  unlink $de_was_selected_file;
}

sub DetectDisplayNumberFromCliArgs {
  if (@ARGV == 0) {
    return;
  }

  my $displayNumber;
  if ($ARGV[0] =~ /^:(\d+)$/) {
    $displayNumber = $1;
    shift(@ARGV);
    if (!CheckVncIsntRunningOnDisplay($displayNumber)) {
      die "A VNC server is already running as :$displayNumber\n";
    }
  }

  $displayNumber;
}

sub CheckCliOptionsForBeingValid {
  if (@ARGV == 0) {
    return;
  }

  if (! IsCliOption($ARGV[0])) {
    Usage();
  }
}

sub IsCliOption {
  my $arg = shift;

  ($arg =~ /^-/) || ($arg =~ /^\+/);
}

sub SetReasonabeDefaults {
  $default_opts{desktop} = quotedString($desktopName);
  $default_opts{auth} = quotedString($xauthorityFile);
  $default_opts{geometry} = $geometry if ($geometry);
  $default_opts{depth} = $depth if ($depth);
  $default_opts{pixelformat} = $pixelformat if ($pixelformat);
  $default_opts{rfbwait} = 30000;
  $default_opts{rfbauth} = "$vncUserDir/passwd";
  $default_opts{websocketPort} = $websocketPort;
  $default_opts{fp} = $fontPath if ($fontPath);
  $default_opts{pn} = "";
  $default_opts{interface} = "0.0.0.0";
}

sub LoadSystemThenUserThenMandatoryConfigs {
  # Load user-overrideable system defaults
  LoadConfig($vncSystemConfigDefaultsFile);

  # Then the user's settings
  LoadConfig($vncUserConfig);

  # And then override anything set above if mandatory settings exist.
  # WARNING: "Mandatory" is used loosely here! As the man page says,
  # there is nothing stopping someone from EASILY subverting the
  # settings in $vncSystemConfigMandatoryFile by simply passing
  # CLI args to vncserver, which trump config files! To properly
  # hard force policy in a non-subvertible way would require major
  # development work that touches Xvnc itself.
  LoadConfig($vncSystemConfigMandatoryFile, 1);
}

sub DisableLegacyVncAuth() {
  # Disable vnc auth, kasmvnc uses https basic auth
  system("echo 'WrLNwLrcrxM=' | base64 -d > $vncUserDir/passwd");
}

sub TellUserToSetupUserAndPassword {
  if (AtLeastOneUserConfigured()) {
    return;
  }

  warn "\nYou will require a password to access your desktops.\n\n";
  system($exedir."kasmvncpasswd $kasmPasswdFile");
  if (($? >> 8) != 0) {
    exit 1;
  }
}

sub GuideUserToSetupKasmPasswdUser {
  my $defaultUser = $ENV{USER};
  print(<<"NEEDTOCREATEUSER");

In order to access your desktop, at least one KasmVNC user must be setup.
Let's create a user.

NEEDTOCREATEUSER

  my $username = Prompt("Enter username (default: $defaultUser): ");
  $username ||= $defaultUser;

  system($exedir."kasmvncpasswd -u \"$username\" -w $kasmPasswdFile");
  if ($?) {
    die("\nFailed to setup user \"$username\"\n");
  }
  print("Created user \"$username\"\n");
}

sub Prompt {
  my $prompt = shift;

  print($prompt);
  my $userInput = <STDIN>;
  $userInput =~ s/^\s+|\s+$//g;

  return $userInput;
}

sub AtLeastOneUserConfigured {
  scalar @kasmPasswdUsers > 0;
}

sub LoadKasmPasswdUsers {
  my @result = ();
  my %permissionExplanations = ("w" => "can use keyboard and mouse",
    "o" => "can add/remove users",
    "ow" => "can use keyboard and mouse, add/remove users",
    "" => "can only view");

  open(FH, '<', $kasmPasswdFile) or return @result;

  while(<FH>){
    chomp $_;
    my ($name, $__, $permissions) = split(':', $_);
    push(@result, "$name ($permissionExplanations{$permissions})");
  }

  close(FH);

  return @result;
}

sub MakeXCookie {
  # Make an X server cookie and set up the Xauthority file
  # mcookie is a part of util-linux, usually only GNU/Linux systems have it.
  my $cookie = `mcookie`;
  # Fallback for non GNU/Linux OS - use /dev/urandom on systems that have it,
  # otherwise use perl's random number generator, seeded with the sum
  # of the current time, our PID and part of the encrypted form of the password.
  if ($cookie eq "" && open(URANDOM, '<', '/dev/urandom')) {
    my $randata;
    if (sysread(URANDOM, $randata, 16) == 16) {
      $cookie = unpack 'h*', $randata;
    }
    close(URANDOM);
  }
  if ($cookie eq "") {
    srand(time+$$+unpack("L",`cat $vncUserDir/passwd`));
    for (1..16) {
      $cookie .= sprintf("%02x", int(rand(256)) % 256);
    }
  }

  return $cookie;
}

sub SetupXauthorityFile {
  my $cookie = MakeXCookie();

  open(XAUTH, "|xauth -f $xauthorityFile source -");
  print XAUTH "add $host:$displayNumber . $cookie\n";
  print XAUTH "add $host/unix:$displayNumber . $cookie\n";
  close(XAUTH);
}

sub ConstructXvncCmd {
  my $cmd = $exedir."Xvnc :$displayNumber";

  foreach my $k (sort keys %config) {
    $cmd .= " -$k $config{$k}";
    delete $default_opts{$k}; # file options take precedence
  }

  foreach my $k (sort keys %default_opts) {
    $cmd .= " -$k $default_opts{$k}";
  }

  # Add color database stuff here, e.g.:
  # $cmd .= " -co /usr/lib/X11/rgb";

  foreach $arg (@ARGV) {
    $cmd .= " " . quotedString($arg);
  }

  $cmd .= SwallowedArgs();
  $cmd .= ConvertConfigToXvncArgs();

  $cmd .= " >> " . quotedString($desktopLog) . " 2>&1";

  return $cmd;
}

sub SwallowedArgs {
  my $cmd;

  if ($opt{"-interface"}) {
    $cmd .= " " . "-interface " . quotedString($opt{"-interface"});
  }
  if ($opt{"-log"}) {
    $cmd .= " " . "-log " . quotedString($opt{"-log"});
  }

  $cmd;
}

sub StartXvncAndRecordPID {
  system("$cmd & echo \$! >$pidFile");
}

sub DeleteLogLeftFromPreviousXvncRun {
  unlink($desktopLog);
}

sub StartXvncWithSafeFontPath {
  if ($fpArgSpecified) {
    warn "\nWARNING: The first attempt to start Xvnc failed, probably because the font\n";
    warn "path you specified using the -fp argument is incorrect.  Attempting to\n";
    warn "determine an appropriate font path for this system and restart Xvnc using\n";
    warn "that font path ...\n";
  } else {
    warn "\nWARNING: The first attempt to start Xvnc failed, possibly because the font\n";
    warn "catalog is not properly configured.  Attempting to determine an appropriate\n";
    warn "font path for this system and restart Xvnc using that font path ...\n";
  }
  $cmd =~ s@-fp [^ ]+@@;
  $cmd .= " -fp $defFontPath" if ($defFontPath);
  StartXvncAndRecordPID();
}

sub IsXvncRunning {
  IsProcessRunning(`cat $pidFile`);
}

sub WarnUserXvncNotStartedAndExit {
  warn "Could not start Xvnc.\n\n";
  unlink $pidFile;
  open(LOG, "<$desktopLog");
  while (<LOG>) { print; }
  close(LOG);
  die "\n";
}

sub WaitForXvncToRespond {
  my $sleepSlice = 0.1;
  my $sleptFor = 0;
  my $sleepLimit = 3;

  until (IsXvncResponding() || $sleptFor >= $sleepLimit) {
    sleep($sleepSlice);
    $sleptFor += $sleepSlice;
  }
}

sub IsXvncResponding {
  `xdpyinfo -display :$displayNumber >/dev/null 2>&1`;
  $? == 0;
}

sub UsingSafeFontPath {
  $fontPath eq $defFontPath
}

sub CreateUserConfigIfNeeded {
  if (-e "$vncUserDir/config") {
    return;
  }

  warn "Creating default config $vncUserDir/config\n";
  open(VNCUSERCONFIG, ">$vncUserDir/config");
  print VNCUSERCONFIG $defaultConfig;
  close(VNCUSERCONFIG);
  chmod 0644, "$vncUserDir/config";
}

sub PrintKasmUsers {
  warn "\nUsers configured:\n";
  foreach my $user (@kasmPasswdUsers) {
    warn "$user\n";
  }
  warn "\n";
}

sub CheckWeCanRunInThisEnvironment {
  $exedir = DetectBinariesDir();
  CheckRequiredDependenciesArePresent();
}

sub DefineFilePathsAndStuff {
  #
  # Global variables.  You may want to configure some of these for
  # your site
  #

  $geometry = "1024x768";

  $vncUserDir = "$ENV{HOME}/.vnc";
  $vncUserConfig = "$vncUserDir/config";
  $kasmPasswdFile = "$ENV{HOME}/.kasmpasswd";

  $selectDeBin = DetectSelectDeBin();
  $de_was_selected_file="$ENV{HOME}/.vnc/.de-was-selected";

  $vncSystemConfigDir = "/etc/kasmvnc";
  $vncDefaultsConfig = "/src/unix/vncserver_defaults.yaml";
  $vncSystemConfig = "/src/unix/vncserver.yaml";
  $vncSystemConfigDefaultsFile = "$vncSystemConfigDir/vncserver-config-defaults";
  $vncSystemConfigMandatoryFile = "$vncSystemConfigDir/vncserver-config-mandatory";
  $defaultWebsocketPort = 8443;

  $skipxstartup = 0;
  $xauthorityFile = "$ENV{XAUTHORITY}" || "$ENV{HOME}/.Xauthority";

  $xstartupFile = $vncUserDir . "/xstartup";
  $defaultConfig
  = ("## Supported server options to pass to vncserver upon invocation can be listed\n".
    "## in this file. See the following manpages for more: vncserver(1) Xvnc(1).\n".
    "## Several common ones are shown below. Uncomment and modify to your liking.\n".
    "##\n".
    "# securitytypes=vncauth,tlsvnc\n".
    "# desktop=sandbox\n".
    "# geometry=2000x1200\n".
    "# localhost\n".
    "# alwaysshared\n");

  chop($host = `uname -n`);
  chop($hostIP = `hostname -i`);

  DetectFontPath();

  %xvncArgsToConfigAliases = (
    '-AcceptPointerEvents' => [qw(pointer.allow_clicks_and_cursor_movement)],
    '-AcceptKeyEvents' => [qw(data_loss_prevention.keyboard.allow_input)],
    '-AcceptSetDesktopSize' => [qw(desktop.allow_resize)],
    '-FrameRate' => [qw(framerate)],
    '-DynamicQualityMin' => [qw(dynamic_quality.min)],
    '-DynamicQualityMax' => [qw(dynamic_quality.max)],
    '-TreatLossless' => [qw(treat_lossless)],
    '-PreferBandwidth' => [qw(prefer_bandwidth)],
    '-JpegVideoQuality' => [qw(video.jpeg_quality)],
    '-WebpVideoQuality' => [qw(video.webp_quality)],
    '-VideoScaling' => [qw(video.scaling_method)],
    '-PrintVideoArea' => [qw(video.print_video_area)],
    # Clipboard
    '-SendCutText' => [qw(data_loss_prevention.clipboard.allow_copy_to_client_clipboard)],
    '-AcceptCutText' => [qw(data_loss_prevention.clipboard.allow_paste_to_server)],
    '-SendPrimary' => [qw(data_loss_prevention.clipboard.allow_copy_primary_selection_to_client_clipboard)],
    '-DLP_ClipSendMax' => [qw(data_loss_prevention.clipboard.limit_bytes_copied_to_client_clipboard)],
    '-DLP_ClipAcceptMax' => [qw(data_loss_prevention.clipboard.limit_bytes_pasted_to_server_clipboard)],
    '-DLP_Region' => [qw(data_loss_prevention.region.coords)],
    '-DLP_ClipDelay' => [qw(data_loss_prevention.clipboard.delay_in_milliseconds)],
    # '-DLP_KeyRateLimit' => [qw(data_loss_prevention.keyboard.limit_keypress_rate_per_second)],
    '-httpd' => [qw(httpd_directory)],
    '-disableBasicAuth' => [qw(disable_basic_auth)],
    '-IdleTimeout' => [qw(idle_timeout)],
    '-MaxDisconnectionTime' => [qw(max_disconnection_time)],
    '-localhost' => [qw(allow_localhost_only)],
    '-QueryConnect' => [qw(query_connect)],
    '-DLP_Log' => [qw(data_loss_prevention_log)],
  );
}

sub ParseAndProcessCliOptions {
  my @supportedOptions = ("-geometry",1,"-depth",1,"-pixelformat",1,"-name",1,"-kill",1,"-help",0,"-h",0,"--help",0,"-fp",1,"-list",0,"-fg",0,"-autokill",0,"-noxstartup",0,"-xstartup",1,"-select-de",OPTIONAL_ARG_VALUE, "-interface", REQUIRED_ARG_VALUE, '-debug', NO_ARG_VALUE, '-websocketPort', REQUIRED_ARG_VALUE, "-dry-run", NO_ARG_VALUE);
  ParseOptionsAndRemoveMatchesFromARGV(@supportedOptions);
  ProcessCliOptions();
  CheckGeometryAndDepthAreSensible();

  $displayNumber = DetectDisplayNumberFromCliArgs();
  if (!defined($displayNumber)) {
    $displayNumber = GetLowestAvailableDisplayNumber();
  }
  CheckCliOptionsForBeingValid();
}

sub CheckBrowserHostDefined {
  DeduceBrowserHost() || \
    die "-interface has no default value and wasn't passed by user";
}

sub PrepareDefaultsForPassingToXvnc {
  # We set some reasonable defaults. Config file settings
  # override these where present.
  %default_opts;
  %config;

  $websocketPort = $opt{"-websocketPort"} ||
    GenerateWebsocketPortFromDisplayNumber();
  $desktopName = $opt{'-name'} || "$host:$displayNumber ($ENV{USER})";

  SetReasonabeDefaults();
  LoadSystemThenUserThenMandatoryConfigs();
  CheckBrowserHostDefined();
}

sub GenerateWebsocketPortFromDisplayNumber {
  $defaultWebsocketPort + $displayNumber;
}

sub EnsureAtLeastOneKasmUserExists {
  return if (IsDryRun());

  @kasmPasswdUsers = LoadKasmPasswdUsers();
  if (!AtLeastOneUserConfigured()) {
    GuideUserToSetupKasmPasswdUser();
    @kasmPasswdUsers = LoadKasmPasswdUsers();
  }
}

sub StartXvncOrExit {
  $cmd = ConstructXvncCmd();
  if (IsDryRun()) {
    say $cmd;
    exit(0);
  }

  DeleteLogLeftFromPreviousXvncRun();
  StartXvncAndRecordPID();
  WaitForXvncToRespond();

  if (!IsXvncRunning() && !UsingSafeFontPath())  {
    StartXvncWithSafeFontPath();
    WaitForXvncToRespond();
  }

  unless (IsXvncRunning()) {
    WarnUserXvncNotStartedAndExit();
  }
}

sub WaitForTimeLimitOrSubReturningTrue {
  my ($timeLimit, $sub) = @_;
  my $sleepSlice = 0.05;
  my $sleptFor = 0;

  until (&$sub() || $sleptFor >= $timeLimit) {
    sleep($sleepSlice);
    $sleptFor += $sleepSlice;
  }
}

sub IsProcessRunning {
  my $pid = shift;
  unless ($pid) { return 0 };

  kill 0, $pid;
}

sub DefineLogAndPidFilesForDisplayNumber {
  $desktopLog = "$vncUserDir/$host:$displayNumber.log";
  $pidFile = "$vncUserDir/$host:$displayNumber.pid";
}

sub PrepareLoggingAndXvncKillingFramework {
  CreateDotVncDir();
  DefineLogAndPidFilesForDisplayNumber();
}

sub AllowXProgramsToConnectToXvnc {
  SetupXauthorityFile();
}

sub PrintLogFilenameAndConfiguredUsersAndStuff {
  warn "\nNew '$desktopName' desktop is $host:$displayNumber\n";
  PrintKasmUsers();
  warn "Log file is $desktopLog\n\n";
}

sub PrintBrowserUrl {
  my $browserUrl = ConstructBrowserUrl();
  warn "\nPaste this url in your browser: $browserUrl\n"
}

sub IsAllInterfaces {
  my $interface = shift;

  $interface eq "0.0.0.0";
}

sub DeduceBrowserHost {
  my $browserHost;
  my $interface = $opt{"-interface"} || $default_opts{interface};

  if (IsAllInterfaces($interface)) {
    $browserHost = $hostIP;
  } else {
    $browserHost = $interface;
  }

  $browserHost;
}

sub ConstructBrowserUrl {
  my $browserHost = DeduceBrowserHost();
  my $browserPort = $websocketPort;

  "https://$browserHost:$browserPort";
}

sub IsThisSystemBinary {
  $0 =~ m!^/usr!;
}

sub DetectSelectDeBin {
  if (IsThisSystemBinary()) {
    "/usr/lib/kasmvncserver/select-de.sh";
  } else {
    LocalSelectDePath();
  }
}

sub LocalSelectDePath {
  my $dirname = dirname($0);
  "$dirname/../builder/startup/deb/select-de.sh";
}

sub IsDryRun {
  $opt{"-dry-run"};
}

sub LoadYAMLConfig {
  if (! -f $vncDefaultsConfig) {
    die "Couldn't load config: $vncDefaultsConfig";
  }

  my $defaultsConfig = YAML::Tiny->read($vncDefaultsConfig)->[0];
  my $systemConfig = YAML::Tiny->read($vncSystemConfig)->[0];
  %mergedConfig = %{ Hash::Merge::Simple::merge($defaultsConfig, $systemConfig) };

  # say $mergedConfig{framerate};
  # say $mergedConfig{data_loss_prevention}{region}{x1};
  # say ConvertConfigToXvncArgs();
}

sub ConvertConfigToXvncArgs {
  my $result = "";

  foreach my $cliArg (keys %xvncArgsToConfigAliases) {
    my $xvncCliArgWithValue = ComplementCliArgWithValue($cliArg);
    next unless defined($xvncCliArgWithValue);

    $result .= " $xvncCliArgWithValue";
  }

  $result;
}

sub ComplementCliArgWithValue {
  my $cliArg = $_[0];

  my $firstDefinedConfigKey = FirstDefinedConfigKey($cliArg);
  return unless defined($firstDefinedConfigKey);

  my $cliValue = ConfigValue($firstDefinedConfigKey);
  return unless defined($cliValue);

  switch($cliValue) {
    case "default" {
      say "default value for $cliArg, skipping";
      next;
    }
    case "true" {
      $cliValue = "1";
    }
    case "false" {
      $cliValue = "0";
    }
  }

  "$cliArg $cliValue";
}

sub FirstDefinedConfigKey {
  my $cliArg = $_[0];
  my @configAliases = @{ $xvncArgsToConfigAliases{$cliArg} };

  first { ConfigValue($_) } @configAliases;
}

sub ConfigValue {
  my $absoluteKey = $_[0];
  my @keyParts = split(/\./, $absoluteKey);
  my %configPart = %mergedConfig;

  foreach my $keyPart (@keyParts) {
    if (!defined($configPart{$keyPart})) {
      return;
    }

    if (ref $configPart{$keyPart} eq "HASH") {
      %configPart = % { $configPart{$keyPart} };
      next;
    }

    return $configPart{$keyPart};
  }
}