1#!/usr/local/bin/perl
2#
3#  Copyright (C) 2002-2009 Constantin Kaplinsky.  All Rights Reserved.
4#  Copyright (C) 1999 AT&T Laboratories Cambridge.  All Rights Reserved.
5#
6#  This is free software; you can redistribute it and/or modify
7#  it under the terms of the GNU General Public License as published by
8#  the Free Software Foundation; either version 2 of the License, or
9#  (at your option) any later version.
10#
11#  This software is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#
16#  You should have received a copy of the GNU General Public License
17#  along with this software; if not, write to the Free Software
18#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307,
19#  USA.
20#
21
22#
23# vncserver - wrapper script to start an X VNC server.
24#
25
26# First make sure we're operating in a sane environment.
27
28&SanityCheck();
29
30# Default configuration of the TightVNC Server:
31
32$geometry = "1024x768";
33$depth = 24;
34$desktopName = "X";
35$vncClasses = "/usr/local/share/tightvnc/classes";
36$vncUserDir = "$ENV{HOME}/.vnc";
37#$fontPath = "unix/:7100";
38$authType = "-rfbauth $vncUserDir/passwd";
39
40# Read configuration from the system-wide and user files if present.
41
42$configFile = "/etc/tightvncserver.conf";
43ReadConfiguration();
44$configFile = "$ENV{HOME}/.vnc/tightvncserver.conf";
45ReadConfiguration();
46
47# Done reading configuration.
48
49$defaultXStartup
50    = ("#!/bin/sh\n\n".
51       "xrdb \$HOME/.Xresources\n".
52       "xsetroot -solid grey\n".
53       "xterm -geometry 80x24+10+10 -ls -title \"\$VNCDESKTOP Desktop\" &\n".
54       "twm &\n");
55
56$xauthorityFile = "$ENV{XAUTHORITY}";
57
58$vncUserDirUnderTmp = ($vncUserDir =~ m|^/tmp/.+|) ? 1 : 0;
59$xstartup = ($vncUserDirUnderTmp) ?
60  "$ENV{HOME}/.vncstartup" : "$vncUserDir/xstartup";
61unless ($xauthorityFile) {
62    if ($vncUserDirUnderTmp) {
63        $xauthorityFile = "$vncUserDir/.Xauthority";
64    } else {
65        $xauthorityFile = "$ENV{HOME}/.Xauthority";
66    }
67}
68
69chop($host = `uname -n`);
70
71
72# Check command line options
73
74&ParseOptions("-geometry",1,"-depth",1,"-pixelformat",1,"-name",1,"-kill",1,
75	      "-help",0,"-h",0,"--help",0);
76
77&Usage() if ($opt{'-help'} || $opt{'-h'} || $opt{'--help'});
78
79&Kill() if ($opt{'-kill'});
80
81# Uncomment this line if you want default geometry, depth and pixelformat
82# to match the current X display:
83# &GetXDisplayDefaults();
84
85if ($opt{'-geometry'}) {
86    $geometry = $opt{'-geometry'};
87}
88if ($opt{'-depth'}) {
89    $depth = $opt{'-depth'};
90    $pixelformat = "";
91}
92if ($opt{'-pixelformat'}) {
93    $pixelformat = $opt{'-pixelformat'};
94}
95
96&CheckGeometryAndDepth();
97
98if ($opt{'-name'}) {
99    $desktopName = $opt{'-name'};
100}
101
102# Create the user's vnc directory if necessary.
103
104unless (-e $vncUserDir) {
105    unless (mkdir($vncUserDir, 0700)) {
106        die "$prog: Could not create $vncUserDir.\n";
107    }
108}
109($z,$z,$mode) = lstat("$vncUserDir");
110if (!-d _ || !-o _ || ($vncUserDirUnderTmp && ($mode & 0777) != 0700)) {
111    die "$prog: Wrong type or access mode of $vncUserDir.\n";
112}
113
114# Make sure the user has a password.
115
116($z,$z,$mode) = lstat("$vncUserDir/passwd");
117if (-e _ && (!-f _ || !-o _)) {
118    die "$prog: Wrong type or ownership on $vncUserDir/passwd.\n";
119}
120if (!-e _ || ($mode & 077) != 0) {
121    warn "\nYou will require a password to access your desktops.\n\n";
122    system("vncpasswd $vncUserDir/passwd");
123    if (($? & 0xFF00) != 0) {
124        exit 1;
125    }
126}
127
128# Find display number.
129
130if ((@ARGV > 0) && ($ARGV[0] =~ /^:(\d+)$/)) {
131    $displayNumber = $1;
132    shift(@ARGV);
133    unless (&CheckDisplayNumber($displayNumber)) {
134	die "A VNC server is already running as :$displayNumber\n";
135    }
136} elsif ((@ARGV > 0) && ($ARGV[0] !~ /^-/)) {
137    &Usage();
138} else {
139    $displayNumber = &GetDisplayNumber();
140}
141
142$vncPort = 5900 + $displayNumber;
143
144$desktopLog = "$vncUserDir/$host:$displayNumber.log";
145unlink($desktopLog);
146
147# Make an X server cookie - use as the seed the sum of the current time, our
148# PID and part of the encrypted form of the password.  Ideally we'd use
149# /dev/urandom, but that's only available on Linux.
150
151srand(time+$$+unpack("L",`cat $vncUserDir/passwd`));
152$cookie = "";
153for (1..16) {
154    $cookie .= sprintf("%02x", int(rand(256)));
155}
156
157system("xauth -f $xauthorityFile add $host:$displayNumber . $cookie");
158system("xauth -f $xauthorityFile add $host/unix:$displayNumber . $cookie");
159
160# Now start the X VNC Server
161
162$cmd = "Xvnc :$displayNumber";
163$cmd .= " -desktop " . &quotedString($desktopName);
164$cmd .= " -httpd $vncClasses";
165$cmd .= " -auth $xauthorityFile";
166$cmd .= " -geometry $geometry" if ($geometry);
167$cmd .= " -depth $depth" if ($depth);
168$cmd .= " -pixelformat $pixelformat" if ($pixelformat);
169$cmd .= " -rfbwait 120000";
170$cmd .= " $authType";
171$cmd .= " -rfbport $vncPort";
172$cmd .= " -fp $fontPath" if ($fontPath);
173$cmd .= " -co $colorPath" if ($colorPath);
174
175foreach $arg (@ARGV) {
176    $cmd .= " " . &quotedString($arg);
177}
178$cmd .= " >> " . &quotedString($desktopLog) . " 2>&1";
179
180# Run $cmd and record the process ID.
181
182$pidFile = "$vncUserDir/$host:$displayNumber.pid";
183system("$cmd & echo \$! >$pidFile");
184
185# Give Xvnc a chance to start up
186
187sleep(1);
188unless (kill 0, `cat $pidFile`) {
189    warn "Couldn't start Xvnc; trying default font path.\n";
190    warn "Please set correct fontPath in the $prog script.\n";
191    $cmd =~ s@-fp [^ ]+@@;
192    system("$cmd & echo \$! >$pidFile");
193    sleep(1);
194}
195unless (kill 0, `cat $pidFile`) {
196    warn "Couldn't start Xvnc process.\n\n";
197    open(LOG, "<$desktopLog");
198    while (<LOG>) { print; }
199    close(LOG);
200    die "\n";
201}
202
203warn "\nNew '$desktopName' desktop is $host:$displayNumber\n\n";
204
205# Create the user's xstartup script if necessary.
206
207unless (-e "$xstartup") {
208    warn "Creating default startup script $xstartup\n";
209    open(XSTARTUP, ">$xstartup");
210    print XSTARTUP $defaultXStartup;
211    close(XSTARTUP);
212    chmod 0755, "$xstartup";
213}
214
215# Run the X startup script.
216
217warn "Starting applications specified in $xstartup\n";
218warn "Log file is $desktopLog\n\n";
219
220# If the unix domain socket exists then use that (DISPLAY=:n) otherwise use
221# TCP (DISPLAY=host:n)
222
223if (-e "/tmp/.X11-unix/X$displayNumber") {
224    $ENV{DISPLAY}= ":$displayNumber";
225} else {
226    $ENV{DISPLAY}= "$host:$displayNumber";
227}
228$ENV{VNCDESKTOP}= $desktopName;
229
230system("$xstartup >> " . &quotedString($desktopLog) . " 2>&1 &");
231
232exit;
233
234
235###############################################################################
236#
237# CheckGeometryAndDepth simply makes sure that the geometry and depth values
238# are sensible.
239#
240
241sub CheckGeometryAndDepth
242{
243    if ($geometry =~ /^(\d+)x(\d+)$/) {
244	$width = $1; $height = $2;
245
246	if (($width<1) || ($height<1)) {
247	    die "$prog: geometry $geometry is invalid\n";
248	}
249
250	while (($width % 4)!=0) {
251	    $width = $width + 1;
252	}
253
254	while (($height % 2)!=0) {
255	    $height = $height + 1;
256	}
257
258	$geometry = "${width}x$height";
259    } else {
260	die "$prog: geometry $geometry is invalid\n";
261    }
262
263    if (($depth < 8) || ($depth > 32)) {
264	die "Depth must be between 8 and 32\n";
265    }
266}
267
268
269#
270# GetDisplayNumber gets the lowest available display number.  A display number
271# n is taken if something is listening on the VNC server port (5900+n) or the
272# X server port (6000+n).
273#
274
275sub GetDisplayNumber
276{
277    foreach $n (1..99) {
278	if (&CheckDisplayNumber($n)) {
279	    return $n+0; # Bruce Mah's workaround for bug in perl 5.005_02
280	}
281    }
282
283    die "$prog: no free display number on $host.\n";
284}
285
286
287#
288# CheckDisplayNumber checks if the given display number is available.  A
289# display number n is taken if something is listening on the VNC server port
290# (5900+n) or the X server port (6000+n).
291#
292
293sub CheckDisplayNumber
294{
295    local ($n) = @_;
296
297    socket(S, $AF_INET, $SOCK_STREAM, 0) || die "$prog: socket failed: $!\n";
298    eval 'setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1))';
299    unless (bind(S, pack('S n x12', $AF_INET, 6000 + $n))) {
300	close(S);
301	return 0;
302    }
303    close(S);
304
305    socket(S, $AF_INET, $SOCK_STREAM, 0) || die "$prog: socket failed: $!\n";
306    eval 'setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1))';
307    unless (bind(S, pack('S n x12', $AF_INET, 5900 + $n))) {
308	close(S);
309	return 0;
310    }
311    close(S);
312
313    if (-e "/tmp/.X$n-lock") {
314	warn "\nWarning: $host:$n is taken because of /tmp/.X$n-lock\n";
315	warn "Remove this file if there is no X server $host:$n\n";
316	return 0;
317    }
318
319    if (-e "/tmp/.X11-unix/X$n") {
320	warn "\nWarning: $host:$n is taken because of /tmp/.X11-unix/X$n\n";
321	warn "Remove this file if there is no X server $host:$n\n";
322	return 0;
323    }
324
325    return 1;
326}
327
328
329#
330# GetXDisplayDefaults uses xdpyinfo to find out the geometry, depth and pixel
331# format of the current X display being used.  If successful, it sets the
332# options as appropriate so that the X VNC server will use the same settings
333# (minus an allowance for window manager decorations on the geometry).  Using
334# the same depth and pixel format means that the VNC server won't have to
335# translate pixels when the desktop is being viewed on this X display (for
336# TrueColor displays anyway).
337#
338
339sub GetXDisplayDefaults
340{
341    local (@lines, @matchlines, $width, $height, $defaultVisualId, $i,
342	   $red, $green, $blue);
343
344    $wmDecorationWidth = 4;	# a guess at typical size for window manager
345    $wmDecorationHeight = 24;	# decoration size
346
347    return unless (defined($ENV{DISPLAY}));
348
349    @lines = `xdpyinfo 2>/dev/null`;
350
351    return if ($? != 0);
352
353    @matchlines = grep(/dimensions/, @lines);
354    if (@matchlines) {
355	($width, $height) = ($matchlines[0] =~ /(\d+)x(\d+) pixels/);
356
357	$width -= $wmDecorationWidth;
358	$height -= $wmDecorationHeight;
359
360	$geometry = "${width}x$height";
361    }
362
363    @matchlines = grep(/default visual id/, @lines);
364    if (@matchlines) {
365	($defaultVisualId) = ($matchlines[0] =~ /id:\s+(\S+)/);
366
367	for ($i = 0; $i < @lines; $i++) {
368	    if ($lines[$i] =~ /^\s*visual id:\s+$defaultVisualId$/) {
369		if (($lines[$i+1] !~ /TrueColor/) ||
370		    ($lines[$i+2] !~ /depth/) ||
371		    ($lines[$i+4] !~ /red, green, blue masks/))
372		{
373		    return;
374		}
375		last;
376	    }
377	}
378
379	return if ($i >= @lines);
380
381	($depth) = ($lines[$i+2] =~ /depth:\s+(\d+)/);
382	($red,$green,$blue)
383	    = ($lines[$i+4]
384	       =~ /masks:\s+0x([0-9a-f]+), 0x([0-9a-f]+), 0x([0-9a-f]+)/);
385
386	$red = hex($red);
387	$green = hex($green);
388	$blue = hex($blue);
389
390	if ($red > $blue) {
391	    $red = int(log($red) / log(2)) - int(log($green) / log(2));
392	    $green = int(log($green) / log(2)) - int(log($blue) / log(2));
393	    $blue = int(log($blue) / log(2)) + 1;
394	    $pixelformat = "rgb$red$green$blue";
395	} else {
396	    $blue = int(log($blue) / log(2)) - int(log($green) / log(2));
397	    $green = int(log($green) / log(2)) - int(log($red) / log(2));
398	    $red = int(log($red) / log(2)) + 1;
399	    $pixelformat = "bgr$blue$green$red";
400	}
401    }
402}
403
404
405#
406# quotedString returns a string which yields the original string when parsed
407# by a shell.
408#
409
410sub quotedString
411{
412    local ($in) = @_;
413
414    $in =~ s/\'/\'\"\'\"\'/g;
415
416    return "'$in'";
417}
418
419
420#
421# removeSlashes turns slashes into underscores for use as a file name.
422#
423
424sub removeSlashes
425{
426    local ($in) = @_;
427
428    $in =~ s|/|_|g;
429
430    return "$in";
431}
432
433
434#
435# Usage
436#
437
438sub Usage
439{
440    die("TightVNC Server version 1.3.10\n".
441	"\n".
442	"Usage: $prog [<OPTIONS>] [:<DISPLAY#>]\n".
443	"       $prog -kill :<DISPLAY#>\n".
444	"\n".
445	"<OPTIONS> are Xvnc options, or:\n".
446	"\n".
447	"        -name <DESKTOP-NAME>\n".
448	"        -depth <DEPTH>\n".
449	"        -geometry <WIDTH>x<HEIGHT>\n".
450	"        -pixelformat rgb<NNN>\n".
451	"        -pixelformat bgr<NNN>\n".
452	"\n".
453	"See vncserver and Xvnc manual pages for more information.\n");
454}
455
456
457#
458# Kill
459#
460
461sub Kill
462{
463    $opt{'-kill'} =~ s/(:\d+)\.\d+$/$1/; # e.g. turn :1.0 into :1
464
465    if ($opt{'-kill'} =~ /^:\d+$/) {
466	$pidFile = "$vncUserDir/$host$opt{'-kill'}.pid";
467    } else {
468	if ($opt{'-kill'} !~ /^$host:/) {
469	    die "\nCan't tell if $opt{'-kill'} is on $host\n".
470		"Use -kill :<number> instead\n\n";
471	}
472	$pidFile = "$vncUserDir/$opt{'-kill'}.pid";
473    }
474
475    unless (-r $pidFile) {
476	die "\nCan't find file $pidFile\n".
477	    "You'll have to kill the Xvnc process manually\n\n";
478    }
479
480    $SIG{'HUP'} = 'IGNORE';
481    chop($pid = `cat $pidFile`);
482    warn "Killing Xvnc process ID $pid\n";
483    system("kill $pid");
484    unlink $pidFile;
485    exit;
486}
487
488
489#
490# ParseOptions takes a list of possible options and a boolean indicating
491# whether the option has a value following, and sets up an associative array
492# %opt of the values of the options given on the command line. It removes all
493# the arguments it uses from @ARGV and returns them in @optArgs.
494#
495
496sub ParseOptions
497{
498    local (@optval) = @_;
499    local ($opt, @opts, %valFollows, @newargs);
500
501    while (@optval) {
502	$opt = shift(@optval);
503	push(@opts,$opt);
504	$valFollows{$opt} = shift(@optval);
505    }
506
507    @optArgs = ();
508    %opt = ();
509
510    arg: while (defined($arg = shift(@ARGV))) {
511	foreach $opt (@opts) {
512	    if ($arg eq $opt) {
513		push(@optArgs, $arg);
514		if ($valFollows{$opt}) {
515		    if (@ARGV == 0) {
516			&Usage();
517		    }
518		    $opt{$opt} = shift(@ARGV);
519		    push(@optArgs, $opt{$opt});
520		} else {
521		    $opt{$opt} = 1;
522		}
523		next arg;
524	    }
525	}
526	push(@newargs,$arg);
527    }
528
529    @ARGV = @newargs;
530}
531
532
533#
534# Routine to make sure we're operating in a sane environment.
535#
536
537sub SanityCheck
538{
539    local ($cmd);
540
541    #
542    # Get the program name
543    #
544
545    ($prog) = ($0 =~ m|([^/]+)$|);
546
547    #
548    # Check we have all the commands we'll need on the path.
549    #
550
551 cmd:
552    foreach $cmd ("uname","xauth","Xvnc","vncpasswd") {
553	for (split(/:/,$ENV{PATH})) {
554	    if (-x "$_/$cmd") {
555		next cmd;
556	    }
557	}
558	die "$prog: couldn't find \"$cmd\" on your PATH.\n";
559    }
560
561    #
562    # Check the HOME and USER environment variables are both set.
563    #
564
565    unless (defined($ENV{HOME})) {
566	die "$prog: The HOME environment variable is not set.\n";
567    }
568    unless (defined($ENV{USER})) {
569	die "$prog: The USER environment variable is not set.\n";
570    }
571
572    #
573    # Find socket constants. 'use Socket' is a perl5-ism, so we wrap it in an
574    # eval, and if it fails we try 'require "sys/socket.ph"'.  If this fails,
575    # we just guess at the values.  If you find perl moaning here, just
576    # hard-code the values of AF_INET and SOCK_STREAM.  You can find these out
577    # for your platform by looking in /usr/include/sys/socket.h and related
578    # files.
579    #
580
581    chop($os = `uname`);
582    chop($osrev = `uname -r`);
583
584    eval 'use Socket';
585    if ($@) {
586	eval 'require "sys/socket.ph"';
587	if ($@) {
588	    if (($os eq "SunOS") && ($osrev !~ /^4/)) {
589		$AF_INET = 2;
590		$SOCK_STREAM = 2;
591	    } else {
592		$AF_INET = 2;
593		$SOCK_STREAM = 1;
594	    }
595	} else {
596	    $AF_INET = &AF_INET;
597	    $SOCK_STREAM = &SOCK_STREAM;
598	}
599    } else {
600	$AF_INET = &AF_INET;
601	$SOCK_STREAM = &SOCK_STREAM;
602    }
603}
604
605sub ReadConfiguration
606{
607  my @configurableVariables =
608    qw(geometry
609       depth
610       desktopName
611       vncClasses
612       vncUserDir
613       fontPath
614       authType
615       colorPath
616      );
617
618  if (open CONF, "<$configFile") {
619    while (<CONF>) {
620      if (/^\s*\$(\w+)\s*=\s*(.*)$/) {
621        for my $var (@configurableVariables) {
622          if ($1 eq $var) {
623            eval $_;
624            last;
625          }
626        }
627      }
628    }
629    close CONF;
630  }
631}
632