#!/usr/bin/env perl
#
# Copyright (C) 2009-2018, 2020-2022, 2024 D. R. Commander.
#                                          All Rights Reserved.
# Copyright (C) 2021 Steffen Kieß
# Copyright (C) 2010 University Corporation for Atmospheric Research.
#                    All Rights Reserved.
# Copyright (C) 2002-2009 Constantin Kaplinsky.  All Rights Reserved.
# Copyright (C) 2005-2006 Sun Microsystems, Inc.  All Rights Reserved.
# Copyright (C) 2002-2005 RealVNC Ltd.  All Rights Reserved.
# 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 software; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
# USA.

#
# vncserver - wrapper script to start the TurboVNC X server.
#

# First make sure we're operating in a sane environment.

$exedir = "";
$slashndx = rindex($0, "/");
if ($slashndx >= 0) {
  $exedir = substr($0, 0, $slashndx + 1);
}

$xauth = "xauth";
$buildWebServer = @TVNC_BUILDWEBSERVER@;
$staticXorgPaths = @TVNC_STATIC_XORG_PATHS@;

&SanityCheck();

# Default configuration of the TurboVNC Server:

$geometry = "1240x900";
$depth = 24;
$vncUserDir = "$ENV{HOME}/.vnc";
$authTypeVNC = 1;
$authTypeOTP = 1;
$generateOTP = 0;
$securityTypes = "";
$encTypeX509 = @USETLS@;
$noxstartup = 0;
$autoLosslessRefresh = 0.0;
$deferUpdate = 1;
$wm = "";
$useVGL = 0;
$autokill = 1;
$pamSession = 0;
$bits = @BITS@;
$multiThread = 1;
$numThreads = 0;
$noVNC = "";
$serverArgs = "";
$useUDS = 0;
$udsPath = "";

# Read configuration from the system-wide and user files if present.

$configFile = "@CMAKE_INSTALL_FULL_SYSCONFDIR@/turbovncserver.conf";
ReadConfiguration();
$configFile = "$ENV{HOME}/.vnc/turbovncserver.conf";
ReadConfiguration();
ReadAuthConfiguration("@CMAKE_INSTALL_FULL_SYSCONFDIR@/turbovncserver-security.conf");

# We set these defaults after reading the configuration file, in case
# $vncUserDir was modified.

$passwdFile = "$vncUserDir/passwd" if (!$passwdFile);
$x509CertFile = "$vncUserDir/x509_cert.pem" if (!$x509CertFile);
$x509KeyFile = "$vncUserDir/x509_private.pem" if (!$x509KeyFile);

# Done reading configuration.

$xauthorityFile = "$ENV{XAUTHORITY}";

if (!$xstartup) {
  $xstartup = $exedir."xstartup.turbovnc";
}
$vncUserDirUnderTmp = ($vncUserDir =~ m|^/tmp/.+|) ? 1 : 0;
unless ($xauthorityFile) {
  if ($vncUserDirUnderTmp) {
    $xauthorityFile = "$vncUserDir/.Xauthority";
  } else {
    $xauthorityFile = "$ENV{HOME}/.Xauthority";
  }
}

chop($host = `uname -n`);
chop($os = `uname`);

if (!$staticXorgPaths) {

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

@fontpaths = ('/usr/share/X11/fonts', '/usr/share/fonts',
              '/usr/share/fonts/X11', '/usr/local/lib/X11/fonts',
              '/usr/local/share/fonts');
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/openwin") { push(@fontpaths, '/usr/openwin/lib/X11/fonts'); }
if (! -l "/usr/X11R6") { push(@fontpaths, '/usr/X11R6/lib/X11/fonts'); }
if (! -l "/opt/X11/share/fonts") { push(@fontpaths, '/opt/X11/share/fonts'); }
push(@fontpaths, '/usr/share/fonts/default');

@fonttypes = ('F3bitmaps',
              'misc',
              '75dpi',
              '100dpi',
              'Speedo',
              'Type1',
              'ghostscript',
              'liberation',
              'TTF',
              'OTF');

if (($fontPath eq "")) {
  foreach $_fpath (@fontpaths) {
    if (-f "$_fpath/encodings/encodings.dir") {
      $ENV{FONT_ENCODINGS_DIRECTORY} = "$_fpath/encodings";
    }
    foreach $_ftype (@fonttypes) {
      if (-f "$_fpath/$_ftype/fonts.dir") {
        if (! -l "$_fpath/$_ftype") {
          $fontPath .= "$_fpath/$_ftype,";
        }
      }
    }
  }
}
if ($fontPath) {
  if (substr($fontPath, -1, 1) eq ',') {
    chop $fontPath;
  }
}

if ($os eq "Darwin") {
  $fontPath = "$fontPath,/Library/Fonts,/System/Library/Fonts";
}

@xkbdirs = ('/usr/X11R6/lib/X11/xkb', '/usr/local/share/X11/xkb',
            '/opt/X11/share/X11/xkb');
foreach $_xkbdir (@xkbdirs) {
  if (-d "$_xkbdir") {
    $xkbdir = "$_xkbdir";
  }
}

@xkbcompdirs = ('/usr/X11R6/bin', '/usr/X11/lib/X11/xkb', '/usr/local/bin',
                '/opt/X11/bin');
foreach $_xkbcompdir (@xkbcompdirs) {
  if (-x "$_xkbcompdir/xkbcomp") {
    $xkbcompdir = "$_xkbcompdir";
  }
}

if ($bits eq "64") {
  @dridirs = ('/usr/lib64/dri', '/usr/lib/dri',
              '/usr/lib/x86_64-linux-gnu/dri',
              '/usr/lib/xorg/modules/dri/amd64',
              '/usr/lib/powerpc64-linux-gnu/dri',
              '/usr/lib/powerpc64le-linux-gnu/dri',
              '/usr/lib/aarch64-linux-gnu/dri');
} else {
  @dridirs = ('/usr/lib/dri', '/usr/lib32/dri', '/usr/lib/i386-linux-gnu/dri',
              '/usr/lib/xorg/modules/dri', '/usr/lib/arm-linux-gnueabihf/dri',
              '/usr/lib/arm-linux-gnueabi/dri');
}
push(@dridirs, '/usr/local/lib/dri');
foreach $_dridir (@dridirs) {
  if (-f "$_dridir/swrast_dri.so") {
    $dridir = "$_dridir";
    last;
  }
}

@registrydirs = ('/usr/lib/xorg');
if ($bits eq "64") {
  push(@registrydirs, '/usr/lib64/xorg');
}
push(@registrydirs, '/usr/local/lib/xorg');
push(@registrydirs, '/opt/X11/lib/xorg');
foreach $_registrydir (@registrydirs) {
  if (-f "$_registrydir/protocol.txt") {
    $registrydir = "$_registrydir";
    last;
  }
}

} # !$staticXorgPaths

# Check command line options

&ParseOptions("-geometry", 1, "-depth", 1, "-pixelformat", 1, "-name", 1,
              "-kill", 1, "-help", 0, "-h", 0, "--help", 0, "-fg", 0,
              "-list", 0, "-fp", 1, "-otp", 0, "-securitytypes", 1,
              "-rfbauth", 1, "-noxstartup", 0, "-xstartup", 1, "-log", 1,
              "-3dwm", 0, "-vgl", 0, "-debug", 0, "-x509cert", 1,
              "-x509key", 1, "-autokill", 0, "-quiet", 0, "-wm", 1,
              "-sessionlist", 0, "-sessionstart", 0, "-novnc", 1,
              "-noautokill", 0, "-rfbport", 1, "-rfbunixpath", 1, "-uds", 0);

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

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

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

if ($opt{'-sessionlist'}) {
  &List(0);
  exit;
}

if (defined($ENV{WAYLAND_DISPLAY})) {
  warn "\nWARNING: Some window managers will not work in a TurboVNC session if the\n";
  warn "TurboVNC session is started from a Wayland session.\n";
}

if ($opt{'-sessionstart'}) {
  $opt{'-quiet'} = 1;
}

# 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{'-novnc'}) {
  if (!$buildWebServer) {
    warn "TurboVNC was not built with the noVNC web server.  Ignoring -novnc.\n";
  } else {
    $noVNC = $opt{'-novnc'};
    if (! -e "$noVNC/vnc.html") {
      die $noVNC . " does not appear to contain an installation of noVNC.\n"
    }
  }
}
if ($opt{'-noxstartup'}) {
  $noxstartup = 1;
}
if ($opt{'-xstartup'}) {
  $xstartup = $opt{'-xstartup'};
}
if ($opt{'-wm'}) {
  $wm = $opt{'-wm'};
}
if ($opt{'-3dwm'} || $opt{'-vgl'}) {
  $useVGL = 1;
}
if ($opt{'-fp'}) {
  $fontPath = $opt{'-fp'};
}
if ($opt{'-deferupdate'}) {
  $deferUpdate = $opt{'-deferupdate'};
}
if ($opt{'-debug'}) {
  $opt{'-fg'} = 1;
}
if ($opt{'-noautokill'}) {
  $autokill = 0;
}
$authTypeVNCPermitted = $authTypeVNC;
if ($opt{'-securitytypes'}) {
  $securityTypes = $opt{'-securitytypes'};
}
if ($securityTypes) {
  my $enableVNC = 0;
  my $enableOTP = 0;
  my $secTypes = $securityTypes;
  $secTypes =~ s/[\t\ \r\n]//g;
  foreach $tok (split/[,=]/, $secTypes) {
    if (substr(lc $tok, -3) eq 'otp') {
      $enableOTP = 1;
    }
    if (substr(lc $tok, -3) eq 'vnc') {
      $enableVNC = 1;
    }
  }
  if ($enableVNC == 0) {
    $authTypeVNC = 0;
  }
  if ($enableOTP == 0) {
    $authTypeOTP = 0;
  }
}
if ($opt{'-rfbauth'}) {
  if ($authTypeVNC) {
    $passwdFile = $opt{'-rfbauth'};
  } else {
    if ($authTypeVNCPermitted) {
      warn "VNC Password auth is not enabled.  Ignoring -rfbauth.\n";
    } else {
      warn "VNC Password auth is not permitted on this system.  Ignoring -rfbauth.\n";
    }
  }
}
if ($opt{'-x509cert'}) {
  if ($encTypeX509) {
    $x509CertFile = $opt{'-x509cert'};
  } else {
    warn "Server was not built with TLS encryption.  Ignoring -x509cert.\n";
  }
}
if ($opt{'-x509key'}) {
  if ($encTypeX509) {
    $x509KeyFile = $opt{'-x509key'};
  } else {
    warn "Server was not built with TLS encryption.  Ignoring -x509key.\n";
  }
}

if ($opt{'-otp'}) {
  $generateOTP = 1;
}

if ($generateOTP && $authTypeOTP == 0) {
  warn "One-Time Password authentication is not enabled.  Ignoring request to generate\n";
  warn "    initial OTP.\n";
  $generateOTP = 0;
}

&CheckGeometryAndDepth();

# Create the user's vnc directory if necessary.

unless (-e $vncUserDir) {
  unless (mkdir($vncUserDir, 0700)) {
    die "$prog: Could not create $vncUserDir.\n";
  }
}
($z, $z, $mode) = lstat("$vncUserDir");
if (! -d _ || ! -o _ || ($vncUserDirUnderTmp && ($mode & 0777) != 0700)) {
  die "$prog: Wrong type or access mode of $vncUserDir.\n";
}

# Make sure the user has a password.
if ($authTypeVNC && "$passwdFile" eq "$vncUserDir/passwd") {
  ($z, $z, $mode) = lstat("$vncUserDir/passwd");
  if (-e _ && (! -f _ || ! -o _ || ($mode & 077) != 0)) {
    die "$prog: Wrong type, ownership, or permissions on\n           $vncUserDir/passwd.\n";
  }

  if (! -e _) {
    if ($opt{'-quiet'}) {
      warn "$vncUserDir/passwd does not exist.\nRun ".$exedir."vncpasswd to create passwd file.\n";
      exit 1;
    } else {
      warn "\nYou will require a password to access your desktops.\n\n";
      system($exedir."vncpasswd $vncUserDir/passwd");
      if (($? & 0xFF00) != 0) {
        exit 1;
      }
    }
  }
}

# Find display number.

if ((@ARGV > 0) && ($ARGV[0] =~ /^:(\d+)$/)) {
  $displayNumber = $1;
  shift(@ARGV);
  unless (&CheckDisplayNumber($displayNumber)) {
    die "A VNC server is already running as :$displayNumber\n";
  }
} elsif ((@ARGV > 0) && ($ARGV[0] !~ /^-/) && ($ARGV[0] !~ /^\+/)) {
  &Usage();
} else {
  $displayNumber = &GetDisplayNumber();
}

$vncPort = 5900 + $displayNumber;

if ($opt{'-rfbport'}) {
  $vncPort = $opt{'-rfbport'};
}

if ($opt{'-uds'}) {
  $useUDS = 1;
}

if ($opt{'-rfbunixpath'}) {
  $udsPath = $opt{'-rfbunixpath'};
} elsif ($useUDS) {
  $udsPath = "$vncUserDir/$host\_$displayNumber.uds";
}

if ($opt{'-log'}) {
  $desktopLog = $opt{'-log'};
} else {
  $desktopLog = "$vncUserDir/$host:$displayNumber.log";
}
unlink($desktopLog);

if ($opt{'-name'}) {
  $desktopName = $opt{'-name'};
} else {
  $desktopName = "TurboVNC: $host:$displayNumber ($ENV{USER})" unless($desktopName);
}

# Make an X server cookie - 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.

my $cookie = "";
if (open(URANDOM, '<', '/dev/urandom')) {
  my $randata;
  if (sysread(URANDOM, $randata, 16) == 16) {
    $cookie = unpack 'h*', $randata;
  }
  close(URANDOM);
}
if ($cookie eq "") {
  if (-e "$vncUserDir/passwd") {
    srand(time + $$ + unpack("L", `cat $vncUserDir/passwd`));
  } else {
    srand(time + $$);
  }
  for (1..16) {
    $cookie .= sprintf("%02x", int(rand(256)) % 256);
  }
}

system("$xauth -f $xauthorityFile add $host:$displayNumber . $cookie");
system("$xauth -f $xauthorityFile add $host/unix:$displayNumber . $cookie");
if ($vncUserDirUnderTmp) {
  system("$xauth merge $xauthorityFile");
}

# Now start the TurboVNC X server

$cmd = $exedir."Xvnc :$displayNumber";
$cmd .= " -dpi $dpi" if ($dpi);
$cmd .= " -desktop " . &quotedString($desktopName);
$cmd .= " -auth $xauthorityFile";
$cmd .= " -geometry $geometry" if ($geometry);
$cmd .= " -depth $depth" if ($depth);
$cmd .= " -pixelformat $pixelformat" if ($pixelformat);
$cmd .= " -rfbauth $passwdFile" if ($authTypeVNC);
$cmd .= " -x509cert $x509CertFile" if ($encTypeX509);
$cmd .= " -x509key $x509KeyFile" if ($encTypeX509);
$cmd .= " -securitytypes \"$securityTypes\"" if ($securityTypes);
$cmd .= " -rfbport $vncPort";
$cmd .= " -rfbunixpath " . &quotedString($udsPath) if ($udsPath);
$cmd .= " -fp $fontPath" if ($fontPath);
$cmd .= " -alr ".$autoLosslessRefresh if ($autoLosslessRefresh > 0.0);
$cmd .= " -deferupdate $deferUpdate";
$cmd .= " -xkbdir $xkbdir" if ($xkbdir && !$staticXorgPaths);
$cmd .= " -xkbcompdir $xkbcompdir" if ($xkbcompdir && !$staticXorgPaths);
$cmd .= " -pamsession" if ($pamSession);
$cmd .= " -dridir $dridir" if ($dridir && !$staticXorgPaths);
$cmd .= " -registrydir $registrydir" if ($registrydir && !$staticXorgPaths);
$cmd .= " -nomt" if (!$multiThread);
$cmd .= " -nthreads $numThreads" if ($numThreads);
$cmd .= " $serverArgs" if ($serverArgs);

foreach $arg (@ARGV) {
  $cmd .= " " . &quotedString($arg);
}
if (!$opt{'-debug'}) {
  $cmd .= " >> " . &quotedString($desktopLog) . " 2>&1";
}

# Run $cmd and record the process ID.

$pidFile = "$vncUserDir/$host:$displayNumber.pid";
system("$cmd & echo \$! >$pidFile");

# Record the RFB Unix domain socket path

$udsPathFile = "$vncUserDir/$host:$displayNumber.udspath";
if ($udsPath) {
  open(UDSPATHFILE, '>', $udsPathFile);
  print UDSPATHFILE "$udsPath\n"
} else {
  unlink $udsPathFile;
}

# Give Xvnc a chance to start up

sleep(1);
unless (kill 0, `cat $pidFile`) {
  # If Xvnc exits on startup, it might be because the RFB Unix domain socket
  # belongs to another process.  Remove the .udspath file to prevent -kill from
  # attempting to remove the Unix domain socket later.
  if ($udsPath) {
    unlink $udsPathFile;
  }

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

if (!$opt{'-sessionstart'}) {
  warn "\nDesktop '$desktopName' started on display $host:$displayNumber\n";
  if ($udsPath) {
    warn "Listening on Unix domain socket $udsPath\n";
  }
  warn "\n";
}

if ($generateOTP == 1) {
  warn "One-Time Password authentication enabled.  Generating initial OTP ...\n";

  system($exedir."vncpasswd -o -display :$displayNumber");
  if (($? & 0xFF00) != 0) {
    warn "Could not generate initial OTP.\n";
    exit 1;
  }

  warn "Run '".$exedir."vncpasswd -o' from within the TurboVNC session or\n    '".$exedir."vncpasswd -o -display :$displayNumber' from within this shell\n    to generate additional OTPs\n";
}

# Start noVNC web server and record the process ID.

if ($noVNC) {
  $noVNCEncrypt = $encTypeX509;
  $cmd = $exedir."webserver";
  $cmd .= " -dir " . $noVNC;
  $cmd .= " -httpport " . (5800 + $displayNumber);
  if ($noVNCEncrypt) {
    if (! -e $x509CertFile) {
      warn $x509CertFile . " does not exist.  Disabling noVNC encryption.\n";
      $noVNCEncrypt = 0;
    } else {
      $cmd .= " -x509cert " . $x509CertFile;
    }
    if (! -e $x509KeyFile) {
      warn $x509KeyFile . " does not exist.  Disabling noVNC encryption.\n";
      $noVNCEncrypt = 0;
    } else {
      $cmd .= " -x509key " . $x509KeyFile;
    }
  }
  if (!$opt{'-debug'}) {
    $cmd .= " >> " . &quotedString($desktopLog) . " 2>&1";
  }

  $noVNCPIDFile = "$vncUserDir/$host:$displayNumber-noVNC.pid";
  system("$cmd & echo \$! >$noVNCPIDFile");
  sleep(1);
  unless (kill 0, `cat $noVNCPIDFile`) {
    warn "Could not start noVNC web server.\n\n";
    open(LOG, "<$desktopLog");
    while (<LOG>) { print; }
    close(LOG);
    unlink $noVNCPIDFile;
    $opt{'-kill'} = ':'.$displayNumber;
    &Kill();
  }

  $msg = "noVNC URL:  ";
  $msg .= "https://" if ($noVNCEncrypt);
  $msg .= "http://" if (!$noVNCEncrypt);
  $msg .= $host . ":" . (5800 + $displayNumber) . "/vnc.html";
  $msg .= "?host=" . $host . "&port=" . $vncPort;
  $msg .= "&encrypt=1" if ($noVNCEncrypt);
  $msg .= "\n";
  warn $msg;
}

if ($opt{'-sessionstart'}) {
  &List(0, $displayNumber);
}

if (!$noxstartup) {
  # Run the X startup script.

  warn "Starting applications specified in $xstartup\n";
  if ($wm) {
    $ENV{TVNC_WM} = $wm;
  }
  if ($useVGL) {
    warn "(Enabling VirtualGL)\n";
    $ENV{TVNC_VGL} = "1";
  }
}
warn "Log file is $desktopLog\n\n";

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

if (-e "/tmp/.X11-unix/X$displayNumber") {
  $ENV{DISPLAY} = ":$displayNumber";
} else {
  $ENV{DISPLAY} = "$host:$displayNumber";
}
$ENV{VNCDESKTOP} = $desktopName;
$ENV{VGL_COMPRESS} = "0";
$ENV{VGL_PROBEGLX} = "0";

if (!$noxstartup) {
  if ($opt{'-fg'}) {
    $cmd = "$xstartup";
    if (!$opt{'-debug'}) {
      $cmd .= " >> " . &quotedString($desktopLog) . " 2>&1";
    }
    system($cmd);
    if (kill 0, `cat $pidFile` || kill 0, `cat $noVNCPIDFile`) {
      $opt{'-kill'} = ':'.$displayNumber;
      &Kill();
    }
  } else {
    if ($autokill) {
      system("($xstartup; $0 -kill :$displayNumber) >> " .
             &quotedString($desktopLog) . " 2>&1 &");
    } else {
      system("$xstartup >> " . &quotedString($desktopLog) . " 2>&1 &");
    }
  }
}

exit;


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

sub CheckGeometryAndDepth
{
  foreach $tok (split/[,]/, $geometry) {
    $width = -1;  $height = -1;  $x = 0;  $y = 0;

    if ($tok =~ /^(\d+)x(\d+)$/) {
      $width = $1;  $height = $2;
    } elsif ($tok =~ /^(\d+)x(\d+)\+(\d+)$/) {
      $width = $1;  $height = $2;  $x = $3;
    } elsif ($tok =~ /^(\d+)x(\d+)\+(\d+)\+(\d+)$/) {
      $width = $1;  $height = $2;  $x = $3;  $y = $4;
    }

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

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


#
# GetDisplayNumber gets the lowest available display number.
#

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

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


#
# CheckDisplayNumber checks if the given display number is available.  A
# display number $n is taken if any of the following are true:
#
# - something is listening on the X server port (6000+$n)
# - something is listening on the VNC server port (5900+$n)
# - -novnc/$noVNC is specified and something is listening on the web server
#   port (5800+$n)
# - (Linux only) the abstract socket \0/tmp/.X11-unix/X$n is in use
# - the lock file /tmp/.X$n-lock exists
# - the Unix domain socket /tmp/.X11-unix/X$n exists
#

sub CheckDisplayNumber
{
  local ($n) = $_[0];
  local ($silent) = $_[1];

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

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

  if ($os eq "Linux") {
    socket(S, $AF_UNIX, $SOCK_STREAM, 0) || die "$prog: socket failed: $!\n";
    unless (bind(S, pack_sockaddr_un("\0/tmp/.X11-unix/X$n"))) {
      if (!$silent) {
        warn "\nWARNING: $host:$n is taken because abstract socket \\0/tmp/.X11-unix/X$n is in use.\n";
      }
      close(S);
      return 0;
    }
    close(S);
  }

  if (-e "/tmp/.X$n-lock") {
    if (!$silent) {
      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") {
    if (!$silent) {
      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 TurboVNC X 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 unless (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("TurboVNC Server v@VERSION@ (build @BUILD@)\n".
      "\n".
      "Usage: $prog [<OPTIONS>] [:<DISPLAY#>]\n".
      "       $prog -kill :<DISPLAY#>\n".
      "       $prog -list\n".
      "\n".
      "<OPTIONS> are Xvnc options, or:\n".
      "\n".
      "        -depth <DEPTH>\n".
      "        -fg\n".
      "        -fp <FONT-PATH>\n".
      "        -geometry <WIDTH>x<HEIGHT> or\n".
      "        -geometry <W0>x<H0>+<X0>+<Y0>[,<W1>x<H1>+<X1>+<Y1>,...]\n".
      "        -log <FILE>\n".
      "        -name <DESKTOP-NAME>\n".
      "        -noautokill\n".
      "        -novnc <DIR>\n".
      "        -noxstartup\n".
      "        -otp\n".
      "        -pixelformat rgb<NNN>\n".
      "        -pixelformat bgr<NNN>\n".
      "        -uds\n".
      "        -vgl\n".
      "        -wm <SCRIPT>\n".
      "        -x509cert <CERT-FILE>\n".
      "        -x509key <KEY-FILE>\n".
      "        -xstartup <SCRIPT>\n".
      "\n".
      "See the vncserver and Xvnc man pages for more information.\n");
}


#
# List
#
# If -sessionlist is passed to vncserver instead of -list, then this subroutine
# prints the TurboVNC session list in a machine-readable format that the
# TurboVNC Session Manager can easily parse through its SSH connection.  The
# machine-readable session list contains the following fields, in the following
# order, separated by a single space and on the same line:
#
# - The total number of TurboVNC sessions that are currently running on this
#   host under the user account that invoked vncserver
# - The number of parameters to be listed for each session (currently 3 but may
#   increase in the future)
# - The X display number for Session 1
# - The Xvnc process ID for Session 1
# - The noVNC web server process ID for Session 1 (or 0 if a noVNC web server
#   was not started with the session)
#   ...
# - The X display number for Session N
# - The Xvnc process ID for Session N
# - The noVNC web server process ID for Session N (or 0 if a noVNC web server
#   was not started with the session)
#
# If -sessionstart is passed to vncserver, then vncserver starts a new TurboVNC
# session and calls this subroutine with a second argument (the X display
# number of the new session), which causes the subroutine to use the format
# described above to list only the new session.  (Thus, the first field will
# always be 1 in that case.)
#
# Since the TurboVNC Session Manager relies upon these interfaces, they are
# considered stable and (barring some unforeseen dire need) will not change in
# a backward-incompatible manner.  The number of parameters will likely
# increase in the future (for instance, to support Unix domain sockets with the
# TurboVNC Session Manager), but the meaning of the existing parameters should
# stay the same.
#

sub List
{
  local ($verbose) = $_[0];
  local ($displayNumber) = $_[1];

  opendir(dir, $vncUserDir);
  my @filelist = readdir(dir);
  closedir(dir);
  if ($verbose) {
    print "\nTurboVNC sessions:\n\n";
    print "X DISPLAY #\tPROCESS ID\tNOVNC PROCESS ID\n";
  }
  my @sessions = ();
  foreach my $file (@filelist) {
    if ($file =~ /$host:(\d+)$\.pid/ && !&CheckDisplayNumber($1, 1) &&
        ($1 == $displayNumber || !$displayNumber)) {
      my @session = ();
      push(@session, $1);
      chomp($pid = `cat $vncUserDir/$file`);
      push(@session, $pid);
      if (-r "$vncUserDir/$host:$1-noVNC.pid") {
        chomp($pid = `cat $vncUserDir/$host:$1-noVNC.pid`);
      } else {
        $pid = 0;
      }
      push(@session, $pid);
      push(@sessions, \@session);
    }
  }
  if (!$verbose) {
    print scalar(@sessions)."\t3";
  }
  if (scalar(@sessions)) {
    @sessions = sort { $a->[0] <=> $b->[0] } @sessions;
    foreach $session (@sessions) {
      if ($verbose) {
        print ":".$session->[0]."\t\t".$session->[1];
        if ($session->[2]) {
          print "\t\t".$session->[2];
        }
        print "\n";
      } else {
        print "\t:".$session->[0]."\t".$session->[1]."\t".$session->[2];
      }
    }
  }
  if (!$verbose) {
    print "\n";
  }
}


#
# 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";
    $udsPathFile = "$vncUserDir/$host$opt{'-kill'}.udspath";
    $noVNCPIDFile = "$vncUserDir/$host$opt{'-kill'}-noVNC.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";
    $udsPathFile = "$vncUserDir/$opt{'-kill'}.udspath";
    $noVNCPIDFile = "$vncUserDir/$opt{'-kill'}-noVNC.pid";
  }

  if (-r $noVNCPIDFile) {
    $SIG{'HUP'} = 'IGNORE';
    chop($pid = `cat $noVNCPIDFile`);
    warn "Killing noVNC web server process ID $pid\n";

    if (kill 0, $pid) {
      system("kill $pid");
      sleep(1);
      if (kill 0, $pid) {
        print "noVNC seems to be deadlocked.  Kill the process manually and then re-run\n";
        print "    ".$0." -kill ".$opt{'-kill'}."\n";
        print "to clean up the PID file.\n";
      } else {
        unlink $noVNCPIDFile;
      }
    } else {
      warn "noVNC web server process ID $pid already killed\n";
      unlink $noVNCPIDFile;
    }
  }

  unless (-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 (kill 0, $pid) {
    system("kill $pid");
    sleep(1);
    if (kill 0, $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 (-r $udsPathFile) {
      chop($udsPath = `cat $udsPathFile`);
      if (-e $udsPath) {
        print "Xvnc did not appear to shut down cleanly.";
        print " Removing $udsPath\n";
        unlink $udsPath;
      }
    }
    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;
  unlink $udsPathFile;
  exit;
}


#
# ParseOptions 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 ParseOptions
{
  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 (lc $arg eq $opt) {
        push(@optArgs, $arg);
        if ($valFollows{$opt}) {
          if (@ARGV == 0) {
            &Usage();
          }
          $opt{$opt} = shift(@ARGV);
          push(@optArgs, $opt{$opt});
        } else {
          $opt{$opt} = 1;
        }
        next arg;
      }
    }
    push(@newargs, $arg);
  }

  @ARGV = @newargs;
}


#
# Routine to make sure we're operating in a sane environment.
#

sub SanityCheck
{
  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") {
    for (split(/:/, $ENV{PATH})) {
      if (-x "$_/$cmd") {
        next cmd;
      }
    }
    die "$prog: couldn't find \"$cmd\" on your PATH.\n";
  }
  if (-x "/usr/X11R6/bin/xauth") {
    $xauth = "/usr/X11R6/bin/xauth";
  }
  elsif (-x "/usr/openwin/bin/xauth") {
    $xauth = "/usr/openwin/bin/xauth";
  } else {
  cmd1:
    foreach $cmd ("xauth") {
      for (split(/:/, $ENV{PATH})) {
        if (-x "$_/$cmd") {
          next cmd1;
        }
      }
      die "$prog: couldn't find \"$cmd\" on your PATH.\n";
    }
  }

  foreach $cmd ($exedir."Xvnc", $exedir."vncpasswd") {
    if (! -x "$cmd") {
      die "$prog: couldn't find \"$cmd\".\n";
    }
  }
  if ($buildWebServer) {
    foreach $cmd ($exedir."webserver") {
      if (! -x "$cmd") {
        die "$prog: couldn't find \"$cmd\".\n";
      }
    }
  }

  #
  # Check the HOME and USER environment variables are both set.
  #

  unless (defined($ENV{HOME})) {
    die "$prog: The HOME environment variable is not set.\n";
  }
#  unless (defined($ENV{USER})) {
#    die "$prog: The USER 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_UNIX, 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_UNIX = 1;
        $AF_INET = 2;
        $SOCK_STREAM = 2;
      } else {
        $AF_UNIX = 1;
        $AF_INET = 2;
        $SOCK_STREAM = 1;
      }
    } else {
      $AF_UNIX = &AF_UNIX;
      $AF_INET = &AF_INET;
      $SOCK_STREAM = &SOCK_STREAM;
    }
  } else {
    $AF_UNIX = &AF_UNIX;
    $AF_INET = &AF_INET;
    $SOCK_STREAM = &SOCK_STREAM;
  }
}

sub ReadConfiguration
{
  my @configurableVariables =
    qw(geometry
       depth
       desktopName
       dpi
       vncUserDir
       fontPath
       securityTypes
       generateOTP
       autoLosslessRefresh
       wm
       useVGL
       autokill
       pamSession
       multiThread
       numThreads
       noVNC
       passwdFile
       x509CertFile
       x509KeyFile
       xstartup
       noxstartup
       serverArgs
       useUDS);

  if (open CONF, "<$configFile") {
    while (<CONF>) {
      if (/^\s*\$(\w+)\s*=\s*(.*)$/) {
        for my $var (@configurableVariables) {
          if ($1 eq $var) {
            eval $_;
            last;
          }
        }
      }
    }
    close CONF;
  }
}

sub ReadAuthConfiguration($)
{
  my $acf = shift;
  my $enableVNC = 0;
  my $enableOTP = 0;
  my $permissionsSet = 0;

  return unless (open(ACF, $acf));

  while (<ACF>) {
    $_ =~ s/[\t\ \r\n]//g;
    @tokens = split(/=/, $_);
    if (@tokens[0] eq 'permitted-auth-methods') {
      $permissionsSet = 1;
      foreach $tok (split/[,=]/, $_) {
        if (lc $tok eq 'otp') {
          $enableOTP = 1;
        }
        if (lc $tok eq 'vnc') {
          $enableVNC = 1;
        }
      }
    }
    if (@tokens[0] eq 'permitted-security-types') {
      $permissionsSet = 1;
      foreach $tok (split/[,=]/, $_) {
        if (substr(lc $tok, -3) eq 'otp') {
          $enableOTP = 1;
        }
        if (substr(lc $tok, -3) eq 'vnc') {
          $enableVNC = 1;
        }
      }
    }
  }

  return unless ($permissionsSet == 1);

  if ($enableVNC == 0) {
    $authTypeVNC = 0;
  }
  if ($enableOTP == 0) {
    $authTypeOTP = 0;
  }

  close(ACF);
}
