#!/bin/perl
#Telnet client.  Send the name and value of the environment variable "myvar" to
#the telnet server.  Decline all other telnet options.

use Socket;
use POSIX;        #for WIFEXITED and WEXITSTATUS

use FileHandle;   #for autoflush
STDOUT->autoflush();

if (@ARGV == 1) {   #This @ARGV is in a scalar context
	$port = getservbyname('telnet', 'tcp') #look up telnet in /etc/services
		or die "$0: couldn't find port number for telnet";
} elsif (@ARGV == 2) {
	$port = $ARGV[1];
} else {
	die "$0: requires 1 or 2 command line arguments";
}

socket(S, AF_INET, SOCK_STREAM, 0) or die "$0: $!";
S->autoflush();      #pp. 130, 444 in O'Reilly Perl book

$ip = inet_aton($ARGV[0])          or die "$0: inet_aton failed";
$address = sockaddr_in($port, $ip) or die "$0: sockaddr_in failed";

$dotted = inet_ntoa($ip);
print "Trying $dotted...\n";
connect(S, $address)               or die "$0: $!";
$name = gethostbyaddr($ip, AF_INET) or $name = $dotted;
print "Connected to $name.\n";

$pid = fork();
defined $pid or die "$0: $!";

if ($pid == 0) {
	#Arrive here if I am the child.

	#Telnet protocol codes from RFC 854

	$SB = "\xFA";     #250: subnegotiation begin
	$SE = "\xF0";     #240: subnegotiation end

	$WILL = "\xFB";   #251
	$WONT = "\xFC";   #252

	$DO   = "\xFD";   #253
	$DONT = "\xFE";   #254

	$IAC  = "\xFF";   #255: "interpret as command"

	#Environment option codes from RFC 1408

	$ENVIRONMENT = "\x24";	#36
	$SEND = "\x01";    #1: Please send me the following variables.
	$IS = "\x00";      #0: Here are the names and values of my variables.

	$VAR = "\x00";     #0: The following variable is a "well-known" one.
	$USERVAR = "\x03"; #3: The following variable is not a "well-known" one.
	$VALUE = "\x01";   #1: end of variable name, start of variable value

	print S "$IAC$WILL$ENVIRONMENT";

	while (sysread(S, $c, 1) == 1) {   #Read one byte from the server.
		if ($port != 23 || $c ne $IAC) {
			print $c;
			next;        #Go back to line 63.
		}

		#Read a telnet command and the following option.
		sysread(S, $command, 1);
		sysread(S, $option, 1);

		if ($option ne $ENVIRONMENT) {

			#Tell the server not to perform any telnet option other
			#than environment.
			if ($command eq $WILL || $command eq $WONT) {
				print S "$IAC$DONT$option";
			}

			#Tell the server that we won't perform any telnet option
			#other than environment.
			elsif ($command eq $DO || $command eq $DONT) {
				print S "$IAC$WONT$option";
			}

			else {
				die "$0: Don't know telnet command ",
					ord($command), " with option ",
					ord($option);
			}

			next;        #Go back to line 63.
		}

		#The two possible responses to line 61.
		if ($command eq $DO) {
			print "Server wants us to do environment variables.\n";
		} elsif ($command eq $DONT) {
			print "Server doesn't want us to do environment variables.\n";
		}

		#Just in case the server tells us whether it is willing to do
		#environment variables.
		elsif ($command eq $WILL) {
			print S "$IAC$DO$option";
		} elsif ($command eq $WONT) {
			print S "$IAC$DONT$option";
			print "Server won't do environment variables.\n";
		}

		#Environment subnegotiation starts with IAC SB,
		#ends with IAC SE.
		elsif ($command eq $SB && $option eq $ENVIRONMENT) {
			sysread(S, $c, 1);
			if ($c ne $SEND) {
				die "$0: expected SEND, got " . ord($c);
			}

			while (sysread(S, $c, 1) == 1 && $c ne $IAC) {
				#Ignore the list of variables that the server wants.
				print "Ignoring ", ord($c), "\n";
			}

			sysread(S, $c, 1);
			if ($c ne $SE) {
				die "$0: expected SE, got " . ord($c);
			}

			print S "$IAC$SB$ENVIRONMENT" .
				"$IS" .
				"${USERVAR}myvar$VALUE$ENV{myvar}" .
				"$IAC$SE";
		}

		else {
			die "$0: Don't know telnet command ",
				ord($command), " with option ENVIRONMENT";
		}
	}

	close(S) or die "$0: $!";
	exit 0;
}

#Arrive here if I am the parent.
$SIG{CHLD} = 'death_of_child';

#Copy from the stdin to the server.
while (<STDIN>) {                #Read one line from the stdin
	print S $_;                  #and write it to the server.
}

shutdown(S, SHUT_RDWR) or die "$0: $!";
print "Connection closed.\n";
exit 0;

sub death_of_child {
	$p = wait();
	if ($p != $pid) {
		die "$0: My child is $pid, not $p";
	}

	if (!WIFEXITED($?)) {
		die "$0: My child did not return an exit status";
	}

	$status = WEXITSTATUS($?);
	if ($status != 0) {
		die "Child returned exit status $status";
	}

	shutdown(S, SHUT_RDWR) or die "$0: $!";
	print "Connection closed by foreign host.\n";
	exit 0;
}
