#!/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 Hash::Merge::Simple; use constant { NO_ARG_VALUE => 0, REQUIRED_ARG_VALUE => 1, OPTIONAL_ARG_VALUE => 2 }; CheckWeCanRunInThisEnvironment(); DefineFilePathsAndStuff(); LoadYAMLConfig(); exit; 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 () { 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 [:] [-name ] [-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(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 : 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 < $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 { 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 = ; $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(){ 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 .= " >> " . 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 () { 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(); } 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); 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 { @kasmPasswdUsers = LoadKasmPasswdUsers(); if (!AtLeastOneUserConfigured()) { GuideUserToSetupKasmPasswdUser(); @kasmPasswdUsers = LoadKasmPasswdUsers(); } } sub StartXvncOrExit { $cmd = ConstructXvncCmd(); 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 LoadYAMLConfig { my $defaultsConfig = YAML::Tiny->read($vncDefaultsConfig)->[0]; my $systemConfig = YAML::Tiny->read($vncSystemConfig)->[0]; my %mergedConfig = %{ Hash::Merge::Simple::merge($defaultsConfig, $systemConfig) }; say $mergedConfig{framerate}; say $mergedConfig{dlp}{region}{x1}; }