blob: 7fe93bd18a4ce8bf9d61410533506840fd0dfa6b [file] [log] [blame]
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +00001#!/usr/bin/env perl
2#
DRCb9d8e762011-02-09 08:24:58 +00003# Copyright (C) 2009-2010 D. R. Commander. All Rights Reserved.
DRC190854c2009-03-26 18:13:00 +00004# Copyright (C) 2005-2006 Sun Microsystems, Inc. All Rights Reserved.
5# Copyright (C) 2002-2003 Constantin Kaplinsky. All Rights Reserved.
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +00006# Copyright (C) 2002-2005 RealVNC Ltd.
7# Copyright (C) 1999 AT&T Laboratories Cambridge. All Rights Reserved.
8#
9# This is free software; you can redistribute it and/or modify
10# it under the terms of the GNU General Public License as published by
11# the Free Software Foundation; either version 2 of the License, or
12# (at your option) any later version.
13#
14# This software is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17# GNU General Public License for more details.
18#
19# You should have received a copy of the GNU General Public License
20# along with this software; if not, write to the Free Software
21# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
22# USA.
23#
24
25#
26# vncserver - wrapper script to start an X VNC server.
27#
28
29#
30# First make sure we're operating in a sane environment.
31#
32
DRC190854c2009-03-26 18:13:00 +000033$exedir = "";
34$slashndx = rindex($0, "/");
35if($slashndx>=0) {
36 $exedir = substr($0, 0, $slashndx+1);
37}
38
39$vncClasses = "";
40
41$xauth = "xauth";
42
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +000043&SanityCheck();
44
45#
46# Global variables. You may want to configure some of these for your site.
47#
48
49$geometry = "1024x768";
DRC9d1c1572009-03-26 18:18:51 +000050#$depth = 16;
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +000051$vncJavaFiles = (((-d "/usr/share/vnc/classes") && "/usr/share/vnc/classes") ||
DRC190854c2009-03-26 18:13:00 +000052 ((-d "/usr/local/vnc/classes") && "/usr/local/vnc/classes") ||
53 ((-d "$vncClasses") && "$vncClasses"));
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +000054$vncUserDir = "$ENV{HOME}/.vnc";
55$xauthorityFile = "$ENV{XAUTHORITY}" || "$ENV{HOME}/.Xauthority";
56
57$defaultXStartup
58 = ("#!/bin/sh\n\n".
Adam Tkac804d86f2009-04-03 14:33:51 +000059 "vncconfig -iconic &\n".
DRC93248982009-03-26 18:14:38 +000060 "unset SESSION_MANAGER\n".
Adam Tkacc071e492009-05-20 09:01:24 +000061 "unset DBUS_SESSION_BUS_ADDRESS\n".
DRC93248982009-03-26 18:14:38 +000062 "OS=`uname -s`\n".
63 "if [ \$OS = 'Linux' ]; then\n".
64 " case \"\$WINDOWMANAGER\" in\n".
65 " \*gnome\*)\n".
66 " if [ -e /etc/SuSE-release ]; then\n".
67 " PATH=\$PATH:/opt/gnome/bin\n".
68 " export PATH\n".
69 " fi\n".
70 " ;;\n".
71 " esac\n".
72 "fi\n".
73 "if [ -x /etc/X11/xinit/xinitrc ]; then\n".
74 " exec /etc/X11/xinit/xinitrc\n".
75 "fi\n".
76 "if [ -f /etc/X11/xinit/xinitrc ]; then\n".
77 " exec sh /etc/X11/xinit/xinitrc\n".
78 "fi\n".
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +000079 "[ -r \$HOME/.Xresources ] && xrdb \$HOME/.Xresources\n".
80 "xsetroot -solid grey\n".
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +000081 "xterm -geometry 80x24+10+10 -ls -title \"\$VNCDESKTOP Desktop\" &\n".
82 "twm &\n");
83
84chop($host = `uname -n`);
85
DRC989dbd12009-04-22 13:23:17 +000086if (-d "/etc/X11/fontpath.d") {
87 $fontPath = "catalogue:/etc/X11/fontpath.d";
88}
DRC36546c12009-04-15 06:47:23 +000089
DRCd6821bf2009-03-26 18:17:49 +000090@fontpaths = ('/usr/share/X11/fonts', '/usr/share/fonts', '/usr/share/fonts/X11/');
91if (! -l "/usr/lib/X11") {push(@fontpaths, '/usr/lib/X11/fonts');}
92if (! -l "/usr/X11") {push(@fontpaths, '/usr/X11/lib/X11/fonts');}
93if (! -l "/usr/X11R6") {push(@fontpaths, '/usr/X11R6/lib/X11/fonts');}
94push(@fontpaths, '/usr/share/fonts/default');
95
96@fonttypes = ('misc',
97 '75dpi',
98 '100dpi',
99 'Speedo',
100 'Type1');
101
102foreach $_fpath (@fontpaths) {
103 foreach $_ftype (@fonttypes) {
104 if (-f "$_fpath/$_ftype/fonts.dir") {
105 if (! -l "$_fpath/$_ftype") {
DRC36546c12009-04-15 06:47:23 +0000106 $defFontPath .= "$_fpath/$_ftype,";
DRCd6821bf2009-03-26 18:17:49 +0000107 }
108 }
109 }
110}
DRCd28792b2010-01-11 20:53:00 +0000111
DRC36546c12009-04-15 06:47:23 +0000112if ($defFontPath) {
113 if (substr($defFontPath, -1, 1) == ',') {
114 chop $defFontPath;
DRCd6821bf2009-03-26 18:17:49 +0000115 }
116}
117
DRCd28792b2010-01-11 20:53:00 +0000118if ($fontPath eq "") {
119 $fontPath = $defFontPath;
120}
121
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000122# Check command line options
123
124&ParseOptions("-geometry",1,"-depth",1,"-pixelformat",1,"-name",1,"-kill",1,
DRC8fb11912011-03-03 10:42:14 +0000125 "-help",0,"-h",0,"--help",0,"-fp",1,"-list",0,"-fg",0);
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000126
127&Usage() if ($opt{'-help'} || $opt{'-h'} || $opt{'--help'});
128
129&Kill() if ($opt{'-kill'});
130
DRCb9d8e762011-02-09 08:24:58 +0000131&List() if ($opt{'-list'});
132
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000133# Uncomment this line if you want default geometry, depth and pixelformat
134# to match the current X display:
135# &GetXDisplayDefaults();
136
137if ($opt{'-geometry'}) {
138 $geometry = $opt{'-geometry'};
139}
140if ($opt{'-depth'}) {
141 $depth = $opt{'-depth'};
142 $pixelformat = "";
143}
144if ($opt{'-pixelformat'}) {
145 $pixelformat = $opt{'-pixelformat'};
146}
DRCeed5d1f2009-03-26 19:16:19 +0000147if ($opt{'-fp'}) {
148 $fontPath = $opt{'-fp'};
DRC36546c12009-04-15 06:47:23 +0000149 $fpArgSpecified = 1;
DRCeed5d1f2009-03-26 19:16:19 +0000150}
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000151
152&CheckGeometryAndDepth();
153
154
155# Create the user's vnc directory if necessary.
156
157if (!(-e $vncUserDir)) {
158 if (!mkdir($vncUserDir,0755)) {
159 die "$prog: Could not create $vncUserDir.\n";
160 }
161}
162
Adam Tkacf586b842011-04-27 11:20:18 +0000163# Check whether VNC authentication is enabled, and if so, prompt the user to
164# create a VNC password if they don't already have one.
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000165
Adam Tkacf586b842011-04-27 11:20:18 +0000166$securityTypeArgSpecified = 0;
167$vncAuthEnabled = 0;
168$passwordArgSpecified = 0;
169
170for ($i = 0; $i < @ARGV; ++$i) {
171 # -SecurityTypes can be followed by a space or "="
172 my @splitargs = split('=', $ARGV[$i]);
173 if (@splitargs <= 1 && $i < @ARGV - 1) {
174 push(@splitargs, $ARGV[$i + 1]);
175 }
176 if (lc(@splitargs[0]) eq "-securitytypes") {
177 if (@splitargs > 1) {
178 $securityTypeArgSpecified = 1;
179 }
180 foreach $arg2 (split(',', @splitargs[1])) {
181 if (lc($arg2) eq "vncauth" || lc($arg2) eq "tlsvnc"
182 || lc($arg2) eq "x509vnc") {
183 $vncAuthEnabled = 1;
184 }
185 }
186 }
187 if ((lc(@splitargs[0]) eq "-password")
188 || (lc(@splitargs[0]) eq "-passwordfile"
189 || (lc(@splitargs[0]) eq "-rfbauth"))) {
190 $passwordArgSpecified = 1;
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000191 }
192}
193
Adam Tkacf586b842011-04-27 11:20:18 +0000194if ((!$securityTypeArgSpecified || $vncAuthEnabled) && !$passwordArgSpecified) {
195 ($z,$z,$mode) = stat("$vncUserDir/passwd");
196 if (!(-e "$vncUserDir/passwd") || ($mode & 077)) {
197 warn "\nYou will require a password to access your desktops.\n\n";
198 system($exedir."vncpasswd -q $vncUserDir/passwd");
199 if (($? >> 8) != 0) {
200 exit 1;
201 }
202 }
203}
204
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000205# Find display number.
206
207if ((@ARGV > 0) && ($ARGV[0] =~ /^:(\d+)$/)) {
208 $displayNumber = $1;
209 shift(@ARGV);
210 if (!&CheckDisplayNumber($displayNumber)) {
211 die "A VNC server is already running as :$displayNumber\n";
212 }
Adam Tkac39c9d992010-07-21 14:08:38 +0000213} elsif ((@ARGV > 0) && ($ARGV[0] !~ /^-/) && ($ARGV[0] !~ /^\+/)) {
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000214 &Usage();
215} else {
216 $displayNumber = &GetDisplayNumber();
217}
218
219$vncPort = 5900 + $displayNumber;
220
221$desktopLog = "$vncUserDir/$host:$displayNumber.log";
222unlink($desktopLog);
223
Adam Tkac6cbd9d12009-11-12 10:39:54 +0000224# Make an X server cookie - use /dev/urandom on systems that have it,
225# otherwise use perl's random number generator, seeded with the sum
226# of the current time, our PID and part of the encrypted form of the password.
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000227
Adam Tkac6cbd9d12009-11-12 10:39:54 +0000228my $cookie = "";
229if (open(URANDOM, '<', '/dev/urandom')) {
230 my $randata;
231 if (sysread(URANDOM, $randata, 16) == 16) {
232 $cookie = unpack 'h*', $randata;
233 }
234 close(URANDOM);
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000235}
Adam Tkac6cbd9d12009-11-12 10:39:54 +0000236if ($cookie eq "") {
237 srand(time+$$+unpack("L",`cat $vncUserDir/passwd`));
238 for (1..16) {
239 $cookie .= sprintf("%02x", int(rand(256)) % 256);
240 }
241}
242
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000243system("xauth -f $xauthorityFile add $host:$displayNumber . $cookie");
244system("xauth -f $xauthorityFile add $host/unix:$displayNumber . $cookie");
245
246if ($opt{'-name'}) {
247 $desktopName = $opt{'-name'};
248} else {
249 $desktopName = "$host:$displayNumber ($ENV{USER})";
250}
251
252# Now start the X VNC Server
253
DRC190854c2009-03-26 18:13:00 +0000254$cmd = $exedir."Xvnc :$displayNumber";
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000255$cmd .= " -desktop " . &quotedString($desktopName);
256$cmd .= " -httpd $vncJavaFiles" if ($vncJavaFiles);
257$cmd .= " -auth $xauthorityFile";
258$cmd .= " -geometry $geometry" if ($geometry);
259$cmd .= " -depth $depth" if ($depth);
260$cmd .= " -pixelformat $pixelformat" if ($pixelformat);
261$cmd .= " -rfbwait 30000";
262$cmd .= " -rfbauth $vncUserDir/passwd";
263$cmd .= " -rfbport $vncPort";
DRCd6821bf2009-03-26 18:17:49 +0000264$cmd .= " -fp $fontPath" if ($fontPath);
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000265$cmd .= " -pn";
266
DRCd6821bf2009-03-26 18:17:49 +0000267# Add color database stuff here, e.g.:
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000268#
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000269# $cmd .= " -co /usr/lib/X11/rgb";
270#
271
272foreach $arg (@ARGV) {
273 $cmd .= " " . &quotedString($arg);
274}
275$cmd .= " >> " . &quotedString($desktopLog) . " 2>&1";
276
277# Run $cmd and record the process ID.
278
279$pidFile = "$vncUserDir/$host:$displayNumber.pid";
280system("$cmd & echo \$! >$pidFile");
281
282# Give Xvnc a chance to start up
283
284sleep(3);
DRCd28792b2010-01-11 20:53:00 +0000285if ($fontPath ne $defFontPath) {
286 unless (kill 0, `cat $pidFile`) {
287 if ($fpArgSpecified) {
288 warn "\nWARNING: The first attempt to start Xvnc failed, probably because the font\n";
289 warn "path you specified using the -fp argument is incorrect. Attempting to\n";
290 warn "determine an appropriate font path for this system and restart Xvnc using\n";
291 warn "that font path ...\n";
292 } else {
293 warn "\nWARNING: The first attempt to start Xvnc failed, possibly because the font\n";
294 warn "catalog is not properly configured. Attempting to determine an appropriate\n";
295 warn "font path for this system and restart Xvnc using that font path ...\n";
296 }
297 $cmd =~ s@-fp [^ ]+@@;
298 $cmd .= " -fp $defFontPath" if ($defFontPath);
299 system("$cmd & echo \$! >$pidFile");
300 sleep(3);
DRC36546c12009-04-15 06:47:23 +0000301 }
DRCd6821bf2009-03-26 18:17:49 +0000302}
303unless (kill 0, `cat $pidFile`) {
304 warn "Could not start Xvnc.\n\n";
305 open(LOG, "<$desktopLog");
306 while (<LOG>) { print; }
307 close(LOG);
308 die "\n";
309}
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000310
311warn "\nNew '$desktopName' desktop is $host:$displayNumber\n\n";
312
313# Create the user's xstartup script if necessary.
314
315if (!(-e "$vncUserDir/xstartup")) {
316 warn "Creating default startup script $vncUserDir/xstartup\n";
317 open(XSTARTUP, ">$vncUserDir/xstartup");
318 print XSTARTUP $defaultXStartup;
319 close(XSTARTUP);
320 chmod 0755, "$vncUserDir/xstartup";
321}
322
323# Run the X startup script.
324
325warn "Starting applications specified in $vncUserDir/xstartup\n";
326warn "Log file is $desktopLog\n\n";
327
328# If the unix domain socket exists then use that (DISPLAY=:n) otherwise use
329# TCP (DISPLAY=host:n)
330
331if (-e "/tmp/.X11-unix/X$displayNumber" ||
332 -e "/usr/spool/sockets/X11/$displayNumber")
333{
334 $ENV{DISPLAY}= ":$displayNumber";
335} else {
336 $ENV{DISPLAY}= "$host:$displayNumber";
337}
338$ENV{VNCDESKTOP}= $desktopName;
339
DRC8fb11912011-03-03 10:42:14 +0000340if ($opt{'-fg'}) {
Adam Tkacf586b842011-04-27 11:20:18 +0000341 close(STDIN);
342 system("($vncUserDir/xstartup; $0 -kill :$displayNumber) >> " . &quotedString($desktopLog) . " 2>&1");
DRC8fb11912011-03-03 10:42:14 +0000343} else {
Adam Tkacf586b842011-04-27 11:20:18 +0000344 system("$vncUserDir/xstartup >> " . &quotedString($desktopLog) . " 2>&1 &");
DRC8fb11912011-03-03 10:42:14 +0000345}
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000346
347exit;
348
349
350###############################################################################
351#
352# CheckGeometryAndDepth simply makes sure that the geometry and depth values
353# are sensible.
354#
355
356sub CheckGeometryAndDepth
357{
358 if ($geometry =~ /^(\d+)x(\d+)$/) {
359 $width = $1; $height = $2;
360
361 if (($width<1) || ($height<1)) {
362 die "$prog: geometry $geometry is invalid\n";
363 }
364
365 while (($width % 4)!=0) {
366 $width = $width + 1;
367 }
368
369 while (($height % 2)!=0) {
370 $height = $height + 1;
371 }
372
373 $geometry = "${width}x$height";
374 } else {
375 die "$prog: geometry $geometry is invalid\n";
376 }
377
DRCe5b4f752009-03-26 18:23:29 +0000378 if ($depth && (($depth < 8) || ($depth > 32))) {
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000379 die "Depth must be between 8 and 32\n";
380 }
381}
382
383
384#
385# GetDisplayNumber gets the lowest available display number. A display number
386# n is taken if something is listening on the VNC server port (5900+n) or the
387# X server port (6000+n).
388#
389
390sub GetDisplayNumber
391{
392 foreach $n (1..99) {
393 if (&CheckDisplayNumber($n)) {
394 return $n+0; # Bruce Mah's workaround for bug in perl 5.005_02
395 }
396 }
397
398 die "$prog: no free display number on $host.\n";
399}
400
401
402#
403# CheckDisplayNumber checks if the given display number is available. A
404# display number n is taken if something is listening on the VNC server port
405# (5900+n) or the X server port (6000+n).
406#
407
408sub CheckDisplayNumber
409{
410 local ($n) = @_;
411
412 socket(S, $AF_INET, $SOCK_STREAM, 0) || die "$prog: socket failed: $!\n";
413 eval 'setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1))';
414 if (!bind(S, pack('S n x12', $AF_INET, 6000 + $n))) {
415 close(S);
416 return 0;
417 }
418 close(S);
419
420 socket(S, $AF_INET, $SOCK_STREAM, 0) || die "$prog: socket failed: $!\n";
421 eval 'setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1))';
422 if (!bind(S, pack('S n x12', $AF_INET, 5900 + $n))) {
423 close(S);
424 return 0;
425 }
426 close(S);
427
428 if (-e "/tmp/.X$n-lock") {
429 warn "\nWarning: $host:$n is taken because of /tmp/.X$n-lock\n";
430 warn "Remove this file if there is no X server $host:$n\n";
431 return 0;
432 }
433
434 if (-e "/tmp/.X11-unix/X$n") {
435 warn "\nWarning: $host:$n is taken because of /tmp/.X11-unix/X$n\n";
436 warn "Remove this file if there is no X server $host:$n\n";
437 return 0;
438 }
439
440 if (-e "/usr/spool/sockets/X11/$n") {
441 warn("\nWarning: $host:$n is taken because of ".
442 "/usr/spool/sockets/X11/$n\n");
443 warn "Remove this file if there is no X server $host:$n\n";
444 return 0;
445 }
446
447 return 1;
448}
449
450
451#
452# GetXDisplayDefaults uses xdpyinfo to find out the geometry, depth and pixel
453# format of the current X display being used. If successful, it sets the
454# options as appropriate so that the X VNC server will use the same settings
455# (minus an allowance for window manager decorations on the geometry). Using
456# the same depth and pixel format means that the VNC server won't have to
457# translate pixels when the desktop is being viewed on this X display (for
458# TrueColor displays anyway).
459#
460
461sub GetXDisplayDefaults
462{
463 local (@lines, @matchlines, $width, $height, $defaultVisualId, $i,
464 $red, $green, $blue);
465
466 $wmDecorationWidth = 4; # a guess at typical size for window manager
467 $wmDecorationHeight = 24; # decoration size
468
469 return if (!defined($ENV{DISPLAY}));
470
471 @lines = `xdpyinfo 2>/dev/null`;
472
473 return if ($? != 0);
474
475 @matchlines = grep(/dimensions/, @lines);
476 if (@matchlines) {
477 ($width, $height) = ($matchlines[0] =~ /(\d+)x(\d+) pixels/);
478
479 $width -= $wmDecorationWidth;
480 $height -= $wmDecorationHeight;
481
482 $geometry = "${width}x$height";
483 }
484
485 @matchlines = grep(/default visual id/, @lines);
486 if (@matchlines) {
487 ($defaultVisualId) = ($matchlines[0] =~ /id:\s+(\S+)/);
488
489 for ($i = 0; $i < @lines; $i++) {
490 if ($lines[$i] =~ /^\s*visual id:\s+$defaultVisualId$/) {
491 if (($lines[$i+1] !~ /TrueColor/) ||
492 ($lines[$i+2] !~ /depth/) ||
493 ($lines[$i+4] !~ /red, green, blue masks/))
494 {
495 return;
496 }
497 last;
498 }
499 }
500
501 return if ($i >= @lines);
502
503 ($depth) = ($lines[$i+2] =~ /depth:\s+(\d+)/);
504 ($red,$green,$blue)
505 = ($lines[$i+4]
506 =~ /masks:\s+0x([0-9a-f]+), 0x([0-9a-f]+), 0x([0-9a-f]+)/);
507
508 $red = hex($red);
509 $green = hex($green);
510 $blue = hex($blue);
511
512 if ($red > $blue) {
513 $red = int(log($red) / log(2)) - int(log($green) / log(2));
514 $green = int(log($green) / log(2)) - int(log($blue) / log(2));
515 $blue = int(log($blue) / log(2)) + 1;
516 $pixelformat = "rgb$red$green$blue";
517 } else {
518 $blue = int(log($blue) / log(2)) - int(log($green) / log(2));
519 $green = int(log($green) / log(2)) - int(log($red) / log(2));
520 $red = int(log($red) / log(2)) + 1;
521 $pixelformat = "bgr$blue$green$red";
522 }
523 }
524}
525
526
527#
528# quotedString returns a string which yields the original string when parsed
529# by a shell.
530#
531
532sub quotedString
533{
534 local ($in) = @_;
535
536 $in =~ s/\'/\'\"\'\"\'/g;
537
538 return "'$in'";
539}
540
541
542#
543# removeSlashes turns slashes into underscores for use as a file name.
544#
545
546sub removeSlashes
547{
548 local ($in) = @_;
549
550 $in =~ s|/|_|g;
551
552 return "$in";
553}
554
555
556#
557# Usage
558#
559
560sub Usage
561{
562 die("\nusage: $prog [:<number>] [-name <desktop-name>] [-depth <depth>]\n".
563 " [-geometry <width>x<height>]\n".
564 " [-pixelformat rgbNNN|bgrNNN]\n".
DRCeed5d1f2009-03-26 19:16:19 +0000565 " [-fp <font-path>]\n".
DRC8fb11912011-03-03 10:42:14 +0000566 " [-fg]\n".
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000567 " <Xvnc-options>...\n\n".
DRCb9d8e762011-02-09 08:24:58 +0000568 " $prog -kill <X-display>\n\n".
569 " $prog -list\n\n");
570}
571
572
573#
574# List
575#
576
577sub List
578{
579 opendir(dir, $vncUserDir);
580 my @filelist = readdir(dir);
581 closedir(dir);
DRC075d9fa2011-02-10 04:19:46 +0000582 print "\nTigerVNC server sessions:\n\n";
DRCb9d8e762011-02-09 08:24:58 +0000583 print "X DISPLAY #\tPROCESS ID\n";
584 foreach my $file (@filelist) {
585 if ($file =~ /$host:(\d+)$\.pid/) {
586 print ":".$1."\t\t".`cat $vncUserDir/$file`;
587 }
588 }
589 exit 1;
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000590}
591
592
593#
594# Kill
595#
596
597sub Kill
598{
599 $opt{'-kill'} =~ s/(:\d+)\.\d+$/$1/; # e.g. turn :1.0 into :1
600
601 if ($opt{'-kill'} =~ /^:\d+$/) {
602 $pidFile = "$vncUserDir/$host$opt{'-kill'}.pid";
603 } else {
604 if ($opt{'-kill'} !~ /^$host:/) {
605 die "\nCan't tell if $opt{'-kill'} is on $host\n".
606 "Use -kill :<number> instead\n\n";
607 }
608 $pidFile = "$vncUserDir/$opt{'-kill'}.pid";
609 }
610
611 if (! -r $pidFile) {
612 die "\nCan't find file $pidFile\n".
613 "You'll have to kill the Xvnc process manually\n\n";
614 }
615
616 $SIG{'HUP'} = 'IGNORE';
617 chop($pid = `cat $pidFile`);
618 warn "Killing Xvnc process ID $pid\n";
DRCb9d8e762011-02-09 08:24:58 +0000619
620 if (kill 0, $pid) {
621 system("kill $pid");
622 sleep(1);
623 if (kill 0, $pid) {
624 print "Xvnc seems to be deadlocked. Kill the process manually and then re-run\n";
625 print " ".$0." -kill ".$opt{'-kill'}."\n";
626 print "to clean up the socket files.\n";
627 exit
628 }
629
630 } else {
631 warn "Xvnc process ID $pid already killed\n";
632 $opt{'-kill'} =~ s/://;
633
634 if (-e "/tmp/.X11-unix/X$opt{'-kill'}") {
635 print "Xvnc did not appear to shut down cleanly.";
636 print " Removing /tmp/.X11-unix/X$opt{'-kill'}\n";
637 unlink "/tmp/.X11-unix/X$opt{'-kill'}";
638 }
639 if (-e "/tmp/.X$opt{'-kill'}-lock") {
640 print "Xvnc did not appear to shut down cleanly.";
641 print " Removing /tmp/.X$opt{'-kill'}-lock\n";
642 unlink "/tmp/.X$opt{'-kill'}-lock";
643 }
644 }
645
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000646 unlink $pidFile;
647 exit;
648}
649
650
651#
652# ParseOptions takes a list of possible options and a boolean indicating
653# whether the option has a value following, and sets up an associative array
654# %opt of the values of the options given on the command line. It removes all
655# the arguments it uses from @ARGV and returns them in @optArgs.
656#
657
658sub ParseOptions
659{
660 local (@optval) = @_;
661 local ($opt, @opts, %valFollows, @newargs);
662
663 while (@optval) {
664 $opt = shift(@optval);
665 push(@opts,$opt);
666 $valFollows{$opt} = shift(@optval);
667 }
668
669 @optArgs = ();
670 %opt = ();
671
672 arg: while (defined($arg = shift(@ARGV))) {
673 foreach $opt (@opts) {
674 if ($arg eq $opt) {
675 push(@optArgs, $arg);
676 if ($valFollows{$opt}) {
677 if (@ARGV == 0) {
678 &Usage();
679 }
680 $opt{$opt} = shift(@ARGV);
681 push(@optArgs, $opt{$opt});
682 } else {
683 $opt{$opt} = 1;
684 }
685 next arg;
686 }
687 }
688 push(@newargs,$arg);
689 }
690
691 @ARGV = @newargs;
692}
693
694
695#
696# Routine to make sure we're operating in a sane environment.
697#
698
699sub SanityCheck
700{
701 local ($cmd);
702
703 #
704 # Get the program name
705 #
706
707 ($prog) = ($0 =~ m|([^/]+)$|);
708
709 #
710 # Check we have all the commands we'll need on the path.
711 #
712
713 cmd:
DRC190854c2009-03-26 18:13:00 +0000714 foreach $cmd ("uname") {
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000715 for (split(/:/,$ENV{PATH})) {
716 if (-x "$_/$cmd") {
717 next cmd;
718 }
719 }
720 die "$prog: couldn't find \"$cmd\" on your PATH.\n";
721 }
DRC190854c2009-03-26 18:13:00 +0000722 if (-x "/usr/X11R6/bin/xauth") {
723 $xauth = "/usr/X11R6/bin/xauth";
724 }
725 else {
726 cmd1:
727 foreach $cmd ("xauth") {
728 for (split(/:/,$ENV{PATH})) {
729 if (-x "$_/$cmd") {
730 next cmd1;
731 }
732 }
733 die "$prog: couldn't find \"$cmd\" on your PATH.\n";
734 }
735 }
736
737 if($exedir eq "") {
738 cmd2:
739 foreach $cmd ("Xvnc","vncpasswd") {
740 for (split(/:/,$ENV{PATH})) {
741 if (-x "$_/$cmd") {
742 $vncClasses = "$_/../vnc/classes";
743 next cmd2;
744 }
745 }
746 die "$prog: couldn't find \"$cmd\" on your PATH.\n";
747 }
748 }
749 else {
750 cmd3:
751 foreach $cmd ($exedir."Xvnc",$exedir."vncpasswd") {
752 for (split(/:/,$ENV{PATH})) {
753 if (-x "$cmd") {
754 $vncClasses = $exedir."../vnc/classes";
755 next cmd3;
756 }
757 }
758 die "$prog: couldn't find \"$cmd\".\n";
759 }
760 }
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000761
762 #
763 # Check the HOME environment variable is set
764 #
765
766 if (!defined($ENV{HOME})) {
767 die "$prog: The HOME environment variable is not set.\n";
768 }
DRC190854c2009-03-26 18:13:00 +0000769# chdir($ENV{HOME});
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000770
771 #
772 # Find socket constants. 'use Socket' is a perl5-ism, so we wrap it in an
773 # eval, and if it fails we try 'require "sys/socket.ph"'. If this fails,
774 # we just guess at the values. If you find perl moaning here, just
775 # hard-code the values of AF_INET and SOCK_STREAM. You can find these out
776 # for your platform by looking in /usr/include/sys/socket.h and related
777 # files.
778 #
779
780 chop($os = `uname`);
781 chop($osrev = `uname -r`);
782
783 eval 'use Socket';
784 if ($@) {
785 eval 'require "sys/socket.ph"';
786 if ($@) {
787 if (($os eq "SunOS") && ($osrev !~ /^4/)) {
788 $AF_INET = 2;
789 $SOCK_STREAM = 2;
790 } else {
791 $AF_INET = 2;
792 $SOCK_STREAM = 1;
793 }
794 } else {
795 $AF_INET = &AF_INET;
796 $SOCK_STREAM = &SOCK_STREAM;
797 }
798 } else {
799 $AF_INET = &AF_INET;
800 $SOCK_STREAM = &SOCK_STREAM;
Constantin Kaplinskyb30ae7f2006-05-25 05:04:46 +0000801 }
802}