KasmVNC/unix/vncserver
2021-09-17 03:39:40 +12:00

1167 lines
29 KiB
Perl
Executable File

#!/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 constant {
NO_ARG_VALUE => 0,
REQUIRED_ARG_VALUE => 1,
OPTIONAL_ARG_VALUE => 2
};
&CheckWeCanRunInThisEnvironment();
&DefineFilePathsAndStuff();
&ParseAndProcessCliOptions();
&PrepareLoggingAndXvncKillingFramework();
&DisableLegacyVncAuth();
&AllowXProgramsToConnectToXvnc();
&EnsureAtLeastOneKasmUserExists();
&AskUserToChooseDeOrManualXstartup();
&PrepareDefaultsForPassingToXvnc();
&StartXvncOrExit();
&PrintLogFilenameAndConfiguredUsersAndStuff();
&CreateUserConfigIfNeeded();
if (! $skipxstartup) {
&CreateXstartupIfNeeded();
&RunXstartup();
}
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 and a
# boolean indicating whether the option has a value following, 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;
}
&CheckUserHasSslCertGroupOnDebian();
}
sub CheckUserHasSslCertGroupOnDebian {
if (! -f "/etc/debian_version") {
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;
}
}
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} = "";
}
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 .= " >> " . &quotedString($desktopLog) . " 2>&1";
return $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 = "/src/builder/startup/deb/select-de.sh";
$de_was_selected_file="$ENV{HOME}/.vnc/.de-was-selected";
$vncSystemConfigDir = "/etc/kasmvnc";
$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`);
&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);
&ParseOptionsAndRemoveMatchesFromARGV(@supportedOptions);
&ProcessCliOptions();
&CheckGeometryAndDepthAreSensible();
$displayNumber = &DetectDisplayNumberFromCliArgs() ||
&GetLowestAvailableDisplayNumber();
&CheckCliOptionsForBeingValid();
}
sub PrepareDefaultsForPassingToXvnc {
# We set some reasonable defaults. Config file settings
# override these where present.
%default_opts;
%config;
$websocketPort = $defaultWebsocketPort + $displayNumber;
$desktopName = $opt{'-name'} || "$host:$displayNumber ($ENV{USER})";
&SetReasonabeDefaults();
&LoadSystemThenUserThenMandatoryConfigs();
}
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";
}