#!/usr/bin/perl
#
# Copyright (C) 1993-1996 Olivetti Research Limited, Cambridge, England.
#
# THERE IS NO WARRANTY FOR THIS SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE
# LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
# OTHER PARTIES PROVIDE THIS SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND,
# EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  NO
# GUARANTEE IS MADE THAT THIS SOFTWARE IS FREE OF SOFTWARE VIRUSES.  THE ENTIRE
# RISK AS TO THE QUALITY AND PERFORMANCE OF THIS SOFTWARE IS WITH YOU.  SHOULD
# THIS SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY
# SERVICING, REPAIR OR CORRECTION.
#
# IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL
# ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE
# THIS SOFTWARE AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
# GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE
# OR INABILITY TO USE THIS SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA
# OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES
# OR A FAILURE OF THIS SOFTWARE TO OPERATE WITH ANY OTHER SYSTEMS), EVEN IF
# SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
# DAMAGES.
#
#
# teleport - perl script for controlling the teleporting system.
#
# T J Richardson
#

###############################################################################
#
# THINGS YOU MAY WANT TO CONFIGURE:
#

#
# If "domainname" doesn't return the internet domain name, you could specify
# it here (otherwise IP addresses may be used instead of names).
#
# $DOMAIN_NAME = "...";
#

#
# Get constants needed for TCP sockets. If sys/socket.ph doesn't exist then
# we use some hard-coded values. Note that these hard-coded values are
# not valid for all architectures (e.g. Solaris 2.x).
#

eval 'require "sys/socket.ph"';
if ($@) {			# couldn't find sys/socket.ph
    $AF_INET = 2;
    $SOCK_STREAM = 1;
} else {
    $AF_INET = &AF_INET;
    $SOCK_STREAM = &SOCK_STREAM;
}

#
# Specify the directories to search for commands.  You can add directories here
# to make it work even for people with broken paths.
#

@commandSearchPath = (split(/:/,$ENV{PATH}),"/bin","/usr/bin","/usr/ucb",
		      "/usr/local/bin","/usr/local/X11R5/bin","/usr/bin/X11");

#
# Files associated with the user's session ($infoFile must correspond with
# value in tpwatch).
#

$infoFile = "$ENV{HOME}/.tpinfo";
$proxyLogFile = "$ENV{HOME}/.tpproxylog";
$watchLogFile = "$ENV{HOME}/.tpwatchlog";
$sessionFile = "$ENV{HOME}/.tpsession";

#
# Timeouts (in seconds) waiting for tpwatch to start up, and waiting to get a
# response from tpwatch.
#

$tpwatchStartUpTimeout = 30;
$tpwatchTimeout = 20;


###############################################################################


#
# Check for certain essential commands.  If a command isn't found then a
# warning is printed and the script may fail when it attempts to execute the
# command.
#

$hostnameBin = &FindCommand("hostname",@commandSearchPath);
if (!defined($DOMAIN_NAME)) {
    $domainnameBin = &FindCommand("domainname",@commandSearchPath);
}
$xauthBin = &FindCommand("xauth",@commandSearchPath);
$sttyBin = &FindCommand("stty",@commandSearchPath);
$catBin = &FindCommand("cat",@commandSearchPath);


#
# Parse command line options into the %opt associative array.
#

&ParseOptions("-help",0,"-away",0,"-kill",0,"-start",0,"-rematerialise",0,
	      "-wait",0,"-reset",0,"-auth",0,"-display",1,"-geometry",1,
	      "-command",1,"-helpuserid",1);

#
# Fully qualify (i.e. expand to full host name) the DISPLAY environment
# variable and/or "-display" argument.
#

$physicalDisplay = &GetFullyQualifiedPhysicalDisplay();

#
# If we have an argument (other than options) then it specifies a different
# userid (and possibly a host name).
#

if (@ARGV == 1) {
    &TeleportUserId($ARGV[0]);
} elsif (@ARGV > 1) {
    &Usage();
}

#
# If we have a -auth option then we will get a magic cookie for the physical
# display on standard input (we have been invoked remotely).
#

if ($opt{'-auth'}) {
    system("$xauthBin merge -");
}

#
# See if information about the teleport session exists and if so try
# connecting to the tpwatch process.
#

($tpSessionInfoExists,$tpHost,$tpPort,$tpDisplay) = &GetTpSessionInfo();

if ($tpSessionInfoExists) {
    ($tpSessionAppearsToExist,$tpSessionResponding,$tpSessionControllable)
	= &ConnectToTpwatch(SOCKET,$tpHost,$tpPort,$tpDisplay);
}

#
# If we have a -help option, print out help information.
#

if ($opt{'-help'}) {
    &Help(SOCKET,$tpSessionInfoExists,$tpSessionAppearsToExist,
	  $tpSessionResponding,$tpSessionControllable,$tpDisplay,$tpHost);
    exit;
}


if ($tpSessionControllable) {

    #
    # We can control the teleport session. See which option was specified.
    #

    if ($opt{'-kill'}) {
	&KillTeleportSession(SOCKET);
    }
    elsif ($opt{'-reset'}) {
	&ResetTeleportSession(SOCKET);
    }
    elsif ($opt{'-away'}) {
	&MaterialiseTeleportSession(SOCKET,"",0);
    }
    elsif ($opt{'-command'}) {
	&ProxyCommand(SOCKET);
    }
    elsif ($opt{'-start'}) {
	die "teleport: You already have a teleport session\n";
    }
    elsif ($opt{'-rematerialise'}) {
	&RematerialiseTeleportSession(SOCKET);
    }
    elsif (!$physicalDisplay) {
	die("teleport: The DISPLAY environment variable is not set and you did not\n".
	    "specify a display. This is probably because you have used 'rlogin'. Try\n".
	    "using 'teleport' in another xterm window or give a -display option.\n");
    }
    else {
	if (&SameDisplay($physicalDisplay,$tpDisplay) && !$opt{'-display'}) {
	    &MaterialiseTeleportSession(SOCKET,"",0);
	} else {
	    &MaterialiseTeleportSession(SOCKET,$physicalDisplay,$opt{'-wait'});
	}
    }
}
else {

    #
    # Either there is no existing teleport session, or we cannot control it.
    #

    if ($tpSessionAppearsToExist) {
	if ($tpSessionResponding) {
	    die("teleport: You have a teleport session (display $tpDisplay) but\n".
		"you do not have permission to control it from this machine.\n".
		"Try using 'teleport $ENV{USER}@$tpHost ...' instead.\n");
	} else {
	    die("teleport: You appear to have a teleport session (display $tpDisplay)\n".
		"but it is not responding.\n");
	}
    }

    if ($tpSessionInfoExists) {
	if ($opt{'-kill'}) {
	    &KillTeleportSession();
	    die "teleport: Your old teleport session died - cleaned up\n";
	} elsif (!$opt{'-start'}) {
	    die("teleport: Your old teleport session has died.\n".
		"Use 'teleport -start' to start a new session\n");
	}
    }

    if ($opt{'-kill'} || $opt{'-reset'} || $opt{'-away'} || $opt{'-command'}) {
	die "teleport: You have no teleport session running.\n";
    }

    &StartTeleportSession($physicalDisplay,$opt{'-wait'});
}
exit;


###############################################################################
#
# SUBROUTINES
#

#
# GetTpSessionInfo extracts information from the user's ".tpinfo" file.
#

sub GetTpSessionInfo
{
    local ($host,$port,$display,$pid);

    if (open(INFOFILE,$infoFile)) {
	$_ = <INFOFILE>;
	($display, $host, $port) = /^(\S+) (\S+) (\S+)/;
	close(INFOFILE);
	$display = &FullyQualifyDisplayName($display);
	(1,$host,$port,$display);
    } else {
	if (-e $infoFile) {
	    die "teleport: cannot read $infoFile\n";
	}
	(0);
    }
}


#
# ConnectToTpwatch tries to connect to the tpwatch process. Returns three
# booleans to say whether the session appears to exist at all, whether it
# responds and whether it is controllable by us.
#

sub ConnectToTpwatch
{
    local ($fh,$host,$port,$tpDisplay) = @_;
    local ($sockaddr,$ipaddr,$proto,$z,$fds,$n,$buf,$cookie);

    #
    # Get the magic cookie for the proxy server - tpwatch uses it as its
    # authorisation mechanism on connections from the teleport command.
    #

    if (open(COOKIE,"$xauthBin list $tpDisplay|")) {
	chop($_ = <COOKIE>);
	($cookie) = /(\S+)$/;
	close(COOKIE);
    } else {
	die "teleport: couldn't get cookie for $tpDisplay\n";
    }

    if ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
	$ipaddr = pack("C4",$1,$2,$3,$4);
    } else {
	($z, $z, $z, $z, $ipaddr) = gethostbyname($host);
	die "teleport: gethostbyname($host) failed\n" unless ($ipaddr);
    }

    ($z, $z, $proto) = getprotobyname("tcp");
    die "teleport: getprotobyname(tcp) failed\n" unless ($proto);

    socket($fh, $AF_INET, $SOCK_STREAM, $proto)
	|| die "teleport: socket failed: $!\n";

    $sockaddr = pack('S n a4 x8', $AF_INET, $port, $ipaddr);

    connect($fh, $sockaddr)
	|| (close($fh), return (0,0,0));

    select($fh); $| = 1; select(STDOUT); 

    print $fh "$cookie\n";

    vec($fds, fileno($fh), 1) = 1;

    $n = select($fds,undef,undef,$tpwatchTimeout);

    die "teleport: select failed\n" if ($n < 0);

    if ($n == 0) {	# timeout, tpwatch not responding
	close($fh);
	return (1,0,0);
    }

    read($fh,$buf,9);
    if ($buf eq "rejected\n") {
	close($fh);
	return (1,1,0);
    }
    if ($buf eq "accepted\n") {
	return (1,1,1);
    }

    close($fh);
    return (0,0,0);
}


#
# Help prints out context-sensitive help information.
#

sub Help
{
    local ($fh,$tpSessionInfoExists,$tpSessionAppearsToExist,
	   $tpSessionResponding,$tpSessionControllable,$tpDisplay,$tpHost) = @_;
    local ($_userid,$currentDisplay);

    close($fh) unless ($tpSessionControllable);

    warn "\nTeleporting System Version 1.2\n";
    warn "Copyright (C) 1993-1996 Olivetti Research Limited, Cambridge, England.\n";

    warn "\n";
    &Usage(1);
    warn "\n";

    $_userid = " $opt{'-helpuserid'}" if ($opt{'-helpuserid'});

    if (!$tpSessionInfoExists) {
	warn "You do not have a teleport session.\n";
	warn("Type 'teleport$_userid' to start a new teleport session.\n\n");
	return;
    }

    if (!$tpSessionAppearsToExist) {
	warn("You had a teleport session (display $tpDisplay) but it has died.\n".
	     "Type 'teleport$_userid -start' to start a new teleport session.\n\n");
	return;
    }

    if (!$tpSessionResponding) {
	warn("You appear to have a teleport session (display $tpDisplay) but\n".
	     "it is not responding. Either:\n".
	     "1) you have a problem with your '.tpmtl' script - try killing any\n".
	     "   processes associated with it.\n".
	     "2) tpwatch is hung - you have no choice but to kill off tpwatch and\n".
	     "   tpproxy and restart with 'teleport$_userid -start'\n\n");
	return;
    }

    if (!$tpSessionControllable) {
	warn("You have a teleport session (display $tpDisplay) but you do not\n".
	     "have permission to control it from this machine.\n".
	     "Try using 'teleport $ENV{USER}@$tpHost ...' instead.\n");
	return;
    }

    warn "You have a teleport session (display $tpDisplay)\n\n";

    print $fh "currentdisplay\n";
    chop($currentDisplay = <$fh>);
    close($fh);

    if ($currentDisplay) {
	warn "It is currently materialised on $currentDisplay.\n\n";
    } else {
	warn "It is currently dematerialised.\n\n";
    }

    if (!defined($ENV{DISPLAY}))
    {
	warn("The DISPLAY environment variable is not set.\n".
	     "This is probably because you have used 'rlogin'.\n".
	     "I cannot tell if this is your teleport session\n\n".
	     "Type 'teleport$_userid -display <dpy>' to materialise it on a given display.\n");
    }
    else
    {
	warn "The DISPLAY environment variable is set to $ENV{DISPLAY}.\n\n";

	if (&SameDisplay($ENV{DISPLAY},$tpDisplay)) {
	    warn("This is your teleport session.\n\n".
		 "Type 'teleport$_userid' to send it away\n".
		 "Type 'teleport$_userid -display <dpy>' to send it to another display.\n");
	}
	else {
	    warn("This is not your teleport session.\n\n".
		 "Type 'teleport$_userid' to bring it up on this display.\n".
		 "Type 'teleport$_userid -display <dpy>' to send it to another display.\n".
		 "Type 'teleport$_userid -away' to send it away.\n");
	}
    }
    warn "Type 'teleport$_userid -kill' to kill the teleport session.\n\n";
}


#
# StartTeleportSession is used to start a teleport session and display it on
# the given physical display.
#

sub StartTeleportSession
{
    local ($physicalDisplay,$wait) = @_;
    local ($geometry,$displayHost,$z,$serverNo,$screenNo,
	   $magicCookie,$seed,$reply,$i);

    $tpproxyBin = &FindCommand("tpproxy", @commandSearchPath);
    $tpwatchBin = &FindCommand("tpwatch", @commandSearchPath);

    warn "teleport: Starting a new teleport session...\n";

    #
    # Geometry doesn't really matter if you use tpwm...
    #

    if ($opt{'-geometry'}) {
	$geometry = $opt{'-geometry'};
	&Usage() unless ($geometry =~ /^(\d+x\d+)$/);
    } else {
	$geometry = "1280x1024";
    }

    #
    # Create a 16-byte magic cookie.
    #

    $magicCookie = "";
    srand(time+$$);
    for (1..16) {
	$magicCookie .= sprintf("%02x", ($seed = int(rand(256))));
    }

    #
    # Create 2 pipes, from tpwatch to tpproxy and back again.
    #

    pipe(WATCH2PROXY_R, WATCH2PROXY_W);
    pipe(PROXY2WATCH_R, PROXY2WATCH_W);
    open(PROXYSTDERR, ">$proxyLogFile");
    chmod 0644, $proxyLogFile;

    #
    # Fork off the tpproxy process and redirect its stdin, stdout and stderr.
    #

    if (fork == 0) {
	close(WATCH2PROXY_W);
	close(PROXY2WATCH_R);
	open(STDIN,"<&WATCH2PROXY_R");
	open(STDOUT,">&PROXY2WATCH_W");
	open(STDERR,">&PROXYSTDERR");
	close(WATCH2PROXY_R);
	close(PROXY2WATCH_W);
	close(PROXYSTDERR);
	exec "$tpproxyBin","-g",$geometry;
	die "exec $tpproxyBin failed\n";
    }

    close(WATCH2PROXY_R);
    close(PROXY2WATCH_W);
    close(PROXYSTDERR);

    #
    # Send tpproxy its magic cookie.
    #

    select(WATCH2PROXY_W); $| = 1; select(STDOUT);
    print WATCH2PROXY_W "auth MIT-MAGIC-COOKIE-1 $magicCookie\n";
    $reply = <PROXY2WATCH_R>;
    if ($reply ne "ok\n") {
	die "teleport: tpproxy did not start up properly\n";
    }

    #
    # Find tpproxy's display name.
    #

    print WATCH2PROXY_W "whoami\n";
    chop($tpDisplay = <PROXY2WATCH_R>);
    warn "Your teleport session is display $tpDisplay\n";
    $tpDisplay = &FullyQualifyDisplayName($tpDisplay);

    $ENV{DISPLAY} = $tpDisplay;

    #
    # Write cookie to .Xauthority
    #

    system("$xauthBin add $tpDisplay MIT-MAGIC-COOKIE-1 $magicCookie");

    unlink($infoFile);

    #
    # Fork off the tpwatch process, redirect its stdin and stdout, and
    # detach it from our stderr.
    #

    if (($tpwatchPid = fork) == 0) {
	open(STDIN,"<&PROXY2WATCH_R");
	open(STDOUT,">&WATCH2PROXY_W");
	close(STDERR);
	close(PROXY2WATCH_R);
	close(WATCH2PROXY_W);
	exec "$tpwatchBin $tpDisplay";
	die "exec $tpwatchBin failed\n";
    }

    close(WATCH2PROXY_W);
    close(PROXY2WATCH_R);

    #
    # Wait until tpwatch has written to .tpinfo
    #

    $i = 0;
    while ((! -e $infoFile) || (-z $infoFile)) {
	sleep(1);
	$i++;
	print STDERR "." if (($i % 4) == 0);
	if ($i > $tpwatchStartUpTimeout) {
	    warn "teleport: timeout waiting for tpwatch to start\n";
	    system("$catBin $watchLogFile");
	    exit 1;
	}
    }

    ($tpSessionInfoExists,$tpHost,$tpPort,$tpDisplay) = &GetTpSessionInfo();

    if (!$tpSessionInfoExists) {
	die "teleport: starting teleport session failed\n";
    }

    #
    # Connect to tpwatch.
    #

    ($tpSessionAppearsToExist,$tpSessionResponding,$tpSessionControllable)
	= &ConnectToTpwatch(SOCKET,$tpHost,$tpPort,$tpDisplay);

    if (!$tpSessionControllable) {
	die "teleport: starting teleport session failed - session not controllable?\n";
    }

    #
    # Execute .tpsession in the background
    #

    if (-x $sessionFile) {
	system("$sessionFile </dev/null >/dev/null 2>&1 &");
    } else {
	$defaultSessionBin = &FindCommand("tpsession.default",
					  @commandSearchPath);
	system("$defaultSessionBin </dev/null >/dev/null 2>&1 &");
    }

    #
    # Finally materialise the session on the given display.
    #

    &MaterialiseTeleportSession(SOCKET,$physicalDisplay,$wait);
}


#
# MaterialiseTeleportSession tells tpwatch to materialise the teleport session
# on the given display, or dematerialise it if given an empty string.
#

sub MaterialiseTeleportSession
{
    local ($fh,$physicalDisplay,$wait) = @_;
    local ($reply);

    if (&SameDisplay($physicalDisplay,$tpDisplay)) {
	die "teleport: Can't teleport a session to itself!\n";
    }

    if ($physicalDisplay) {
	if ($wait) {
	    print $fh "display $physicalDisplay wait\n";
	} else {
	    print $fh "display $physicalDisplay\n";
	}
    } else {
	print $fh "nodisplay\n";
    }

    chop($reply = <$fh>);

    if ($reply ne "ok") {
	if ($reply eq "conn error") {
	    die("teleport: teleporting to '$physicalDisplay' failed:\n".
		"connection failure (i.e. display doesn't exist or X packets are\n".
		"being filtered out)\n");
	}
	if ($reply eq "auth error") {
	    die("teleport: teleporting to '$physicalDisplay' failed:\n".
		"authorisation failure (i.e. magic cookie incorrect)\n");
	}
	if ($reply eq "host error") {
	    die("teleport: teleporting to '$physicalDisplay' failed:\n".
		"no such host\n");
	}
	if ($physicalDisplay) {
	    die("teleport: teleporting to '$physicalDisplay' failed:\n".
		"reply from proxy server '$reply'\n");
	} else {
	    die("teleport: teleporting away failed:\n".
		"reply from proxy server '$reply'\n");
	}
    }

    if ($wait) {
	do {
	    $reply = <$fh>;
	    print $reply;
	} until (length($reply) == 0);
    }

    close($fh);
}


#
# RematerialiseTeleportSession tells tpwatch to rematerialise on the same
# display.
#

sub RematerialiseTeleportSession
{
    local ($fh) = @_;

    print $fh "rematerialise\n";

    chop($reply = <$fh>);

    if ($reply ne "ok") {
	if ($reply eq "conn error") {
	    die("teleport: teleporting to same display failed:\n".
		"connection failure (i.e. display doesn't exist or X packets are\n".
		"being filtered out)\n");
	}
	if ($reply eq "auth error") {
	    die("teleport: teleporting to same display failed:\n".
		"authorisation failure (i.e. magic cookie incorrect)\n");
	}
	if ($reply eq "host error") {
	    die("teleport: teleporting to same display failed:\n".
		"no such host\n");
	}
	die("teleport: teleporting to same display failed:\n".
	    "reply from proxy server '$reply'\n");
    }

    close($fh);
}


#
# KillTeleportSession tells tpwatch to close down gracefully.
#

sub KillTeleportSession
{
    local ($fh) = @_;

    system("$xauthBin remove $tpDisplay");

    unlink($infoFile);

    if ($fh) {
	print $fh "kill\n";
	close($fh);
    }
}


#
# ResetTeleportSession tells tpwatch to reset i.e. re-read its configuration
# files.
#

sub ResetTeleportSession
{
    local ($fh) = @_;

    print $fh "reset\n";
    close($fh);
}


#
# ProxyCommand tells tpwatch to send a command to tpproxy.
#

sub ProxyCommand
{
    local ($fh) = @_;
    local ($reply);

    print "teleport: Executing proxy command '$opt{'-command'}'\n";

    print $fh "$opt{'-command'}\n";

    chop($reply = <$fh>);
    print "Reply is '$reply'\n";
    close($fh);
}


#
# Usage prints a usage message to standard error then exits or returns.
#

sub Usage
{
    local ($return) = @_;

    warn("usage: teleport [userid[@host]] [-help] [-away] [-kill] [-start] [-wait]\n".
	 "                [-reset] [-rematerialise] [-display <displayname>]\n".
	 "                [-geometry <width>x<height>]\n");
    exit 1 unless ($return);
}


#
# FindCommand searches for the given command in the given directories,
# returning the first match found.
#

sub FindCommand
{
    local ($cmd,@dirs) = @_;

    for (@dirs) {
	if (-x "$_/$cmd") {
	    return "$_/$cmd";
	}
    }
    warn "teleport: couldn't find \"$cmd\".\n";
    return $cmd;
}


#
# GetFullyQualifiedPhysicalDisplay returns a fully qualified display name
# representing the physical display. It also fully qualifies the DISPLAY
# environment variable and -display argument.
#

sub GetFullyQualifiedPhysicalDisplay
{
    if ($ENV{DISPLAY}) {
	$ENV{DISPLAY} = &FullyQualifyDisplayName($ENV{DISPLAY});
    }
    if ($opt{'-display'}) {
	$opt{'-display'} = &FullyQualifyDisplayName($opt{'-display'});
    } else {
	$ENV{DISPLAY};
    }
}


#
# FullyQualifyDisplayName returns a fully qualified version of the given
# display name.
#

sub FullyQualifyDisplayName
{
    local ($display) = @_;
    local ($host,$z,$serverNo,$screenNo);

    return "" if (!$display);

    ($host,$z,$serverNo,$z,$screenNo)
	= ($display =~ /^([^:]+)?(:(\d+)(\.(\d+))?)?/);
    $host = &FullHostName($host);
    $serverNo = 0 unless $serverNo;
    $screenNo = 0 unless $screenNo;

    "$host:$serverNo.$screenNo";
}


#
# FullHostName takes a host name and returns a fully-qualified version of that
# host. It does this by trying to add the domain name, if possible, or as a
# last resort it will simply return the IP address.
#

sub FullHostName
{
    local ($host) = @_;
    local (@hostEntry,@fqHostEntry);

    return $host if ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);

    unless ($host) {
	unless (defined($_THIS_HOST)) {
	    chop($_THIS_HOST = `$hostnameBin`);
	}
	$host = $_THIS_HOST;
    }

    @hostEntry = gethostbyname($host);
    die "teleport: no such host '$host'\n" unless (@hostEntry);

    return $host if ($host =~ /\./);	# already fully-qualified

    if (!defined($DOMAIN_NAME)) {
	chop($DOMAIN_NAME = `$domainnameBin`);
    }

    if (defined($DOMAIN_NAME)) {
	@fqHostEntry = gethostbyname("$host.$DOMAIN_NAME");
	return "$host.$DOMAIN_NAME" if (@fqHostEntry);
    }

    return &HostToIPAddr($host,@hostEntry);
}


#
# HostToIPAddr turns a host name into an IP address in dotted decimal notation.
#

sub HostToIPAddr
{
    local ($host,@hostEntry) = @_;
    local ($ip1,$ip2,$ip3,$ip4);

    return $host if ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);

    unless (@hostEntry) {
	@hostEntry = gethostbyname($host);
	die "teleport: no such host '$host'\n" unless (@hostEntry);
    }

    ($ip1,$ip2,$ip3,$ip4) = unpack('C4', $hostEntry[4]);

    return "$ip1.$ip2.$ip3.$ip4";
}


#
# SameDisplay compares if two display names are the same.
#

sub SameDisplay
{
    local ($display1,$display2) = @_;
    local ($host1,$serverNo1,$screenNo1,@hostEntry1,
	   $host2,$serverNo2,$screenNo2,@hostEntry2,$z);

    if (($display1 eq "") || ($display2 eq "")) {
	return 1 if (($display1 eq "") && ($display2 eq ""));
	return 0;
    }

    ($host1,$z,$serverNo1,$z,$screenNo1)
	= ($display1 =~ /^([^:]+)?(:(\d+)(\.(\d+))?)?/);
    $host1 = &FullHostName($host1);

    ($host2,$z,$serverNo2,$z,$screenNo2)
	= ($display2 =~ /^([^:]+)?(:(\d+)(\.(\d+))?)?/);
    $host2 = &FullHostName($host2);

    return 0 if ($screenNo1 != $screenNo2);
    return 0 if ($serverNo1 != $serverNo2);
    return (&HostToIPAddr($host1) eq &HostToIPAddr($host2));
}


#
# EscapeSpacesAndQuotes takes a string and quotes any backslashes, spaces and
# single or double quotes so that when parsed by a shell we'll get back
# the original string.
#

sub EscapeSpacesAndQuotes
{
    local ($_) = @_;
    s/\\/\\\\/g;
    s/ /\\ /g;
    s/'/\\'/g;
    s/"/\\"/g;
    $_;
}


#
# 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 ($arg = shift(@ARGV)) {
	foreach $opt (@opts) {
	    if ($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;
}


#
# TeleportUserId takes a userid or "userid@host" and invokes the teleport
# script as appropriate for that user.
#

sub TeleportUserId
{
    local ($user) = @_;
    local ($display,$name,$home,$z,@args);

    if ($user =~ /\@/) {	# teleport userid@host ...
	&RemoteTeleport($`,$');
	exit;
    }

    $display = $ENV{DISPLAY};
    %ENV = ();
    ($name,$z,$z,$z,$z,$z,$z,$home,$z) = getpwnam($user);
    &Usage() unless ($name);

    $ENV{USER} = $user;
    $ENV{HOME} = $home;
    $ENV{DISPLAY} = $display;
    for (0..$#optArgs) {
	push(@args,&EscapeSpacesAndQuotes($optArgs[$_]));
    }
    exec "su",$user,"-c","$0 @args -helpuserid $user";
    die "teleport: cannot exec 'su'\n";
}


#
# RemoteTeleport runs the teleport command on the remote host. It contacts
# the rexec port on the remote host and sends it the appropriate command.
#

sub RemoteTeleport
{
    local ($userid, $host) = @_;
    local ($cookie, $i, $remoteCmd, @args);

    #
    # If the teleport command may involve materialisation, we must
    # get the magic cookie for the physical display.
    #

    if ($physicalDisplay && !$opt{'-help'} && !$opt{'-away'} && !$opt{'-kill'}
	&& !$opt{'-reset'} && !$opt{'-command'})
    {
	$cookie = `$xauthBin extract - $physicalDisplay 2>/dev/null`;
	if (($? >> 8) != 0) {
	    $cookie = "";
	}
    }

    #
    # Reconstruct arguments with quoting as necessary for shell parsing.
    #

    for (0..$#optArgs) {
	if ($optArgs[$_] eq "-display") {
	    $optArgs[$_+1] = &FullyQualifyDisplayName($optArgs[$_+1]);
	}
	push(@args,&EscapeSpacesAndQuotes($optArgs[$_]));
    }

    #
    # Now construct the remote teleport command.
    #

    $remoteCmd = "teleport @args -helpuserid $userid\@$host";
    $remoteCmd .= " -auth" if ($cookie);
    if ($ENV{DISPLAY}) {
	$remoteCmd = ("/bin/sh -c DISPLAY=$ENV{DISPLAY}\\;\\ export\\ DISPLAY\\;\\ ".
		      &EscapeSpacesAndQuotes($remoteCmd));
    }

    if (!&Rexec("S",$host,$userid,"",$remoteCmd)) {
	die "teleport: cannot rexec to $host\n";
    }

    if ($cookie) {
	print S $cookie;
    }

    shutdown(S, 1);

    while (read(S,$_,1024)) {
	print;
    }
    close(S);
    exit;
}


#
# Rexec contacts the rexecd on the given host, executes the given command
# using optional userid and password, and returns a filehandle to the
# remote command.
#

sub Rexec
{
    local ($fh, $host, $user, $passwd, $cmd) = @_; 
    local ($sockaddr,$ipaddr,$proto,$port,$z);

    if ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
	$ipaddr = pack("C4",$1,$2,$3,$4);
    } else {
	($z, $z, $z, $z, $ipaddr) = gethostbyname($host);
	die "teleport: gethostbyname($host) failed\n" unless ($ipaddr);
    }

    ($z, $z, $proto) = getprotobyname("tcp");
    die "teleport: getprotobyname(tcp) failed\n" unless ($proto);

    ($z, $z, $port) = getservbyname("exec", "tcp");
    die "teleport: getservbyname(exec) failed\n" unless ($port);

    socket($fh, $AF_INET, $SOCK_STREAM, $proto)
	|| die "socket failed: $!\n";

    $sockaddr = pack('S n a4 x8', $AF_INET, $port, $ipaddr);

    connect($fh, $sockaddr)
	|| (close($fh), return 0);

    select($fh); $| = 1; select(STDOUT); 

    if (!$user) {
        print "login: ";
        chop($user = <STDIN>);
        if (!$user) {
	    close($fh);
	    return 0;
        }
    }

    if (!$passwd) {
	if ((system("$sttyBin -echo") >> 0) != 0) {
	    warn "rexec: cannot stty -echo, unsafe to type password\n";
	    return 0;
	}
	system("$sttyBin echonl 2>/dev/null");
        print "Password: ";
	$SIG{TERM} = "RestoreEcho";
	$SIG{INT} = "RestoreEcho";
	$SIG{QUIT} = "RestoreEcho";
        chop($passwd = <STDIN>);
	$SIG{TERM} = "DEFAULT";
	$SIG{INT} = "DEFAULT";
	$SIG{QUIT} = "DEFAULT";
	system("$sttyBin -echonl 2>/dev/null");
	system("$sttyBin echo");
        if (!$passwd) {
	    close($fh);
	    return 0;
        }
    }

    print $fh "0\0";
    print $fh "$user\0";
    print $fh "$passwd\0";
    print $fh "$cmd\0";

    read($fh, $result, 1);

    if (ord($result) == 1) {
	close($fh);
	return 0;
    }

    1;
}

sub RestoreEcho
{
    system("$sttyBin -echonl");
    system("$sttyBin echo");
    exit;
}
