#! /usr/bin/perl
# vim: set sw=2 sts=2 ts=8 syn=perl expandtab:
#
# vncserver - wrapper script to start an X VNC server.
#
# Copyright (C) 2004-2006 Joachim Falk <joachim.falk@gmx.de>
# Please report all errors to Joachim Falk and not to OL.
#
# This file is based on a vncserver script provided by:
#
#  Copyright (C) 2004 Ola Lundqvist <opal@debian.org>
#  Copyright (C) 2004 Marcus Brinkmann <Marcus.Brinkmann@ruhr-uni-bochum.de>
#  Copyright (C) 2004 Dirk Eddelbuettel <edd@debian.org>
#  Copyright (C) 2002-2003 RealVNC Ltd.
#  Copyright (C) 1999 AT&T Laboratories Cambridge.  All Rights Reserved.
#  Copyright (C) 1997, 1998 Olivetti & Oracle Research Laboratory
#
# 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., 59 Temple Place - Suite 330, Boston, MA  02111-1307,
# USA.

package config;

#########################################################################
#
# I thank Manoj for the code below. All errors are mine, though.
#
# readConfigFile reads in a config file and sets variables according to it.
#

sub readConfigFile {
  my ( $ConfigFile ) = @_;
  
  eval { do "$ConfigFile"; };
  if ($@) {
    print STDERR "$PROG: Error parsing config file, $@";
  }
  
#  my $lineno = 0;
#  while (<$cf>) {
#    chomp;
#    $lineno++;
#    s/\#.*//og;
#    next if /^\s*$/og;
#    $_ .= ";" unless /;\s*$/;
#    if (/^\s*([^=]+)\s*=\s*(\S.*)$/o) {
#      my $ret = eval "$1=$2";
#      if ($@) {
#	print STDERR "$PROG: Error parsing config file $ConfigFile at line $lineno!\n";
#      }
#    }
#  }
}

package main;

use strict;
use warnings;

use File::Path;
use File::Spec;
use File::Basename qw(dirname basename);
use DirHandle;
use File::stat;
use IO::File;
use Socket;
use Getopt::Long;
use Time::HiRes qw(usleep);
use Errno qw(:POSIX);
use POSIX ":sys_wait_h";

use vars qw($HOST $PROG %CMDS);

#
# Set global constants
#

# Get the program name
$PROG = basename($0);

#
# Routine to make sure we're operating in a sane environment.
#
sub sanityCheck {
  # Get install base bin dir
  my $binbase = dirname(File::Spec->rel2abs($0));

  #
  # Check we have all the commands we'll need on the path.
  #
  %CMDS = ();
cmd:
  foreach my $cmd ("uname","xauth","Xtigervnc","tigervncpasswd") {
    foreach my $dir ($binbase, split(/:/,$ENV{PATH})) {
      $CMDS{$cmd} = File::Spec->catfile($dir, $cmd);
      next cmd if -x $CMDS{$cmd};
    }
    print STDERR "$PROG: couldn't find \"$cmd\" on your PATH.\n";
    exit 1;
  }

  #
  # Check the HOME environment variable is set
  #
  if (!defined($ENV{HOME})) {
    print STDERR "$PROG: The HOME environment variable is not set.\n";
    exit 1;
  }
}

sub readConfigFile {
  my $options = shift;
  
  # Add aliases of ::config to %$options
  foreach my $key (keys %$options) {
    no strict 'refs';
    *{"config::$key"} = \$options->{$key};
  }
  foreach my $ConfigFile (@_) {
    next unless -f $ConfigFile; 
    config::readConfigFile( $ConfigFile );
  }
#  foreach my $key (keys %$options) {
#    if ( defined $config::{$key} &&
#         defined *{$config::{$key}}{SCALAR} ) {
#      $options->{$key} = ${*{$config::{$key}}{SCALAR}};
#    }
#    print $key, " => ", $options->{$key}, "\n";
#  }
}

sub readXFConfig {
  my $options = shift;
  my ($XFConfigPath) = @_;
  
  my $cf;
  foreach my $path (split(/:/, $XFConfigPath)) {
    last if defined ($cf = IO::File->new( "<$path" ));
  }
  return unless defined $cf;
  my $lineno = 0;
  my ( $fontPath, $colorPath );
  while (<$cf>) {
    chomp;
    $lineno++;
    s/\#.*//og;
    next if /^\s*$/og;
    if (/^\s*FontPath\s*"(\S.*)"\s*$/o) {
      if (defined $fontPath) {
        $fontPath .= ",$1";
      } else {
        $fontPath  = $1;
      }
    }
#   if (/^\s*RgbPath\s*"(\S.*)"\s*$/o) {
#     $colorPath = $1;
#   }
  }
  if (defined $fontPath) {
    my @fontPathElements = split(/\s*,\s*/, $fontPath);
    
    $fontPath = '';
    foreach my $tempFontPath (@fontPathElements) {
      # is font directory or fontserver (xfs) ?
      if ($tempFontPath !~ m{^[^/]*/[^/]*:\d+$}) {
        # font directory
	$tempFontPath =~ s/:unscaled$//; # remove :unscaled
	# is really a font directory ?
	next unless -r "$tempFontPath/fonts.dir"; # skip if not
      }
      $fontPath .= "$tempFontPath,";
    }
    chop $fontPath; # remove last ','
    $options->{'fontPath'}  = $fontPath;
  }
# if (defined $colorPath) {
#   $options->{'colorPath'} = $colorPath;
# }
}

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

sub checkGeometryAndDepth {
  my ( $options ) = @_;
  
  my $wmDecorationWidth;
  my $wmDecorationHeight;
  
  if ($options->{'wmDecoration'} =~ /^(\d+)x(\d+)$/) {
    ($wmDecorationWidth, $wmDecorationHeight) = ($1,$2);
  } else {
    print STDERR "$PROG: wmDecoration $options->{'wmDecoration'} is invalid\n";
    exit 1;
  }
  if ($options->{'geometry'} =~ /^(\d+)x(\d+)$/) {
    my ( $width, $height ) = ( $1, $2 );
    $width  -= $wmDecorationWidth;
    $height -= $wmDecorationHeight;
    if (($width<1) || ($height<1)) {
      print STDERR "$PROG: geometry $options->{'geometry'} is invalid\n";
      exit 1;
    }
    
    $width  = int(($width +3)/4)*4;
    $height = int(($height+1)/2)*2;
    
    $options->{'geometry'} = "${width}x${height}";
  } else {
    print STDERR "$PROG: geometry $options->{'geometry'} is invalid\n";
    exit 1;
  }

  if ($options->{'pixelformat'}) {
    unless ($options->{'pixelformat'} =~ m/^(?:rgb|bgr)(\d)(\d)(\d)$/) {
      die 'Internal logic error !';
    }
    if (!defined $options->{'depth'}) {
      $options->{'depth'} = $1+$2+$3;
    } elsif ($options->{'depth'} < $1+$2+$3) {
      print STDERR "$PROG: Depth $options->{'depth'} and pixelformat $options->{'pixelformat'} are inconsistent.\n";
      exit 1;
    }
  }
  if (($options->{'depth'} < 8) || ($options->{'depth'} > 32)) {
    print STDERR "$PROG: Depth must be between 8 and 32.\n";
    exit 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 {
  my ( $options ) = @_;
  
  my (@lines, @matchlines, $defaultVisualId, $i);
  
  return if (!defined($ENV{DISPLAY}));
  
  @lines = `xdpyinfo 2>/dev/null`;
  
  return if ($? != 0);
  
  @matchlines = grep(/dimensions/, @lines);
  if (@matchlines) {
    my ($width, $height) = ($matchlines[0] =~ /(\d+)x(\d+) pixels/);
    $options->{'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);

    ( $options->{'depth'} ) = ($lines[$i+2] =~ /depth:\s+(\d+)/);
    my ($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;
      $options->{'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;
      $options->{'pixelformat'} = "bgr$blue$green$red";
    }
  }
}

#
# Check if tcp port is available
#
sub checkTCPPortUsed {
  my ($port) = @_;
  my $proto  = getprotobyname('tcp');
  
  socket(S, AF_INET, SOCK_STREAM, $proto) || die "$PROG: socket failed: $!";
  setsockopt(S, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "$PROG: setsockopt failed: $!";
  if (!bind(S, sockaddr_in($port, INADDR_ANY))) {
    # print "$PROG: bind ($port) failed: $!\n";
    close(S);
    return 1;
  }
  close(S);
  return 0;
}

#
# checkDisplayNumberUsed checks if the given display number is used by vnc.
# A display number n is used if something is listening on the VNC server port
# (5900+n).
#

sub checkDisplayNumberUsed {
  my ($n) = @_;
  return &checkTCPPortUsed( 5900 + $n ) ||
	 &checkTCPPortUsed( 6000 + $n );
}

#
# checkDisplayNumberAvailable 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 checkDisplayNumberAvailable {
  my ($n) = @_;

  return 0 if &checkDisplayNumberUsed($n);

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

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

#
# getDisplayNumber 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 getDisplayNumber {
  foreach my $n (1..99) {
    return $n if &checkDisplayNumberAvailable($n);
  }
  
  print STDERR "$PROG: no free display number on $HOST.\n";
  exit -1;
}

sub pidFile {
  my ($options,$usedDisplay) = @_;
  $usedDisplay = $options->{'displayNumber'} unless defined $usedDisplay;
  return "$options->{'vncUserDir'}/$HOST:$usedDisplay.pid";
}

sub desktopLog {
  my ($options,$usedDisplay) = @_;
  $usedDisplay = $options->{'displayNumber'} unless defined $usedDisplay;
  return File::Spec->catfile($options->{'vncUserDir'}, "$HOST:$usedDisplay.log");
}

sub cleanStale {
  my ($options, $usedDisplay, $stale) = @_;
  my $pidFile  = pidFile($options,$usedDisplay);
  my @x11Locks = ("/tmp/.X$usedDisplay-lock", "/tmp/.X11-unix/X$usedDisplay");
  
  # vnc pidfile stale
  my $msg = "";
  if (-e $pidFile) {
    unless ($options->{'dry-run'} || unlink($pidFile) || $! == &ENOENT) {
      print STDERR "$PROG: Can't clean stale pidfile '$pidFile': $!\n";
    } elsif ($stale) {
      print "Cleaning stale pidfile '$pidFile'!\n";
    }
  }
  if (!$stale || !&checkDisplayNumberUsed($usedDisplay)) {
    foreach my $entry (grep { -e $_ } @x11Locks) {
      unless ($options->{'dry-run'} || unlink($pidFile) || $! == &ENOENT) {
        print STDERR "$PROG: Can't clean stale x11 lock '$entry': $!\n";
      } else {
        print "Cleaning stale x11 lock '$entry'!\n";
      }
    }
  }
}

sub runningUserVncservers {
  my ($options) = @_;
  my %runningUserVncservers = ();
  
  my $d = DirHandle->new($options->{'vncUserDir'});
  if (defined $d) {
    while (defined(my $entry = $d->read)) {
      next unless $entry =~ m/^\Q$HOST\E:(\d+)\.pid$/;
      my $usedDisplay = $1;
      my $pidFile     = File::Spec->catfile($options->{'vncUserDir'}, $entry);
      my $pidFileFh   = IO::File->new($pidFile, "r");
      unless (defined $pidFileFh) {
        print STDERR "$PROG: Can't open pid file '$pidFile': $!\n";
        next;
      }
      unless ($pidFileFh->getline() =~ m/^([0-9]+)$/) {
        print STDERR "$PROG: Can't parse pid file '$pidFile'!\n";
        next;
      }
      my $pid = int($1);
      if ($options->{'cleanstale'} && !kill(0, $pid)) {
        cleanStale($options, $usedDisplay, 1);
        next;
      }
      # running vnc if !$options->{'cleanstale'}
      $runningUserVncservers{$usedDisplay} = {
          'name'        => "$HOST:$usedDisplay",
          'pid'         => $pid,
          'host'        => $HOST,
          'usedDisplay' => $usedDisplay
        };
    }
    undef $d;
  }
  return \%runningUserVncservers;
}

#
# killXvncServer
#

sub killXvncServer {
  my ($options, $runningUserVncservers, $vncs) = @_;
  
  $SIG{'CHLD'} = 'IGNORE';
  my $retval = 0;
  foreach my $vnc (@{$vncs}) {
    my $stale = 0;
    my $pid   = $runningUserVncservers->{$vnc}->{'pid'};
    
    print "Killing Xtigervnc process ID $pid...";
    unless ($options->{'dry-run'}) {
      if (kill('TERM', $pid)) {
        my $i = 10;
        for (; $i >= 0; $i = $i-1) {
          last unless kill(0, $pid);
          usleep 100000;
        }
        if ($i >= 0) {
          print " success!\n";
        } else {
          $retval = 1;
          print " which seems to be deadlocked. Using SIGKILL!\n";
          unless (kill('KILL', $pid) || $! == &ESRCH) {
            print STDERR "Can't kill '$pid': $!\n";
            next;
          }
        }
      } elsif ($! == &ESRCH) {
        print " which was already dead\n";
        $stale = 1;
      } else {
        $retval = 1;
        print STDERR "\nCan't kill '$pid': $!\n";
        next;
      }
    }
    &cleanStale($options,$vnc,$stale);
    
    # If option -clean is given, also remove the logfile
    if (!$options->{'dry-run'} && $options->{'clean'}) {
      my $desktopLog = &desktopLog($options, $vnc);
      unless (unlink($desktopLog) || $! == &ENOENT) {
        $retval = 1;
        print STDERR "Can't remove '$desktopLog': $!\n";
      }
    }
  }
  $SIG{'CHLD'} = 'DEFAULT';
  return $retval;
}

sub listXvncServer {
  my ($fh, $options, $runningUserVncservers, $vncs) = @_;
  
  print $fh
    "\n".
    "TigerVNC server sessions:\n".
    "\n".
    "X DISPLAY #\tPROCESS ID\n";
  foreach my $vnc (@{$vncs}) {
    print $fh ":".$vnc."\t\t".$runningUserVncservers->{$vnc}->{'pid'}."\n";
  }
}

# Make an X server cookie
sub CreateMITCookie {
  my ( $options ) = @_;
  my $displayNumber  = $options->{'displayNumber'};
  my $xauthorityFile = $options->{'xauthorityFile'};
  my $cookie = `mcookie`; # try mcookie
  
  unless (defined $cookie) {
    # mcookie failed => make an X server cookie the old fashioned way
    srand(time+$$+unpack("L",`cat $options->{'vncPasswdFile'}`));
    $cookie = "";
    for (1..16) {
      $cookie .= sprintf("%02x", int(rand(256)));
    }
  } else {
    chomp $cookie;
  }
  system($CMDS{"xauth"}, "-f", "$xauthorityFile", "add", "$HOST:$displayNumber", ".", "$cookie");
  system($CMDS{"xauth"}, "-f", "$xauthorityFile", "add", "$HOST/unix:$displayNumber", ".", "$cookie"); 
}

# Make sure the user has a password.
sub CreateVNCPasswd {
  my ( $options ) = @_;
  my $vncPasswdFile = $options->{'vncPasswdFile'};
  my $st = stat($vncPasswdFile);
  
  if (!defined($st) || ($st->mode & 077)) {
    print "\nYou will require a password to access your desktops.\n\n";
    unless (unlink($vncPasswdFile) || $! == &ENOENT) {
      print STDERR "Can't remove old vnc passwd file '$vncPasswdFile': $!!\n";
      exit 1;
    }
    system($CMDS{"tigervncpasswd"}, $vncPasswdFile); 
    exit 1 if (($? >> 8) != 0);
  }
}

# Now start the X VNC Server
sub startXvncServer {
  my ($options) = @_;
  my $vncStartup = $options->{'vncStartup'};
  my $vncPort    = 5900 + $options->{'displayNumber'};
  my $desktopLog = &desktopLog($options);
  my $pidFile    = &pidFile($options);
  
  # Make sure the user has a password.
  &CreateVNCPasswd($options);
  &CreateMITCookie($options);
  
  # Create the user's vncStartup script if necessary.
  if (!(-e $vncStartup)) {
    print "Creating default startup script $vncStartup\n";
    unless ($options->{'dry-run'}) {
      my $sf = IO::File->new($vncStartup, "w", 0755);
      unless (defined $sf) {
        print STDERR "$PROG: Can't create startup script '$vncStartup': $!\n";
        exit 1;
      }
      print $sf $options->{'defaultVncStartup'};
      $sf->close;
    }
  } elsif (!(-x $vncStartup)) {
    unless ($options->{'dry-run'} || chmod 0755, $vncStartup) {
      print STDERR "$PROG: Can't fixup permissions of startup script '$vncStartup': $!\n";
      exit 1;
    }
  }
  
  my $pidFileFh  = IO::File->new($pidFile, "w", 0644);
  unless (defined $pidFileFh) {
    print STDERR "$PROG: Can't create pid file '$pidFile': $!\n";
    exit 1;
  }

  my $xvncServerPid = fork();
  if ($xvncServerPid == 0) {
    # I am the child
    my @cmd = ($CMDS{"Xtigervnc"});
    push @cmd, ":".$options->{'displayNumber'};
    if (defined $options->{'desktopName'}) {
      push @cmd, '-desktop', $options->{'desktopName'};
    }
    if (defined $options->{'vncClasses'} &&
         (defined($options->{'httpPort'}) ||
          defined($options->{'baseHttpPort'}))) {
      print("Found $options->{'vncClasses'} for http connections.\n");
      push @cmd, '-httpd', $options->{'vncClasses'};
      my $v = $options->{'httpPort'} ||
              $options->{'baseHttpPort'} + $options->{'displayNumber'};
      push @cmd, '-httpPort', $v;
      print("Listening to $v for http connections.\n");
    }
    push @cmd, '-auth', $options->{'xauthorityFile'};
    push @cmd, '-geometry', $options->{'geometry'} if $options->{'geometry'};
    push @cmd, '-depth', $options->{'depth'} if $options->{'depth'};
    push @cmd, '-pixelformat', $options->{'pixelformat'} if $options->{'pixelformat'};
    push @cmd, '-rfbwait', $options->{'rfbwait'};
    push @cmd, '-rfbauth', $options->{'vncPasswdFile'};
    push @cmd, '-rfbport', $vncPort;
    push @cmd, '-pn';
    push @cmd, '-localhost' if $options->{'localhost'} =~ m/^(?:yes|true|1)$/i;
    push @cmd, '-fp', $options->{'fontPath'} if $options->{'fontPath'};
    push @cmd, @ARGV;

    print join(" ",@cmd), "\n" if $options->{'verbose'};
    open(OLDERR, '>&', \*STDERR); # save old STDERR
    open(STDOUT, '>>', $desktopLog);
    open(STDERR, '>>', $desktopLog);
    STDERR->autoflush(1);
    STDOUT->autoflush(1);
    exec {$cmd[0]} (@cmd) or
      print OLDERR "$PROG: Can't exec '".$cmd[0]."': $!\n";
    exit 1;
  } elsif ($xvncServerPid < 0) {
    # Failed to fork
    print STDERR "$PROG: failed to fork: $!\n";
    exit 1;
  }
  $pidFileFh->print($xvncServerPid."\n");
  $pidFileFh->close();
  
  my $runningUserVncservers = {
      $options->{'displayNumber'} => {
          'name'        => "$HOST:".$options->{'displayNumber'},
          'pid'         => $xvncServerPid,
          'host'        => $HOST,
          'usedDisplay' => $options->{'displayNumber'}
        }
    };
  # Wait for Xtigervnc to start up
  {
    my $i = 10;
    for (; $i >= 0; $i = $i-1) {
      last if &checkTCPPortUsed(5900 + $options->{'displayNumber'});
      if ($xvncServerPid = waitpid($xvncServerPid, WNOHANG)) { $i = -2; last; }
      usleep 100000;
    }
    for (; $i >= 0; $i = $i-1) {
      last if -e "/tmp/.X11-unix/X$options->{'displayNumber'}" ||
              &checkTCPPortUsed(6000 + $options->{'displayNumber'});
      if ($xvncServerPid = waitpid($xvncServerPid, WNOHANG)) { $i = -2; last; }
      usleep 100000;
    }
    if ($i < 0) {
      print STDERR "$PROG: $CMDS{'Xtigervnc'} did not start up, please look into '$desktopLog' to determine the reason! $i\n";
      if (kill(0, $xvncServerPid)) {
        &killXvncServer($options, $runningUserVncservers, [$options->{'displayNumber'}]);
      } else {
        &cleanStale($options,$options->{'displayNumber'},0);
      }
      exit 1;
    }
  }
  # If the unix domain socket exists then use that (DISPLAY=:n) otherwise use
  # TCP (DISPLAY=host:n)
  if (-e "/tmp/.X11-unix/X$options->{'displayNumber'}" ) {
    $ENV{DISPLAY}= ":$options->{'displayNumber'}";
  } else {
    $ENV{DISPLAY}= "$HOST:$options->{'displayNumber'}";
  }
  $ENV{VNCDESKTOP} = $options->{'desktopName'};
  print "\nNew '$options->{'desktopName'}' desktop at $HOST:$options->{'displayNumber'}\n\n";
  
  # Run the X startup script.
  print "Starting applications specified in $vncStartup\n";
  print "Log file is $desktopLog\n\n";
  
  my $childPid = $options->{'fg'} ? 0 : fork();
  if ($childPid == 0) {
    # I am the child
    my @cmd = ($vncStartup);
    push @cmd, @{$options->{'sessionArgs'}};
    print join(" ",@cmd), "\n" if $options->{'verbose'};

    open(OLDERR, '>&', \*STDERR); # save old STDERR
    open(STDOUT, '>>', $desktopLog);
    open(STDERR, '>>', $desktopLog);
    STDERR->autoflush(1);
    STDOUT->autoflush(1);
    if ($options->{'fg'} || $options->{'autokill'}) {
      system $cmd[0] (@cmd);
      if (kill(0, $xvncServerPid)) {
        &killXvncServer($options, $runningUserVncservers, [$options->{'displayNumber'}]);
      } else {
        &cleanStale($options,$options->{'displayNumber'},0);
      }
      exit 0;
    } else {
      exec {$cmd[0]} (@cmd) or
        print OLDERR "$PROG: Can't exec '".$cmd[0]."': $!\n";
      exit 1;
    }
  } elsif ($childPid < 0) {
    # Failed to fork
    print STDERR "$PROG: failed to fork: $!\n";
  }
  # I am the parent
  exit 0;
}

#
# usage
#

sub usage {
  my ($err) = @_;
  
  my $prefix = " " x length("  $PROG ");
  print STDERR "usage:\n".
    "  $PROG -help|-h|-?            This help message. Further help in tigervncserver(1).\n\n".

    "  $PROG [:<number>]            X11 display for VNC server\n".
    $prefix."[-dry-run]             Take no real action\n".
    $prefix."[-verbose]             Be more verbose\n".
    $prefix."[-useold]              Only start VNC server if not already running\n".
    $prefix."[-name <desktop-name>] VNC desktop name\n".
    $prefix."[-depth <depth>]       Desktop bit depth (8|16|24|32)\n".
    $prefix."[-pixelformat          X11 server pixel format\n".
    $prefix."  rgb888|rgb565|rgb332   blue color channel encoded in lower bits\n".
    $prefix." |bgr888|bgr565|bgr233]  red color channel encoded in lower bits\n".
    $prefix."[-geometry <dim>]      Desktop geometry in <width>x<height>\n".
    $prefix."[-xdisplaydefaults]    Get geometry and pixelformat from running X\n".
    $prefix."[-wmDecoration <dim>]  Shrink geometry by dim\n".
    $prefix."[-localhost yes|no]    Only accept VNC connections from localhost\n".
    $prefix."[-httpPort     port]   Port of internal http server\n".
    $prefix."[-baseHttpPort port]   Calculate http port from base port + display nr\n".
    $prefix."[-fg]                  No daemonization and\n".
    $prefix."                       kill the VNC server after its X session has terminated\n".
    $prefix."[-autokill]            Kill the VNC server after its X session has terminated\n".
    $prefix."[-fp fontpath]         Colon separated list of font locations\n".
    $prefix."[-cleanstale]          Do not choke on a stale lockfile\n".
    $prefix."<X11-options ...>      Further options for Xtigervnc(1)\n".
    $prefix."[-- sessiontype]       Arguments for the VNC startup script Xvnc-session\n\n".

    "  $PROG -kill                  Kill a VNC server\n".
    $prefix."[:<number>|:*]         VNC server to kill, * for all\n".
    $prefix."[-dry-run]             Take no real action\n".
    $prefix."[-verbose]             Be more verbose\n".
    $prefix."[-clean]               Also clean log files of VNC session\n\n".

    "  $PROG -list                  List VNC server sessions\n".
    $prefix."[:<number>|:*]         VNC server to list, * for all\n".
    $prefix."[-cleanstale]          Do not list stale VNC server sessions\n\n";
    
  exit($err ? 1 : 0);
}

sub main {
  #
  # First make sure we're operating in a sane environment.
  #
  &sanityCheck();
  
  # Get the hostname
  chop($HOST = `$CMDS{"uname"} -n`);
  
  #
  # Global options.  You may want to configure some of these for your site.
  # Use /etc/vnc.conf and ~/.vnc/vnc.conf for this purpose.
  #
  my $options = {
      # a guess at typical size for window manager decoration
      wmDecoration		=> "4x24",
      geometry			=> "1280x1024",
      depth			=> 32,
      pixelformat		=> undef,
      desktopName		=> "X-".($ENV{LOGNAME}||"unknown"),
      rfbwait			=> 30000,
      cleanstale		=> 0,
      clean			=> 0,
      displayNumber		=> undef,
      displayHost		=> undef,
      localhost			=> 1,
      fontPath			=> undef,
      XFConfigPath		=>
        "/etc/X11/xorg.conf",
      xauthorityFile		=>
        $ENV{XAUTHORITY} ||
        File::Spec->catfile($ENV{HOME}, ".Xauthority"),
      defaultVncStartup         =>
        "#! /bin/sh\n\n".
        "vncconfig -iconic &\n".
        "\$SHELL -l <<EOF\n".
        "exec /etc/X11/Xsession \$@\n".
        "EOF\n".
        "vncserver -kill \$DISPLAY\n",
      vncUserDir		=>
        File::Spec->catfile($ENV{HOME}, ".vnc"),
      vncPasswdFile		=>
        undef, # later derived from vncUserDir
      vncStartup		=>
        undef, # later derived from vncUserDir
      sessionArgs		=> [],
    };
  
  #
  # Then source in configuration files, first the site wide one and then the
  # user specific one.
  #
  {
    my $tmpOpt = { XFConfigPath => $options->{'XFConfigPath'} };
    &readConfigFile($tmpOpt, "/etc/vnc.conf");
    &readXFConfig($options, $tmpOpt->{'XFConfigPath'});
  }
  &readConfigFile($options, "/etc/vnc.conf");
  
  if (!(-d $options->{'vncUserDir'})) {
    # Create the user's vnc directory if necessary.
    if (-e $options->{'vncUserDir'}) {
      print STDERR "$PROG: Could not create $options->{'vncUserDir'}, file exists but is not a directory.\n";
      exit 1;
    }
    if (!mkpath ($options->{'vncUserDir'}, 0, 0755)) {
      print STDERR "$PROG: Could not create $options->{'vncUserDir'}.\n";
      exit 1;
    }
  }
  &readConfigFile($options, File::Spec->catfile($options->{'vncUserDir'}, "vnc.conf"));
  unless (defined $options->{'vncStartup'}) {
    if (-f File::Spec->catfile($options->{'vncUserDir'}, "Xvnc-session")) {
      $options->{'vncStartup'} =
        File::Spec->catfile($options->{'vncUserDir'}, "Xvnc-session");
    } elsif (-f File::Spec->catfile($options->{'vncUserDir'}, "Xvnc-session")) {
      $options->{'vncStartup'} =
        File::Spec->catfile($options->{'vncUserDir'}, "xstartup");
    } else {
      $options->{'vncStartup'} =
        File::Spec->catfile($options->{'vncUserDir'}, "Xvnc-session");
    }
  }
  unless (defined $options->{'vncPasswdFile'}) {
    $options->{'vncPasswdFile'} =
      File::Spec->catfile($options->{'vncUserDir'}, "passwd");
  }
  if (! defined $options->{'vncClasses'}) {
    $options->{'vncClasses'} = "/var/www/vnc" if -d "/var/www/vnc";
  } elsif (! -d $options->{'vncClasses'}) {
    print STDERR "VNC class files can not be found at $options->{'vncClasses'}.";
    exit 1;
  }
  
  {
    # seperate session args
    {
      my @newargv;
      my $ref = \@newargv;
      
      foreach my $entry (@ARGV) {
        if ( $entry eq '--' ) {
          $ref = $options->{'sessionArgs'};
        } else {
          push @$ref, $entry;
        }
      }
      @ARGV = @newargv;
    }

    # Check command line options
    my %opts = (
        kill      => 0,
        help      => 0,
        list      => 0,
        fg        => 0,
        autokill  => 0,
        useold    => 0,
      );
    my $p = new Getopt::Long::Parser;
    $p->configure("pass_through");
    my $rc = $p->getoptions(
      'geometry=s'        => sub {
        $options->{'geometry'} = $_[1];
        $options->{'wmDecoration'} = "0x0"; },
      'depth=i'           => \$options->{'depth'},
      'pixelformat=s'     => sub {
        $options->{'pixelformat'} = $_[1];
        undef $options->{'depth'}; },
      'name=s'            => \$options->{'desktopName'},
      'kill'              => \$opts{'kill'},
      'help|h|?'          => \$opts{'help'},
      'fp=s'              => sub {
        $options->{'fontPath'} = $_[1];
        $opts{'fp'} = $_[1]; },
      'list'              => \$opts{'list'},
      'fg'                => \$opts{'fg'},
      'autokill'          => \$opts{'autokill'},
      'xdisplaydefaults'  => sub {
        &getXDisplayDefaults($options); },
      'wmDecoration=s'    => \$options->{'wmDecoration'},
      'httpPort=i'        => sub {
        $options->{'httpPort'} = $_[1];
        undef $options->{'baseHttpPort'}; },
      'baseHttpPort=i'    => sub {
        $options->{'baseHttpPort'} = $_[1];
        undef $options->{'httpPort'}; },
      'localhost:s'       => \$options->{'localhost'},
      'useold'            => \$opts{'useold'},
      'cleanstale'        => \$options->{'cleanstale'},
      'clean'             => \$options->{'clean'},
      'verbose'           => \$options->{'verbose'},
      'dry-run'           => \$options->{'dry-run'},
    );
    
    &usage(!$rc) if (!$rc || $opts{'help'});
    
    if ((@ARGV > 0) && ($ARGV[0] =~ /^([\w\d.]*):(\d+(?:\.\d+)?|\*)$/)) {
      shift(@ARGV);
      $options->{'localhost'} = 'yes' if $1 eq "localhost";
      if (($1 eq "") || ($1 eq "localhost")) {
        $options->{'displayHost'} = $HOST;
      } else {
        $options->{'displayHost'} = $1;
      }
      $options->{'displayNumber'} = $2;
      $options->{'displayNumber'} =~ s{\.\d+$}{};
      if (!$opts{'kill'} && !$opts{'list'}) {
        &usage(1) if $options->{'displayNumber'} eq '*';
      }
    } elsif ((@ARGV > 0) && ($ARGV[0] !~ /^-/)) {
      &usage(1);
    } else {
      $options->{'displayHost'}   = $HOST;
    }

    
    if ($options->{'displayHost'} ne $HOST ) {
      my @cmd = ("ssh", "$options->{'displayHost'}", "tigervncserver");
      push @cmd, "-dry-run" if $options->{'dry-run'};
      if ( $opts{'kill'} ) {
        push @cmd, "-kill";
        push @cmd, ":$options->{'displayNumber'}";
        push @cmd, "-clean" if ($options->{'clean'});
      } elsif ( $opts{'list'} ) {
        push @cmd, "-list";
      } else {
        push @cmd, ":$options->{'displayNumber'}";
        push @cmd, "-geometry", $options->{'geometry'} if ($options->{'geometry'});
        push @cmd, "-pixelformat", $options->{'pixelformat'} if ($options->{'pixelformat'});
        push @cmd, "-depth", $options->{'depth'} if ($options->{'depth'});
        push @cmd, "-name", $options->{'desktopName'} if ($options->{'desktopName'});
        push @cmd, "-fp", $opts{'fp'} if $opts{'fp'};
        push @cmd, "-fg" if $opts{'fg'};
        push @cmd, "-autokill" if $opts{'autokill'};
        push @cmd, "-httpPort", $options->{'httpPort'} if ($options->{'httpPort'});
        push @cmd, "-baseHttpPort", $options->{'baseHttpPort'} if ($options->{'baseHttpPort'});
        push @cmd, "-localhost" if ($options->{'localhost'});
        push @cmd, "-useold" if $opts{'useold'};
        push @cmd, "-cleanstale" if ($options->{'cleanstale'});
        push @cmd, "-wmDecoration", $options->{'wmDecoration'} if ($options->{'wmDecoration'});
        push @cmd, @ARGV;
        if ($#{$options->{'sessionArgs'}} >= 0) {
          push @cmd, '--';
          push @cmd, @{$options->{'sessionArgs'}};
        }
      }
      print join(" ",@cmd), "\n" if $options->{'verbose'};
      exec(@cmd);
      # print "\"".join(" ",@cmd)."\"\n";
      # die "\nCan't tell if $options->{'displayHost'} equals $HOST\n";
      exit -1;
    }
    
    foreach my $key (keys %opts) {
      $options->{$key} = $opts{$key};
    }
  }
  
  my $runningUserVncservers = &runningUserVncservers($options);
  my @vncs = ();
  if (defined $options->{'displayNumber'}) {
    if ($options->{'displayNumber'} eq '*') {
      push @vncs, sort keys %{$runningUserVncservers};
    } else {
      push @vncs, $options->{'displayNumber'};
    }
  } elsif ($options->{'kill'} || $options->{'useold'}) {
    push @vncs, sort keys %{$runningUserVncservers};
    if ($#vncs >= 1) {
      print STDERR "$PROG: This is ambiguous. Multiple vncservers are running for this user!\n";
      &listXvncServer(\*STDERR, $options, $runningUserVncservers, \@vncs);
      exit 1;
    } elsif ($#vncs == -1) {
      print STDERR "$PROG: No vncserver running for this user!\n";
      exit 1;
    }
  } elsif ($options->{'list'}) {
    push @vncs, sort keys %{$runningUserVncservers};
  } else {
    # Find display number.
    push @vncs, &getDisplayNumber();
  }
  
  if ($options->{'kill'}) {
    my $err = &killXvncServer($options, $runningUserVncservers, \@vncs);
    exit($err ? 1 : 0);
  } elsif ($options->{'list'}) {
    &listXvncServer(\*STDOUT, $options, $runningUserVncservers, \@vncs);
    exit 0;
  } else {
    $options->{'displayNumber'} = $vncs[0];
    
    &checkGeometryAndDepth($options);
    
    if (!&checkDisplayNumberAvailable($options->{'displayNumber'}) &&
        (!$runningUserVncservers->{$options->{'displayNumber'}} ||
         !$options->{'useold'})) {
      print STDERR "A VNC server is already running as :$options->{'displayNumber'}\n";
      exit 1;
    }
    if ($runningUserVncservers->{$options->{'displayNumber'}}) {
      print "\nUsing old '$options->{'desktopName'}' desktop at $HOST:$options->{'displayNumber'}\n\n";
    } else {
      &startXvncServer( $options );
    }
  }
}

&main;
