#!/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 warnings; sub DEVENV() { $ENV{KASMVNC_DEVELOPMENT} }; use if DEVENV, Devel::StackTrace; use Time::HiRes qw (sleep); use Switch; use File::Basename; use List::Util qw(first); use List::MoreUtils qw(any uniq); use Data::Dumper; use Try::Tiny; use KasmVNC::CliOption; use KasmVNC::ConfigKey; use KasmVNC::PatternValidator; use KasmVNC::EnumValidator; use KasmVNC::Config; use KasmVNC::Users; use KasmVNC::TextOption; use KasmVNC::TextUI; use KasmVNC::Utils; use KasmVNC::Logger; use constant { NO_ARG_VALUE => 0, REQUIRED_ARG_VALUE => 1, OPTIONAL_ARG_VALUE => 2 }; InitLogger(); CheckWeCanRunInThisEnvironment(); DefineFilePathsAndStuff(); ParseAndProcessCliOptions(); PrepareLoggingAndXvncKillingFramework(); CreateUserConfigIfNeeded(); DefineConfigToCLIConversion(); LoadConfigs(); ActivateConfigToCLIConversion(); SetAppSettingsFromConfigAndCli(); DisableLegacyVncAuth(); AllowXProgramsToConnectToXvnc(); EnsureAtLeastOneKasmUserExists(); ConfigureDeToRun(); StartXvncOrExit(); PrintLogFilenameAndConfiguredUsersAndStuff(); if (! $skipxstartup) { CreateXstartupIfNeeded(); RunXstartup(); } PrintBrowserUrl(); exit; ############################################################################### # Functions ############################################################################### # # 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") { $logger->warn("\nWarning: $host:$n is taken because of /tmp/.X$n-lock"); $logger->warn("Remove this file if there is no X server $host:$n"); return 0; } if (-e "/tmp/.X11-unix/X$n") { $logger->warn("\nWarning: $host:$n is taken because of /tmp/.X11-unix/X$n"); $logger->warn("Remove this file if there is no X server $host:$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 [:] [-desktop ] [-depth ]\n". " [-geometry x]\n". " [-pixelformat rgbNNN|bgrNNN]\n". " [-fp ]\n". " [-fg]\n". " [-autokill]\n". " [-noxstartup]\n". " [-xstartup ]\n". " ...\n\n". " $prog -kill \n\n". " $prog -list\n\n"); } # # List # sub List { opendir(dirHandle, $vncUserDir); my @filelist = readdir(dirHandle); closedir(dirHandle); 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 : 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`); $logger->warn("Killing Xvnc process ID $pid"); 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 { $logger->warn("Xvnc process ID $pid already killed"); $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","hostname","whoami") { 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; } } sub CheckSslCertReadable { return if IsDryRun(); RequireSslCertsToBeReadable(); } sub IsDebian { return -f "/etc/debian_version"; } sub RequireSslCertsToBeReadable { my $certFilename = DerivedValue("network.ssl.pem_certificate"); my $certKeyFilename = DerivedValue("network.ssl.pem_key"); @certs = ($certFilename, $certKeyFilename); @certs = grep defined, @certs; @certs = uniq @certs; my @unreadableCertFiles = map { -r $_ ? () : $_ } @certs; return if (scalar @unreadableCertFiles == 0); foreach my $unreadableCert (@unreadableCertFiles) { GuideUserToMakeCertFileReadable($unreadableCert); } exit 1; } sub FileGroupName { my $file = shift; my $grpId = (stat($file))[5]; getgrgid($grpId); } sub AddUserToGroupCmd { my $certGroup = shift; if (IsRpmSystem()) { "usermod -a -G $certGroup \$USER" } else { "addgroup \$USER $certGroup" } } sub GuideUserToMakeCertFileReadable { my $certFile = shift; if (! -f $certFile) { $logger->warn("$certFile: certificate file doesn't exist or isn't a file"); return; } my $certGroup = FileGroupName $certFile; my $addUserToGroupCmd = AddUserToGroupCmd $certGroup; $logger->warn(</dev/null 2>&1") == 0; } sub RequireUserToHaveKasmvncCertGroup { my $certGroup = 'kasmvnc-cert'; if (system("groups | grep -qw $certGroup") != 0) { $logger->warn(<warn("Creating default startup script $xstartupFile"); 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 { $logger->warn("Starting applications specified in $xstartupFile"); 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) eq ',') { chop $defFontPath; } } if (!defined($fontPath) || $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{'-noxstartup'}) { $skipxstartup = 1; } if ($opt{'-xstartup'}) { $xstartupFile = $opt{'-xstartup'}; } if ($opt{'-fp'}) { $fontPath = $opt{'-fp'}; $fpArgSpecified = 1; } if ($opt{'-debug'}) { $debug = 1; delete $opt{'-debug'}; $opt{'-Log'} = '*:stderr:100'; } if ($opt{'-config'}) { @configFiles = split ",", $opt{'-config'}; delete $opt{'-config'}; } $testOutputTopic = $opt{'-test-output-topic'}; } sub CreateDotVncDir { if (!(-e $vncUserDir)) { if (!mkdir($vncUserDir,0755)) { die "$prog: Could not create $vncUserDir.\n"; } } } sub DeWasSelectedEarlier { -e $de_was_selected_file; } sub DeWasSpecifiedOnCommandLine { defined($opt{'-select-de'}) && $opt{'-select-de'} ne "1"; } sub PromptingForDeWasRequestedOnCommandLine { return unless defined($opt{'-select-de'}); $opt{'-select-de'} == 1; } sub WarnIfShouldPromptForDe { return unless shouldPromptUserToSelectDe(); $logger->warn(<userExists($userToCreate)) { say "User already exists: \"$userToCreate\""; next; } last; }; $userToCreate; } sub GuideUserToSetupKasmPasswdUser { my $userToCreate = GuideUserToEnterUserToCreate(); unless ($users->addUser($userToCreate, "w")) { die("\nFailed to setup user \"$userToCreate\"\n"); } print("Created user \"$userToCreate\"\n"); } sub AtLeastOneUserConfigured { $users->count() > 0; } 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 UserSpecifiedArgsToCmd { my $cmd = ""; foreach my $arg (@ARGV) { $cmd .= " " . quotedString($arg); noteXvncOption($arg) if $arg =~ /^-/; } $cmd; } sub ConstructXvncCmd { my $cmd = $exedir."Xvnc :$displayNumber"; $cmd .= UserSpecifiedArgsToCmd(); $cmd .= SwallowedArgsToCmd(); $cmd .= ConfigToCmd(); $cmd .= LegacyModeArgsToCmd(); $cmd .= " >> " . quotedString($desktopLog) . " 2>&1"; return $cmd; } sub LegacyModeArgsToCmd { my %legacyOptions = ( -rfbauth => "$vncUserDir/passwd", -rfbport => 5901, -rfbwait => 30000 ); my @cmd = (); while(my($optionName, $optionArg) = each %legacyOptions) { next if WasOptionSpecifiedViaCli($optionName); my $optionText = "$optionName " . quotedString($optionArg); push(@cmd, $optionText); noteXvncOption($optionName); } my $legacyCmd = join " ", @cmd; " $legacyCmd"; } sub noteXvncOption { my $optionName = shift; $addedXvncOptions{$optionName} = 1; } sub WasOptionSpecifiedViaCli { my $optionName = shift; $addedXvncOptions{$optionName}; } sub SwallowedArgsToCmd { my @swallowedOptions = qw(-fp -interface -websocketPort -Log); my @optionsInCliFormat = map { SwallowedOptionToCLI($_) } @swallowedOptions; " " . join " ", @optionsInCliFormat; } sub SwallowedOptionToCLI { my $optionName = shift; return unless ($opt{$optionName}); noteXvncOption($optionName); "$optionName " . quotedString($opt{$optionName}); } sub StartXvncAndRecordPID { system("$cmd & echo \$! >$pidFile"); } sub DeleteLogLeftFromPreviousXvncRun { unlink($desktopLog); } sub StartXvncWithSafeFontPath { if ($fpArgSpecified) { $logger->warn("\nWARNING: The first attempt to start Xvnc failed, probably because the font"); $logger->warn("path you specified using the -fp argument is incorrect. Attempting to"); $logger->warn("determine an appropriate font path for this system and restart Xvnc using"); $logger->warn("that font path ..."); } else { $logger->warn("\nWARNING: The first attempt to start Xvnc failed, possibly because the font"); $logger->warn("catalog is not properly configured. Attempting to determine an appropriate"); $logger->warn("font path for this system and restart Xvnc using that font path ..."); } $cmd =~ s@-fp [^ ]+@@; $cmd .= " -fp $defFontPath" if ($defFontPath); StartXvncAndRecordPID(); } sub IsXvncRunning { IsProcessRunning(`cat $pidFile`); } sub WarnUserXvncNotStartedAndExit { $logger->warn("Could not start Xvnc.\n"); unlink $pidFile; open(LOG, "<$desktopLog"); while () { 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 { my $configFilename = "$vncUserDir/kasmvnc.yaml"; if (-e $configFilename) { return; } $logger->warn("Creating default config $configFilename"); open(VNCUSERCONFIG, ">$configFilename"); print VNCUSERCONFIG $defaultConfig; close(VNCUSERCONFIG); chmod 0644, "$configFilename"; } sub PrintKasmUsers { $logger->warn("\nUsers configured:"); $logger->warn($users->toString()); $logger->warn(""); } 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"; $KasmVNC::Users::vncPasswdBin = $exedir . "kasmvncpasswd"; $KasmVNC::Users::logger = $logger; $vncSystemConfigDir = "/etc/kasmvnc"; if ($ENV{KASMVNC_DEVELOPMENT}) { $vncDefaultsConfig = "/src/unix/kasmvnc_defaults.yaml"; $vncSystemConfig = "/src/unix/kasmvnc.yaml"; } else { $vncDefaultsConfig = "/usr/share/kasmvnc/kasmvnc_defaults.yaml"; $vncSystemConfig = "$vncSystemConfigDir/kasmvnc.yaml"; } $vncUserConfig = "$ENV{HOME}/.vnc/kasmvnc.yaml"; @configFiles = ($vncDefaultsConfig, $vncSystemConfig, $vncUserConfig); $defaultWebsocketPort = 8443; $skipxstartup = 0; $xauthorityFile = $ENV{XAUTHORITY} // "$ENV{HOME}/.Xauthority"; $xstartupFile = $vncUserDir . "/xstartup"; $defaultConfig = <hasKey($_) } @allowedVncModeOptions; } sub DefineConfigToCLIConversion { $KasmVNC::CliOption::fetchValueSub = \&ConfigValue; $KasmVNC::ConfigKey::fetchValueSub = \&ConfigValue; my $regionValidator = KasmVNC::PatternValidator->new({ pattern => qr/^(-)?\d+(%)?$/, errorMessage => "must be an integer or percentage" }); my $clipboardSizeValidator = KasmVNC::PatternValidator->new({ pattern => qr/^(unlimited|\d+)$/, errorMessage => "must be 'unlimited' or a number" }); my $autoNumberValidator = KasmVNC::PatternValidator->new({ pattern => qr/^(auto|\d+)$/, errorMessage => "must be 'auto' or a number" }); my $secondsValidator = KasmVNC::PatternValidator->new({ pattern => qr/^(never|\d+)$/, errorMessage => "must be a number or 'never'" }); my $allConfigKeysValidatorSub = sub { my @allConfigKeys = map { $_->configKeyNames() } @xvncOptions; KasmVNC::EnumValidator->new({ allowedValues => [flatten(@allConfigKeys)] }) }; KasmVNC::CliOption::beforeIsActive(\&limitVncModeOptions); my $ipv4_regexp = '((25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)(\.|$)){4}'; my $ipv6_regexp = '(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))'; @xvncOptions = ( KasmVNC::CliOption->new({ name => 'geometry', configKeys => [ KasmVNC::ConfigKey->new({ name => "desktop.resolution.width", type => KasmVNC::ConfigKey::INT }), KasmVNC::ConfigKey->new({ name => "desktop.resolution.height", type => KasmVNC::ConfigKey::INT }) ], deriveValueSub => sub { $self = shift; my $width = $self->{'desktop.resolution.width'}; my $height = $self->{'desktop.resolution.height'}; if (defined($width) && defined($height)) { return $width . "x" . $height; } $geometry; } }), KasmVNC::CliOption->new({ name => 'AcceptSetDesktopSize', configKeys => [ KasmVNC::ConfigKey->new({ name => "desktop.allow_resize", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'depth', configKeys => [ KasmVNC::ConfigKey->new({ name => "desktop.pixel_depth", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(16 24 32)] }) }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); $value || $depth; } }), KasmVNC::CliOption->new({ name => 'noWebsocket', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.protocol", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(http vnc)] }) }) ], isActiveSub => sub { my $self = shift; my $protocol = $self->{"network.protocol"}; return unless defined($protocol); $protocol eq "vnc"; }, deriveValueSub => sub { 1 } }), KasmVNC::CliOption->new({ name => 'websocketPort', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.websocket_port", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(auto|\d+)$/, errorMessage => "must be one a number or 'auto'" }), }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if ($value eq 'auto' || !defined($value)) { return GenerateWebsocketPortFromDisplayNumber(); } $value; } }), KasmVNC::CliOption->new({ name => 'interface', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.interface", type => KasmVNC::ConfigKey::ANY }) ] }), KasmVNC::CliOption->new({ name => 'UseIPv4', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.use_ipv4", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'UseIPv6', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.use_ipv6", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'cert', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.ssl.pem_certificate", type => KasmVNC::ConfigKey::ANY }) ] }), KasmVNC::CliOption->new({ name => 'key', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.ssl.pem_key", type => KasmVNC::ConfigKey::ANY }) ] }), KasmVNC::CliOption->new({ name => 'sslOnly', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.ssl.require_ssl", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'AlwaysShared', configKeys => [ KasmVNC::ConfigKey->new({ name => "user_session.session_type", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(shared exclusive)] }) }) ], deriveValueSub => sub { 1; }, isActiveSub => sub { my $self = shift; my $sessionType = $self->configValue(); return unless defined($sessionType); $sessionType eq "shared"; } }), KasmVNC::CliOption->new({ name => 'DisconnectClients', configKeys => [ KasmVNC::ConfigKey->new({ name => "user_session.new_session_disconnects_existing_exclusive_session", type => KasmVNC::ConfigKey::ANY }) ], deriveValueSub => sub { my $self = shift; $self->configValue() eq "true" ? 1 : 0; } }), KasmVNC::CliOption->new({ name => 'NeverShared', configKeys => [ KasmVNC::ConfigKey->new({ name => "user_session.session_type", type => KasmVNC::ConfigKey::ANY }) ], deriveValueSub => sub { 1; }, isActiveSub => sub { my $self = shift; my $sessionType = $self->configValue(); return unless defined($sessionType); $sessionType eq "exclusive"; }, }), KasmVNC::CliOption->new({ name => 'QueryConnect', configKeys => [ KasmVNC::ConfigKey->new({ name => "user_session.concurrent_connections_prompt", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'IdleTimeout', configKeys => [ KasmVNC::ConfigKey->new({ name => "user_session.idle_timeout", validator => $secondsValidator }) ], deriveValueSub => \&deriveSeconds }), KasmVNC::CliOption->new({ name => 'RemapKeys', configKeys => [ KasmVNC::ConfigKey->new({ name => "keyboard.remap_keys", validator => KasmVNC::PatternValidator->new({ pattern => qr/^0x[[:xdigit:]]+->0x[[:xdigit:]]+$/, errorMessage => "must be in the format 0x->0x" }), }) ] }), KasmVNC::CliOption->new({ name => 'AvoidShiftNumLock', configKeys => [ KasmVNC::ConfigKey->new({ name => "keyboard.ignore_numlock", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'RawKeyboard', configKeys => [ KasmVNC::ConfigKey->new({ name => "keyboard.raw_keyboard", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'AcceptPointerEvents', configKeys => [ KasmVNC::ConfigKey->new({ name => "pointer.enabled", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'Log', configKeys => [ KasmVNC::ConfigKey->new({ name => "logging.log_writer_name", type => KasmVNC::ConfigKey::ANY }), KasmVNC::ConfigKey->new({ name => "logging.log_dest", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(logfile syslog)] }) }), KasmVNC::ConfigKey->new({ name => "logging.level", type => KasmVNC::ConfigKey::INT }) ], deriveValueSub => sub { my $self = shift; my $writerName = $self->{"logging.log_writer_name"}; if ($writerName eq "all") { $writerName = "*"; } my $log_dest = $self->{"logging.log_dest"}; if ($log_dest eq "logfile") { $log_dest = "stdout"; } my $level = $self->{"logging.level"}; "$writerName:$log_dest:$level"; } }), KasmVNC::CliOption->new({ name => 'BlacklistThreshold', configKeys => [ KasmVNC::ConfigKey->new({ name => "security.brute_force_protection.blacklist_threshold", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'BlacklistTimeout', configKeys => [ KasmVNC::ConfigKey->new({ name => "security.brute_force_protection.blacklist_timeout", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'DLP_Region', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.visible_region.top", validator => $regionValidator }), KasmVNC::ConfigKey->new({ name => "data_loss_prevention.visible_region.left", validator => $regionValidator }), KasmVNC::ConfigKey->new({ name => "data_loss_prevention.visible_region.right", validator => $regionValidator }), KasmVNC::ConfigKey->new({ name => "data_loss_prevention.visible_region.bottom", validator => $regionValidator }), ], deriveValueSub => sub { my $self = shift; join ",", ($self->{"data_loss_prevention.visible_region.left"}, $self->{"data_loss_prevention.visible_region.top"}, $self->{"data_loss_prevention.visible_region.right"}, $self->{"data_loss_prevention.visible_region.bottom"} ); } }), KasmVNC::CliOption->new({ name => 'DLP_RegionAllowClick', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.visible_region.concealed_region.allow_click_down", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'DLP_RegionAllowRelease', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.visible_region.concealed_region.allow_click_release", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'DLP_ClipDelay', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.clipboard.delay_between_operations", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(none|\d+)$/, errorMessage => "must be 'none' or a number in milliseconds" }), }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if ($value eq "none") { $value = 0; } $value; } }), KasmVNC::CliOption->new({ name => 'SendCutText', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.clipboard.server_to_client.enabled", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'DLP_ClipSendMax', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.clipboard.server_to_client.size", validator => $clipboardSizeValidator }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if ($value eq "unlimited") { $value = 0; } $value; } }), KasmVNC::CliOption->new({ name => 'SendPrimary', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.clipboard.server_to_client.primary_clipboard_enabled", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'AcceptCutText', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.clipboard.client_to_server.enabled", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'DLP_ClipAcceptMax', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.clipboard.client_to_server.size", validator => $clipboardSizeValidator }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if ($value eq "unlimited") { $value = 0; } $value; } }), KasmVNC::CliOption->new({ name => 'AcceptKeyEvents', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.keyboard.enabled", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'DLP_KeyRateLimit', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.keyboard.rate_limit", validator => $clipboardSizeValidator }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if ($value eq "unlimited") { $value = 0; } $value; } }), KasmVNC::CliOption->new({ name => 'DLP_Log', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.logging.level", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(off info verbose)] }) }) ] }), KasmVNC::CliOption->new({ name => 'FrameRate', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.max_frame_rate", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'DynamicQualityMin', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.rect_encoding_mode.min_quality", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'DynamicQualityMax', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.rect_encoding_mode.max_quality", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'TreatLossless', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.rect_encoding_mode.consider_lossless_quality", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'RectThreads', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.rect_encoding_mode.rectangle_compress_threads", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(auto|\d+)$/, errorMessage => "must be 'auto' or a number in milliseconds" }), }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if ($value eq "auto") { $value = 0; } $value; } }), KasmVNC::CliOption->new({ name => 'JpegVideoQuality', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.jpeg_quality", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'WebpVideoQuality', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.webp_quality", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'MaxVideoResolution', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.max_resolution.width", type => KasmVNC::ConfigKey::INT }), KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.max_resolution.height", type => KasmVNC::ConfigKey::INT }) ], deriveValueSub => sub { $self = shift; $self->{'encoding.video_encoding_mode.max_resolution.width'} . "x" . $self->{'encoding.video_encoding_mode.max_resolution.height'}; } }), KasmVNC::CliOption->new({ name => 'VideoTime', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.enter_video_encoding_mode.time_threshold", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'VideoArea', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.enter_video_encoding_mode.area_threshold", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(\d+%)$/, errorMessage => "must be a number, followed by %" }), }) ], deriveValueSub => sub { $self = shift; my $value = $self->configValue(); $value =~ s/%$//; $value; } }), KasmVNC::CliOption->new({ name => 'VideoOutTime', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.exit_video_encoding_mode.time_threshold", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'PrintVideoArea', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.logging.level", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(off info)] }) }) ], deriveValueSub => sub { $self = shift; my $value = $self->configValue(); switch($value) { case 'off' { return 0 } case 'info' { return 1 } } $value; } }), KasmVNC::CliOption->new({ name => 'VideoScaling', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.video_encoding_mode.scaling_algorithm", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(nearest bilinear progressive_bilinear)] }) }) ], deriveValueSub => sub { $self = shift; my $value = $self->configValue(); switch($value) { case 'nearest' { return 0 } case 'bilinear' { return 1 } case 'progressive_bilinear' { return 2 } } $value; } }), KasmVNC::CliOption->new({ name => 'CompareFB', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.compare_framebuffer", validator => KasmVNC::EnumValidator->new({ allowedValues => [qw(off always auto)] }) }) ], deriveValueSub => sub { $self = shift; my $value = $self->configValue(); switch($value) { case 'off' { return 0 } case 'always' { return 1 } case 'auto' { return 2 } } $value; } }), KasmVNC::CliOption->new({ name => 'ZlibLevel', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.zrle_zlib_level", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(auto|[0-9])$/, errorMessage => "must be 'auto' or a number in 0..9" }), }) ], isActiveSub => sub { $self = shift; my $value = $self->configValue(); isPresent($value) && $value ne "auto"; } }), KasmVNC::CliOption->new({ name => 'ImprovedHextile', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.hextile_improved_compression", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'httpd', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.http.httpd_directory", type => KasmVNC::ConfigKey::ANY }) ] }), KasmVNC::CliOption->new({ name => 'http-header', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.http.headers", type => KasmVNC::ConfigKey::ANY }) ], toStringSub => sub { $self = shift; my @values = @{ listify($self->configValues()) }; my $valuesStr = ""; foreach $value (@values) { $valuesStr = $valuesStr . "-http-header '$value' " } chop($valuesStr); return $valuesStr; } }), KasmVNC::CliOption->new({ name => 'IgnoreClientSettingsKasm', configKeys => [ KasmVNC::ConfigKey->new({ name => "runtime_configuration.allow_client_to_override_kasm_server_settings", type => KasmVNC::ConfigKey::BOOLEAN }) ], deriveValueSub => sub { $self = shift; my $value = $self->configValue(); switch($value) { case 'true' { $value = 0; } case 'false' { $value = 1; } } $value; } }), KasmVNC::CliOption->new({ name => 'fp', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.advanced.x_font_path", type => KasmVNC::ConfigKey::ANY }) ], deriveValueSub => sub { $self = shift; my $value = $self->configValue(); return $value if isPresent($value) && $value ne 'auto'; $fontPath; }, isActiveSub => sub { my $self = shift; my $value = $self->configValue(); return 1 if isPresent($value) && $value ne 'auto'; $fontPath; } }), KasmVNC::CliOption->new({ name => 'KasmPasswordFile', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.advanced.kasm_password_file", type => KasmVNC::ConfigKey::ANY }) ] }), KasmVNC::CliOption->new({ name => 'MaxDisconnectionTime', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.auto_shutdown.no_user_session_timeout", validator => $secondsValidator }) ], deriveValueSub => \&deriveSeconds }), KasmVNC::CliOption->new({ name => 'MaxConnectionTime', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.auto_shutdown.active_user_session_timeout", validator => $secondsValidator }) ], deriveValueSub => \&deriveSeconds }), KasmVNC::CliOption->new({ name => 'MaxIdleTime', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.auto_shutdown.inactive_user_session_timeout", validator => $secondsValidator }) ], deriveValueSub => \&deriveSeconds }), KasmVNC::CliOption->new({ name => 'auth', configKeys => [ KasmVNC::ConfigKey->new({ name => "server.advanced.x_authority_file", type => KasmVNC::ConfigKey::ANY }) ], deriveValueSub => sub { $self = shift; my $value = $self->configValue(); return $value if isPresent($value) && $value ne 'auto'; $xauthorityFile; }, isActiveSub => sub { 1; } }), KasmVNC::CliOption->new({ name => 'desktop', configKeys => [ KasmVNC::ConfigKey->new({ name => "legacy.desktop_name", type => KasmVNC::ConfigKey::ANY }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if (isBlank($value) || $value eq "default") { $desktopName = DefaultDesktopName(); return $desktopName; } $desktopName = $value; }, isActiveSub => sub { 1; } }), KasmVNC::CliOption->new({ name => 'AllowOverride', configKeys => [ KasmVNC::ConfigKey->new({ name => "runtime_configuration.allow_override_standard_vnc_server_settings", type => KasmVNC::ConfigKey::BOOLEAN }), KasmVNC::ConfigKey->new({ name => "runtime_configuration.allow_override_list", validator => $allConfigKeysValidatorSub }) ], deriveValueSub => sub { $self = shift; my @overrideList = @{ listify($self->{'runtime_configuration.allow_override_list'}) }; my @cliOptionList = map { cliOptionForConfigKey($_) } @overrideList; @cliOptionList = map { $_->{name} } @cliOptionList; join ",", @cliOptionList; }, isActiveSub => sub { $self = shift; my $allowOverride = $self->{'runtime_configuration.allow_override_standard_vnc_server_settings'}; return unless defined($allowOverride); $allowOverride eq "true"; } }), KasmVNC::CliOption->new({ name => 'DLP_ClipTypes', configKeys => [ KasmVNC::ConfigKey->new({ name => "data_loss_prevention.clipboard.allow_mimetypes", type => KasmVNC::ConfigKey::ANY }) ] }), KasmVNC::CliOption->new({ name => 'QueryConnectTimeout', configKeys => [ KasmVNC::ConfigKey->new({ name => "user_session.concurrent_connections_prompt_timeout", type => KasmVNC::ConfigKey::INT }) ] }), KasmVNC::CliOption->new({ name => 'PublicIP', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.udp.public_ip", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(auto|$ipv4_regexp|$ipv6_regexp)$/, errorMessage => "must be 'auto' or a valid IPv4 or IPv6 address" }), }) ], isActiveSub => sub { $self = shift; my $value = $self->configValue(); isPresent($value) && $value ne 'auto'; } }), KasmVNC::CliOption->new({ name => 'udpFullFrameFrequency', configKeys => [ KasmVNC::ConfigKey->new({ name => "encoding.full_frame_updates", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(none|\d+)$/, errorMessage => "must be 'none' or an integer" }), }) ], deriveValueSub => sub { my $self = shift; my $value = $self->configValue(); if ($value eq "none") { $value = 0; } $value; } }), KasmVNC::CliOption->new({ name => 'udpPort', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.udp.port", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(auto|\d+)$/, errorMessage => "must be 'auto' or an integer" }), }) ], isActiveSub => sub { $self = shift; my $value = $self->configValue(); isPresent($value) && $value ne 'auto'; } }), KasmVNC::CliOption->new({ name => 'StunServer', configKeys => [ KasmVNC::ConfigKey->new({ name => "network.udp.stun_server", validator => KasmVNC::PatternValidator->new({ pattern => qr/^(auto|\S+)$/, errorMessage => "must be 'auto' or an IP address/hostname" }), }) ], isActiveSub => sub { $self = shift; my $value = $self->configValue(); isPresent($value) && $value ne 'auto'; } }), KasmVNC::CliOption->new({ name => 'hw3d', configKeys => [ KasmVNC::ConfigKey->new({ name => "desktop.gpu.hw3d", type => KasmVNC::ConfigKey::BOOLEAN }) ] }), KasmVNC::CliOption->new({ name => 'drinode', configKeys => [ KasmVNC::ConfigKey->new({ name => "desktop.gpu.drinode", type => KasmVNC::ConfigKey::ANY }) ] }), ); %cliArgMap = map { ("-" . $_->{name}) => $_ } @xvncOptions; %configKeyToXvncOptionMap = map { my $option = $_; map { $_->{name} => $option } @{ $option->{configKeys} }; } @xvncOptions; # my $xvncDoc = "./Xvnc.md"; # open(FH, '<', $xvncDoc) or die $!; # while(){ # if (m/\* \*\*-(\w+)/) { # my $optionName = $1; # if ($optionName) { # $optionName = "-$optionName"; # my $cliOption = $cliArgMap{$optionName}; # if ($cliOption) { # my @keys = @{ $cliOption->configKeyNames() }; # say '### ' . join(", ", @keys); # } # } # } # print $_; # } # close(FH); # exit 0; } sub PromptingAllowed { $appSettings{prompt} } sub PromptingDisabled { !PromptingAllowed(); } sub cliOptionForConfigKey { my $configKey = shift; my $cliOptionForConfigKey = first { $_->hasKey($configKey) } @xvncOptions; } sub deriveSeconds { my $self = shift; my $value = $self->configValue(); return 0 if $value eq 'never'; $value; } sub deriveFromConfigAndLocalCli { my $self = shift; my $cliOptionName = "-" . $self->{name}; my $cliOptionValue = $opt{$cliOptionName}; my $configValue = deriveBoolean($self->configValue()); return $configValue unless defined($cliOptionValue); $cliOptionValue; } sub ParseAndProcessCliOptions { my @supportedOptions = ("-geometry",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, '-config', REQUIRED_ARG_VALUE, '-test-output-topic', REQUIRED_ARG_VALUE, '-prompt', REQUIRED_ARG_VALUE); @vncserverOptions = ( KasmVNC::CliOption->new({ name => 'prompt', configKeys => [ KasmVNC::ConfigKey->new({ name => "command_line.prompt", type => KasmVNC::ConfigKey::BOOLEAN }) ], deriveValueSub => \&deriveFromConfigAndLocalCli }) ); ParseOptionsAndRemoveMatchesFromARGV(@supportedOptions); ProcessCliOptions(); CheckGeometryAndDepthAreSensible(); $displayNumber = DetectDisplayNumberFromCliArgs(); if (!defined($displayNumber)) { $displayNumber = GetLowestAvailableDisplayNumber(); } CheckCliOptionsForBeingValid(); } sub CheckBrowserHostDefined { return if IsDryRun(); scalar DeduceBrowserHosts() > 0 || \ die "-interface has no default value and wasn't passed by user"; } sub DefaultDesktopName { "$host:$displayNumber ($systemUser)"; } sub GenerateWebsocketPortFromDisplayNumber { $defaultWebsocketPort + $displayNumber; } sub LoadUsers { $users = KasmVNC::Users->loadFrom($kasmPasswdFile); } sub EnsureAtLeastOneKasmUserExists { return if IsDryRun(); LoadUsers(); unless (PromptingAllowed()) { return unless $users->is_empty(); $logger->warn(<reload(); } sub GuideUserToAddWritePermissionsToExistingUser { my @options = (); my @users = sort $users->users(); foreach my $user (@users) { my $name = $user->name(); push(@options, KasmVNC::TextOption->new({ description => "Provide user '$name' with write access", callback => sub { $users->addPermissions($name, "w"); say "Added write permissions for user '$name'"; } })); } push(@options, KasmVNC::TextOption->new({ description => "Create a new user with write access", callback => sub { GuideUserToSetupKasmPasswdUser(); $users->reload(); } })); push(@options, KasmVNC::TextOption->new({ description => "Start KasmVNC without a user with write access" })); my $banner = <<"NEEDTOADDWRITEPERMISSIONS"; In order to control your desktop, you need a KasmVNC user with write permissions. Select what action to take: NEEDTOADDWRITEPERMISSIONS my $option = askUserToChooseOption( banner => $banner, prompt => 'Provide selection number', options => \@options, ); &{ $option->callback() }(); } sub AtLeastOneUserWithWriteAccessConfigured { $users->findByPermissions("w") > 0; } sub ShouldPrintTopic { my $topic = shift; return 1 unless ($testOutputTopic); return 1 if ($testOutputTopic eq "all"); $topic eq $testOutputTopic; } sub SupportedAbsoluteKeys { my @supportedAbsoluteKeys = map { $_->configKeyNames() } @allCliOptions; @supportedAbsoluteKeys = flatten(@supportedAbsoluteKeys); my %result = map { $_ => 1 } @supportedAbsoluteKeys; \%result; } sub SupportedSectionsFromAbsoluteKey { my $absoluteKey = shift; my @sections = (); return @sections unless ($absoluteKey =~ /\./); while ($absoluteKey =~ /\./) { $absoluteKey =~ s/\.[^\.]+$//; push @sections, $absoluteKey; } push @sections, $absoluteKey; @sections; } sub StartXvncOrExit { $cmd = ConstructXvncCmd(); CheckForUnsupportedConfigKeys(); CheckSslCertReadable(); say $cmd if ($debug || IsDryRun()) && ShouldPrintTopic("xvnc-cmd"); exit(0) if IsDryRun(); CheckBrowserHostDefined(); 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 { $logger->warn("\nNew '$desktopName' desktop is $host:$displayNumber"); PrintKasmUsers(); $logger->warn("Log file is $desktopLog\n"); } sub PrintBrowserUrl { my $browserUrls = ConstructBrowserUrl(); $logger->warn("\nPaste this url in your browser:\n$browserUrls"); } sub IsAllInterfaces { my $interface = shift; $interface eq "0.0.0.0"; } sub DeduceBrowserHosts { my @browserHosts; my $interface = $opt{"-interface"} || $optFromConfig{"-interface"}; if (IsAllInterfaces($interface)) { @browserHosts = @hostIPs; } else { @browserHosts = ($interface); } @browserHosts; } sub ConstructBrowserUrl { my @browserHosts = DeduceBrowserHosts(); my $browserPort = $opt{"-websocketPort"} || $optFromConfig{"-websocketPort"}; my @urls = map { "https://$_:$browserPort" } @browserHosts; join "\n", @urls; } 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 LoadConfig { my $filename = shift; return if IsConfigOptionalAndNotReadable($filename); my $config = KasmVNC::Config->new({ filename => $filename }); $config; } sub FailIfConfigNotReadable { my $config = shift; -r $config || die "Couldn't load config: $config"; } sub IsConfigOptionalAndNotReadable { my $config = shift; $config eq $vncUserConfig && ! -r $config; } sub TrimEmptyNodes { my $config = shift; my @supportedSections = @{ listify(SupportedSections()) }; my @sectionsToCheck = reverse sort @supportedSections; foreach my $section (@sectionsToCheck) { if ($config->isEmpty($section)) { $config->delete($section); } } } sub ConfigValue { my ($absoluteKey, $configRef) = @_; $configRef ||= $mergedConfig; return $configRef->get($absoluteKey); } sub DerivedValue { my $absoluteKey = shift; $configKeyToXvncOptionMap{$absoluteKey}->toValue(); } sub LoadConfigs { @allCliOptions = (@xvncOptions, @vncserverOptions); my @configs = map { LoadConfig $_ } @configFiles; foreach my $config (@configs) { TrimEmptyNodes($config); } $mergedConfig = KasmVNC::Config::merge(@configs); } sub SupportedSections { my %supportedAbsoluteKeys = %{ SupportedAbsoluteKeys() }; my @supportedSections = map { SupportedSectionsFromAbsoluteKey($_) } (keys %supportedAbsoluteKeys); @supportedSections = uniq(flatten(@supportedSections)); @supportedSections; } sub EmptySectionsDefinedInConfig { my @supportedSections = @{ listify(SupportedSections()) }; my %configAbsoluteKeys = %{ ConfigAbsoluteKeys() }; my @emptySections = grep($configAbsoluteKeys{$_} && isBlank(ConfigValue($_)), @supportedSections); uniq @emptySections; } sub ConfigAbsoluteKeys { my %configAbsoluteKeys = map { $_ => 1 } (ConfigToAbsoluteKeyList("", $mergedConfig->{data})); \%configAbsoluteKeys; } sub CheckForUnsupportedConfigKeys { my %supportedAbsoluteKeys = %{ SupportedAbsoluteKeys() }; my @configAbsoluteKeys = ConfigToAbsoluteKeyList("", $mergedConfig->{data}); my @unsupportedAbsoluteKeys = grep(!defined($supportedAbsoluteKeys{$_}), @configAbsoluteKeys); return if (scalar @unsupportedAbsoluteKeys == 0); if (ShouldPrintTopic("validation")) { $logger->warn("Unsupported config keys found:"); $logger->warn(join("\n", @unsupportedAbsoluteKeys)); $logger->warn(); } exit 1; } sub ConstructOptFromConfig{ my %result; foreach my $cliOption (values %cliArgMap) { my $cliArg = "-$cliOption->{name}"; next if WasOptionSpecifiedViaCli($cliArg); my $optionValue = $cliOption->toValue(); next unless defined($cliOption->toString()); $result{$cliArg} = $optionValue; } \%result; } sub ConfigToCmd { ValidateConfig(); %optFromConfig = %{ ConstructOptFromConfig() }; my @cmd = map { $cliArgMap{$_}->toString() } (keys %optFromConfig); my $cmdStr = " " . join " ", @cmd; return $cmdStr; } sub ValidateConfig { foreach my $cliOption (@allCliOptions) { ValidateCliOption($cliOption); } } sub ValidateCliOption { my $cliOption = $_[0]; return if ($cliOption->isValid()); if (ShouldPrintTopic("validation")) { $logger->warn("config errors:"); $logger->warn($cliOption->errorMessages()); $logger->warn(); } exit 1; } sub ConfigToAbsoluteKeyList { my $keyPrefix = $_[0]; my %configPart = %{ $_[1] }; my @absoluteKeys; foreach my $key (keys %configPart) { my $absoluteKey; if ($keyPrefix) { $absoluteKey = "$keyPrefix.$key"; } else { $absoluteKey = $key; } if (!defined($configPart{$key})) { push @absoluteKeys, $absoluteKey; next; } if (ref $configPart{$key} ne "HASH") { push @absoluteKeys, $absoluteKey; next; } push @absoluteKeys, ConfigToAbsoluteKeyList($absoluteKey, \% { $configPart{$key} }); } @absoluteKeys; } sub ActivateConfigToCLIConversion { foreach my $option (@xvncOptions){ $option->activate(); } } sub SetAppSettingsFromConfigAndCli { foreach my $option (@vncserverOptions) { my $value = $option->deriveValue(); $appSettings{$option->{name}} = $value; } } sub InitLogger { $logger = KasmVNC::Logger->new(); }