#!/usr/bin/perl -w

# Erco's little talk(1)-like server/client
#
#   Copyright (C) 2005,2006 Greg Ercolano
#
#   This program 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 program 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 program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
#   02111-1307 USA
#
#   Please report bugs to erco@3dsite.com -- you /must/ include
#   the words 'talkerco bug report' in the Subject: of your message.
#
#   Just invoke from the command line, and tell the remote
#   user to telnet to this machine with port number shown.
#
#   By default, chats are logged to /var/tmp/talkerco*
#   To disable logging, set 'my $logdir = "";' 
#   under 'USER CHANGABLE VARIABLES'.
#
# --------------------------- <-- loc_top,loc_msg_top
#
#
#      msg area
#
#                             <-- loc_msg_bot
# --------------------------- <-- loc_msg_bot1
#                             <-- loc_edt_top
#      local edit area
#                             <-- loc_edt_bot, loc_bot
# ---------------------------

use Socket;
require "ctime.pl";

$| = 1;

#### START: USER CHANGABLE VARIABLES
my $logdir = "/var/tmp";		# chat log directory ("" disables)
my $port = shift || 5555;		# default port is 5555

### APPLICATION VARIABLES
### Do not change unless you know what you're doing
my $debug = 0;				# set to 1 to enable debuglog
my $debuglog = "$logdir/talkerco-debug-log.txt";
my $busy_pid = 0;			# pid of 'busy signal' process
my $proto = getprotobyname('tcp');
my $loc_name = `logname`; chomp($loc_name);
my $rem_name = 'remote';
my $chatlog = "";
my $rem_init = 0;			# 0=remote hasn't negotiated win size yet

# LOCAL SCREEN POSITIONS
#    These initial defaults later overwritten by actual size.
#
my $loc_rows     = 25;                # physical rows
my $loc_cols     = 80;                # physical cols
my $loc_top      = 1;                 # top of physical screen
my $loc_bot      = $loc_rows;         # bottom of physical screen
my $loc_msg_top  = 1;                 # top of 'message area'
my $loc_msg_bot  = $loc_bot-6;        # bottom of 'message area'
my $loc_msg_bot1 = $loc_msg_bot+1;    # split screen marker
my $loc_edt_top  = $loc_msg_bot+2;    # top of 'edit area'
my $loc_edt_bot  = $loc_bot;          # bottom of 'edit area'
my $loc_dots      = '-'x78;

# REMOTE SCREEN POSITIONS
#    These initial defaults later overwritten by actual size.
#
my $rem_rows     = 25;                # phsical rows
my $rem_cols     = 80;                # phsical columns
my $rem_top      = 1;                 # top of physical screen
my $rem_bot      = $rem_rows;         # bottom of physical screen
my $rem_msg_top  = 1;                 # top of 'message area'
my $rem_msg_bot  = $rem_bot-6;        # bottom of 'message area'
my $rem_msg_bot1 = $rem_msg_bot+1;    # split screen marker
my $rem_edt_top  = $rem_msg_bot+2;    # top of 'edit area'
my $rem_edt_bot  = $rem_bot;          # bottom of 'edit area'
my $rem_dots     = '-'x78;

# VT100 SEQUENCES
sub VT100_ScrollRegion($$)  { return("\033[$_[0];$_[1]r"); }
sub VT100_Clear()           { return("\033[2J"); }
sub VT100_Cleol()           { return("\033[K"); }
sub VT100_Position($$)      { return("\033[$_[1];$_[0]H"); }
sub VT100_Save()            { return("\0337"); }
sub VT100_Restore()         { return("\0338"); }

# DEBUGGING
#sub VT100_ScrollRegion($$)  { return(""); }
#sub VT100_Clear()           { return(""); }
#sub VT100_Cleol()           { return(""); }
#sub VT100_Position($$)      { return(""); }
#sub VT100_Save()            { return(""); }
#sub VT100_Restore()         { return(""); }

# TELNET CODES
#  See RFC 854-857, RFC 1073 (win size)
#

# TELNET ESCAPE CHARACTER
my $T_IAC       = "\xff";	# "Interpret As Command"

my %chr2name;
$chr2name{chr(0xec)} = "EOF";
$chr2name{chr(0xee)} = "ABORT";
$chr2name{chr(0xf0)} = "SE";
$chr2name{chr(0xf3)} = "BREAK";
$chr2name{chr(0xf4)} = "INT";
$chr2name{chr(0xf9)} = "GA";
$chr2name{chr(0xfa)} = "SB";
$chr2name{chr(0xfb)} = "WILL";
$chr2name{chr(0xfc)} = "DONT";
$chr2name{chr(0xfd)} = "DO";
$chr2name{chr(0xfe)} = "DONT";
$chr2name{chr(0xff)} = "IAC";
$chr2name{chr(0)}    = "BIN (Binary Transmission)";
$chr2name{chr(1)}    = "ECHO";
$chr2name{chr(2)}    = "RECONNECT";
$chr2name{chr(3)}    = "SUPGA (Suppress Go Ahead)";
$chr2name{chr(4)}    = "AMSN (Approx Msg Size Negotiation)";
$chr2name{chr(5)}    = "STATUS";
$chr2name{chr(6)}    = "TM (Timing-Mark)";
$chr2name{chr(7)}    = "RCTE (Remote Controlled Trans and Echo)";
$chr2name{chr(8)}    = "OLW (Output Line Width)";
$chr2name{chr(9)}    = "OPS (Output Page Size)";
$chr2name{chr(10)}   = "NAOCRD (Negotiate About Output Carriage-Return Disposition)";
$chr2name{chr(11)}   = "NAOHTS (Negotiate About Output Horizontal Tabstops)";
$chr2name{chr(12)}   = "NAOHTD (Negotiate About Output Horizontal Tab Disposition)";
$chr2name{chr(13)}   = "NAOFFD (Negotiate About Output Formfeed Disposition)";
$chr2name{chr(14)}   = "NAOVTS (Negotiate About Vertical Tabstops)";
$chr2name{chr(15)}   = "NAOVTD (Negotiate About Output Vertcial Tab Disposition)";
$chr2name{chr(16)}   = "NAOLFD (Negotiate About Output Linefeed Disposition)";
$chr2name{chr(17)}   = "Extended ASCII";
$chr2name{chr(18)}   = "LOGOUT";
$chr2name{chr(19)}   = "BM (Byte Macro)";
$chr2name{chr(20)}   = "Data Entry Terminal";
$chr2name{chr(21)}   = "SUPDUP";
$chr2name{chr(22)}   = "SUPDUP-OUTPUT";
$chr2name{chr(23)}   = "SEND-LOCATION";
$chr2name{chr(24)}   = "TERMINAL-TYPE";
$chr2name{chr(25)}   = "END-OF-RECORD";
$chr2name{chr(26)}   = "TUID, TACACS User Id.";
$chr2name{chr(27)}   = "OUTMRK";
$chr2name{chr(28)}   = "TTYLOC (Tty Location Number)";
$chr2name{chr(29)}   = "Telnet 3270";
$chr2name{chr(30)}   = "X.3 PAD";
$chr2name{chr(31)}   = "NAWS (Negotiate About Window Size)";
$chr2name{chr(32)}   = "Terminal Speed";
$chr2name{chr(33)}   = "Remote Flow Control";
$chr2name{chr(34)}   = "Line Mode";
$chr2name{chr(35)}   = "X Display Location";
$chr2name{chr(36)}   = "Environment Option";
$chr2name{chr(37)}   = "Authentication Option";
$chr2name{chr(38)}   = "Encryption Option";
$chr2name{chr(39)}   = "New Environment Option";
$chr2name{chr(40)}   = "TN3270E";
$chr2name{chr(41)}   = "XAUTH";
$chr2name{chr(42)}   = "CHARSET";
# See http://www.networksorcery.com/enp/protocol/telnet.htm for more..

# TELNET OPERATIONS
#    These follow $T_IAC
#
my $T_EOF       = "\xec";
my $T_ABORT     = "\xee";       # abort process
my $T_SE        = "\xf0";       # suboption end
my $T_BREAK     = "\xf3";       # abort process
my $T_INT       = "\xf4";       # interrupt process
my $T_GA        = "\xf9";       # go ahead
my $T_SB        = "\xfa";       # suboption begin
my $T_WILL      = "\xfb";	# what we can do
my $T_WONT      = "\xfc";	# what we can't do
my $T_DO        = "\xfd";	# tell them what to do, or what we did
my $T_DONT      = "\xfe";	# tell them what not to do, or what we didn't do

# TELNET OPTIONS
#    Reference: ethereal's dissectors/packet-telnet.c file
#
my $T_BIN                   = "\x00";   # binary transmission (RFC 856)
my $T_ECHO                  = "\x01";   # echo mode (RFC 857)
my $T_SUPGA                 = "\x03";   # surpress go-ahead
my $T_STATUS                = "\x05";   # status reporting
my $T_NAWS                  = "\x1f";   # negotiate window size (RFC 1073)
my $T_FLOW                  = "\x21";   # flow control
my $T_LINEMODE              = "\x22";   # line mode (RFC 1184)
my $T_LINEMODE_MODE         = "\x01";   # line mode 'mode' operation
my $T_LINEMODE_MODE_EDIT    = "\x01";   # 'mode' mask
my $T_LINEMODE_MODE_TRAPSIG = "\x02";   # 'mode' mask
my $T_LINEMODE_MODE_ACK     = "\x04";   # 'mode' ack

# WRAP LINE INTO MULTIPLE LINES
#    $1 - string to wrap
#    $2 - width to wrap to
#
sub WrapLine($$)
{
    my ($line, $wrap) = @_;
    if ( length($line) < $wrap ) { return($line); }
    my $save = $line;
    $line = "";
    while ( length($save) >= $wrap )
    {
	$line = ($line eq ""?"":"$line\r\n") . substr($save, 0, $wrap);
	if ( length($save) >= $wrap ) { $save = substr($save, $wrap); }
	else                          { $save = ""; }
    }
    if ( $save ne "" ) { $line .= "\r\n$save"; }
    return($line);
}

# ADD A LINE TO THE MESSAGE AREA
sub AddMessage($)
{
    my ($line) = @_;
    $line =~ s/\r\n//;

    # LINE TOO LONG FOR SCREEN?
    #    Break up into separate lines to avoid linewrap/scroll problems.
    #
    $line = WrapLine($line, $loc_cols-1);

    print STDERR 
	VT100_Save().
	VT100_Position(0,$loc_msg_bot1).
	"\r---------".			# overwrite "Oo" typing indicator
	VT100_ScrollRegion($loc_msg_top, $loc_msg_bot).
	VT100_Position(0,$loc_msg_bot).
	"\n$line".
	VT100_ScrollRegion($loc_edt_top, $loc_edt_bot).
	VT100_Restore();
}

# ADD A LINE TO THE REMOTE MESSAGE AREA
sub AddMessageRemote($)
{
    my ($line) = @_;
    $line =~ s/\r\n//;

    # LINE TOO LONG FOR SCREEN?
    #    Break up into separate lines to avoid linewrap/scroll problems.
    #
    $line = WrapLine($line, $rem_cols-1);

    syswrite(Client,
        VT100_Save().
        VT100_Position(0,$rem_msg_bot1).
	"\r--------".			# overwrite "Oo" typing indicator
        VT100_ScrollRegion($rem_msg_top, $rem_msg_bot).
        VT100_Position(0,$rem_msg_bot).
        "\n$line".
        VT100_ScrollRegion($rem_edt_top, $rem_edt_bot).
	VT100_Restore());
}

# CLEAR EDIT SCREEN AREA
sub ClearLocalEditScreen()
{
    for ( $t=$loc_edt_top; $t<=$loc_edt_bot; $t++ )
    {
        print STDERR VT100_Position(0,$t).
                     VT100_Cleol();
    }
    print STDERR VT100_Position(0,$loc_edt_top);
}

# CLEAR REMOTE EDIT SCREEN AREA
sub ClearRemoteEditScreen()
{
    for ( $t=$rem_edt_top; $t<=$rem_edt_bot; $t++ )
	{ syswrite(Client, VT100_Position(0,$t).VT100_Cleol()); }
    syswrite(Client, VT100_Position(0,$rem_edt_top));
}

sub InitLocalScreen($)
{
    my ($doclear) = @_;
    if ( ! $doclear ) { print STDERR VT100_Save(); }
    print STDERR VT100_ScrollRegion($loc_top,$loc_bot).
		 (($doclear)?VT100_Clear():"").
		 VT100_Position(0,$loc_msg_bot1).
		 $loc_dots.VT100_Cleol().
		 VT100_ScrollRegion($loc_edt_top, $loc_edt_bot).
		 VT100_Position(0,$loc_edt_top);
    if ( ! $doclear ) { print STDERR VT100_Restore(); }
}

# INITIALIZE REMOTE'S SCREEN
#    $1 - bit flags:
#          1=clear screen
#          2=welcome message
#
sub InitRemoteScreen($)
{
    my ($flags) = @_;
    if ( ! $flags & 1 ) { syswrite(Client, VT100_Save()); }
    syswrite(Client, 
                 VT100_ScrollRegion($rem_top,$rem_bot).
		 (($flags&1)?VT100_Clear():"").
		 VT100_Position(0,$rem_msg_bot1).
		 $rem_dots.VT100_Cleol().
		 VT100_ScrollRegion($rem_edt_top, $rem_edt_bot).
		 VT100_Position(0,$rem_edt_top));

    # RESTORE CURSOR IF INITIALIZED, RESET IF NOT
    if ( $rem_init ) { syswrite(Client, VT100_Restore()); }

    # PRINT WELCOME MESSAGE IF INITIALIZING REMOTE FOR FIRST TIME
    if ( $rem_init == 0 )
    {
	AddMessageRemote("");
	AddMessageRemote("    -- WELCOME --");
	AddMessageRemote("    You can just start typing..");
	AddMessageRemote("    Hit ^C to close connection.");
	AddMessageRemote("    Lines are not sent until you hit Enter.");
	AddMessageRemote("");
    }

    $rem_init = 1;
}

sub Exit($)
{
    # RESET SCROLL REGION TO NORMAL
    print STDERR VT100_ScrollRegion($loc_top, $loc_bot).
                 VT100_Position(0, $loc_bot).
		 "\r\n";
    my $err = 0;
    if ( $_[0] ne "" ) { print STDERR "$_[0]\n"; $err = 1; }
    system("stty sane");
    print STDERR "*** CLEAN EXIT.\r\n";
    exit($err);
}

# REMOTE BROKE CONNECTION
sub RemoteBreak()
{
    # LOCAL MESSAGES
    #    Print break, and scroll up all text into scroll history,
    #    so none is lost when next connection comes in.
    #
    print STDERR "\r\n\007*** Remote hit ^C: closing connection.\r\n".
                 VT100_ScrollRegion($loc_top, $loc_bot).
		 VT100_Position(0, $loc_bot);
    my $t;
    for ( $t=$loc_top; $t<=($loc_bot-2); $t++ )
	{ print STDERR "\n\r"; }
    print STDERR VT100_Position(0,0).
                 "*** Remote hit ^C: closing connection.\r\n";

    # REMOTE MESSAGES
    syswrite(Client, VT100_ScrollRegion($rem_top, $rem_bot).
                     VT100_Position(0, $rem_bot).
		     "\r\n");
    syswrite(Client, "\n\r\007*** You hit ^C: closing connection.\r\n");
}

# LOCAL BROKE CONNECTION
sub LocalBreak()
{
    print STDERR "\r\n\007*** You hit ^C -- Closing connection\r\n".
                 VT100_ScrollRegion($loc_top, $loc_bot).
		 VT100_Position(0, $loc_bot);
    my $t;
    for ( $t=$loc_top; $t<=($loc_bot-2); $t++ )
        { print STDERR "\n\r"; }
    print STDERR VT100_Position(0,0).
                 "*** You hit ^C: closing connection.\r\n";
    
    syswrite(Client, VT100_ScrollRegion($rem_top, $rem_bot).
                     VT100_Position(0, $rem_bot).
		     "\r\n");
    syswrite(Client, "\r\n\007*** Server killed connection with ^C\r\n");
}

# WRITE ALL -- REMOTE AND LOCAL
sub Wall($)
{
    AddMessage($_[0]);
    AddMessageRemote($_[0]);
}

# GLOBALS FOR ACCUMULATING LINES OF TEXT
my $loc_linebuf = "";
my $rem_linebuf = "";
my $loc_count = 0;
my $rem_count = 0;

# GLOBALS FOR TELNET MODE OF CLIENT
my $tn_iacmode = 0;
my $tn_sbmode = 0;
my $tn_nawsmode = 0;
my $tn_nawswidth = 0;
my $tn_nawsheight = 0;

# CREATE LOG FILE, ZEROING IT OUT
sub CreateLog()
{
    open(LOG,">$debuglog");
    close(LOG);
}

# LOG A DEBUG MESSAGE
sub DebugLog($)
{
    unless(open(LOG, ">>$debuglog")) 
        { AddMessage("$debuglog: $!"); AddMessage($_[0]); return; }
    print LOG $_[0];
    close(LOG);
}

# LOG A STRING TO THE CHAT LOG
sub ChatLog($)
{
    if ( $chatlog eq "" ) { return; }
    unless(open(LOG, ">>$chatlog")) 
	{ AddMessage("$chatlog: $!"); AddMessage($_[0]); return; }
    print LOG $_[0];
    close(LOG);
}

# HANDLE TELNET SEQUENCE CHARACTERS
#     Returns 1 if character was handled.
#     Returns 0 if character was something user typed.
#
sub HandleTelnetSequence($)
{
    my $c = $_[0];

    if ( $c eq $T_IAC )
    {
        #DEBUG AddMessage("IAC RECEIVED");
        $tn_iacmode = 1;
	return(1);
    }
    # IN IAC MODE?
    elsif ( $tn_iacmode )
    {
	# FIRST CHAR AFTER IAC?
        if ( $tn_iacmode == 1 )
	{
	    $tn_iacmode = 2;
	    #DEBUG AddMessage(sprintf("IAC CHAR[1]=%02x",ord($c)));

	    if ( $c eq $T_INT || $c eq $T_BREAK)	# HANDLE ^C
		{ RemoteBreak(); }
	    elsif ( $c eq $T_SB )			# IAC SB [??]
		{ $tn_sbmode = 1; }
	    elsif ( $c eq $T_SE )			# IAC SB [??] IAC SE
	    {
		if ( $tn_nawsmode )	# finished NAWS mode?
		{
		    # Apply new settings
		    SetRemoteScreenSize($tn_nawsheight, $tn_nawswidth, 0);
		    AddMessage(sprintf("    Remote's screen size is: %d x %d", $rem_cols, $rem_rows));
		    AddMessage(sprintf("     Local's screen size is: %d x %d", $loc_cols, $loc_rows));
		    AddMessage("");
		}
	        $tn_sbmode = 0;
	    }
	    elsif ( $c eq $T_WILL )			# IAC WILL <cmd>
		{ $tn_will = 1; }
	    elsif ( $c eq $T_WONT )			# IAC WONT <cmd>
		{ $tn_wont = 1; }
	    elsif ( $c eq $T_DO )			# IAC DO <cmd>
		{ $tn_do = 1; }
	    elsif ( $c eq $T_DONT )			# IAC DONT <cmd>
		{ $tn_dont = 1; }
	    else
		{ AddMessage(sprintf("Unknown IAC command '%02x'",ord($c))); }
	
	    $tn_iacmode = 0;
	    return(1);
	}

	# IAC mode currently doesn't handle >1 command char
	$tn_iacmode = 0;
	return(1);
    }

    # DO/DONT/WILL/WONT
    elsif ( $tn_will ) 
	{ $tn_will = 0; if ( $debug ) { Log("Remote WILL ".$chr2name{$c}."\n"); } return(1); }
    elsif ( $tn_wont ) 
	{ $tn_wont = 0; if ( $debug ) { Log("Remote WONT ".$chr2name{$c}."\n"); } return(1); }
    elsif ( $tn_do ) 
	{ $tn_do   = 0; if ( $debug ) { Log("Remote DO   ".$chr2name{$c}."\n"); } return(1); }
    elsif ( $tn_dont ) 
	{ $tn_dont = 0; if ( $debug ) { Log("Remote DONT ".$chr2name{$c}."\n"); } return(1); }

    # SB BLOCK MODE?
    #    Used by NAWS..
    #
    elsif ( $tn_sbmode )
    {
	#DEBUG AddMessage(sprintf("SB CHAR[%d]=%02x",$tn_sbmode, ord($c)));

	if ( $tn_sbmode == 1 && $c eq $T_NAWS )		# IAC SB NAWS ..
	{
	    $tn_nawsmode = 1;
	}
	elsif ( $tn_nawsmode )
	{
	    if ( $tn_sbmode == 2 )
		{ $tn_nawswidth = ord($c) * 256; }	# hi byte
	    elsif ( $tn_sbmode == 3 )
		{ $tn_nawswidth += ord($c); }		# lo byte
	    elsif ( $tn_sbmode == 4 )
		{ $tn_nawsheight = ord($c) * 256; }	# hi byte
	    elsif ( $tn_sbmode == 5 )
		{ $tn_nawsheight += ord($c); }		# lo byte
	    else
		{ AddMessage(sprintf("NAWS mode[%d]: extra data '%02x'",$tn_nawsmode, ord($c))); }
	}
	else
	{
	    AddMessage(sprintf("SB mode[%d]: ignoring unknown data '%02x'",$tn_sbmode, ord($c)));
	}
	$tn_sbmode++;
	return(1);
    }
    return(0);
}

# HANDLE A CHARACTER FROM THE REMOTE
#     Returns 1 if they hit ^C
#
sub HandleRemote($)
{
    my ($c) = @_;

    if ( $debug ) { Log(sprintf("REMOTE: %02x\n", ord($c))); }

    # HANDLE TELNET SEQUENCES
    #     This character might be part of a telnet negotiation.
    #
    if ( HandleTelnetSequence($c) )
        { return(0); }

    # HANDLE NON-TELNET SEQUENCE
    #     Remote user typed this character.. display it.
    #

    # TELL LOCAL USER REMOTE IS TYPING
    $rem_count++;
    print STDERR VT100_Save().
                 VT100_Position(5, $loc_msg_bot1).
		 (($rem_count&1)?"oO":"Oo").
		 # substr("-\\|/",$rem_count%4,1).
		 # substr("oOoOoO",(($rem_count%2)*3),3).
		 VT100_Restore();

    # HANDLE CONTROL CHARACTERS FROM REMOTE
    if ( $c =~ '\x08' || $c =~ '\x7f' )		# ^H / DEL
    {
	syswrite(Client, "\x08 \x08");
	chop($rem_linebuf);
	return(0);
    }
    elsif ( $c =~ '\x15' )		# ^U
	{ $rem_linebuf = ""; ClearRemoteEditScreen(); }
    elsif ( $c =~ '\x12' ||		# ^R to redraw
    	    $c =~ '\x0c' )		# ^L to redraw
	{ InitRemoteScreen(0); }
    elsif ( $c =~ '\x03' )		# ^C to quit
    {
	RemoteBreak();
	return(1);
    }
    elsif ( $c =~ '\r' )		# cr part of cr/lf pair
    {
 	syswrite(Client, $c);
 	Wall("[$rem_name] $rem_linebuf");
 	ChatLog("[$rem_name] $rem_linebuf\n");
 	ClearRemoteEditScreen();
 	$rem_linebuf = "";
    }
    elsif ( $c =~ '\n' || $c =~ "\x00" ) # lf / <NUL> (telnet's <CR><NUL>)
    {
	# REMOTE HIT 'ENTER', CLEAR "Oo" TYPING INDICATOR FROM LOCAL STATUS BAR
	#    Do here instead of at \r, since \r\n comes in pairs,
	#    the \n causes an extra "Oo" to be printed that we clear here.
	#
	print STDERR VT100_Save().
		     VT100_Position(0, $loc_msg_bot1).
		     "\r----------".	# clear "Oo" typing indicator
		     VT100_Restore();
    }
    else				# printable character
    {
	if ( ord($c) < 0x20 || ord($c) >= 0x7f ) { $c = '?'; }
        syswrite(Client, $c);
	$rem_linebuf .= $c;
    }
    return(0);
}

# HANDLE LOCALLY TYPED CHARACTER
#     Returns 1 if they hit ^C
#     Returns 2 on some other error
#
sub HandleLocal($)
{
    my ($c) = @_;

    # TELL REMOTE TYPING HAPPENING ON LOCAL TTY
    $loc_count++;

    my $nwrite = syswrite(Client, VT100_Save().
                          VT100_Position(5, $rem_msg_bot1).
		          (($loc_count&1)?"oO":"Oo").
		          # substr("-\\|/",$loc_count%4,1).
		          VT100_Restore());

    if ( ! defined($nwrite) )
    {
        print "\n\007*** syswrite(): $!\n";
        return(2);
    }
    elsif ( $c eq '\x03' )			# ^C?
    {
        LocalBreak();
	return(1);
    }
    elsif ( $c =~ '\x08' || $c =~ '\x7f' )	# ^H
    {
	print STDERR "\x08 \x08";
	chop($loc_linebuf);
    }
    elsif ( $c =~ '\x15' )		# ^U
	{ $loc_linebuf = ""; ClearLocalEditScreen(); }
    elsif ( $c =~ '\x12' ||		# ^R to redraw
    	    $c =~ '\x0c' )		# ^L to redraw
	{ InitLocalScreen(0); }
    elsif ( $c =~ '\x03' )		# ^C to quit
    {
	LocalBreak();
	return(1);
    }
    elsif ( $c =~ '\r' )		# ^M
    {
	$loc_linebuf =~ s/\n/\r\n/g;
	Wall("[$loc_name] $loc_linebuf");
	ChatLog("[$loc_name] $loc_linebuf\n");
	$loc_linebuf = "";
	ClearLocalEditScreen();
    }
    elsif ( $c =~ '\n' || $c =~ "\x00" ) # lf / <NUL> (telnet's <CR><NUL>)
    {
	print STDERR $c.
	             VT100_Save().
		     VT100_Position(0, $loc_msg_bot1).
		     "\r----------".	# overwrite "Oo" typing indicator
		     VT100_Restore();
    }
    else
    {
        if ( ord($c) < 0x20 || ord($c) >= 0x7f ) { $c = '?'; }
	$loc_linebuf .= $c;
	print STDERR $c;
    }
    return(0);
}

sub BusySignal()
{
    my $pid = fork();
    if ( $pid != 0 ) { return($pid); }

    # CHILD PROCESS
    #     Send 'busy signal' to all other connections.
    #     Parent will kill us when no longer needed.
    #
    while ( 1 )
    {
	my $paddr = accept(Client, Server);
	my($port,$iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr, AF_INET);

	syswrite(Client, "***\r\n".
	                 "*** LINE IS BUSY.\r\n".
	                 "***\r\n");
	sleep(5);

	shutdown(Client, 2);
	close(Client);
    }
}

# GET LOCAL SCREEN SIZE
#    Use stty. If that doesn't work, assume a window 80x25.
#    Returns rows, cols.
#
sub GetLocalScreenSize()
{
    my ($rows,$cols) = (25, 80);
    my $stty = `stty -a < /dev/tty`;

       if ( $stty =~ /rows (\d+);/ ) { $rows = $1; }	# redhat9
    elsif ( $stty =~ /(\d+) rows;/ ) { $rows = $1; }	# OSX 10.3.6

       if ( $stty =~ /columns (\d+);/ ) { $cols = $1; }	# redhat9
    elsif ( $stty =~ /(\d+) columns;/ ) { $cols = $1; }	# OSX 10.3.6

    return($rows,$cols);
}

# SET LOCAL SCREEN SIZE
#    $1 - rows
#    $2 - cols
#
sub SetLocalScreenSize($$)
{
    ($loc_rows,$loc_cols) = @_;
    $loc_top      = 1;                 # top of physical screen
    $loc_bot      = $loc_rows;         # bottom of physical screen
    $loc_msg_top  = 1;                 # top of 'message area'
    $loc_msg_bot  = $loc_bot-6;        # bottom of 'message area'
    $loc_msg_bot1 = $loc_msg_bot+1;    # split screen marker
    $loc_edt_top  = $loc_msg_bot+2;    # top of 'edit area'
    $loc_edt_bot  = $loc_bot;          # bottom of 'edit area'
    $loc_dots     = '-'x($loc_cols-3) . '|';
}

# SET REMOTE SCREEN SIZE
sub SetRemoteScreenSize($$$)
{
    ($rem_rows,$rem_cols,$flag) = @_;
    $rem_bot      = $rem_rows;
    $rem_msg_bot  = $rem_bot - 6;
    $rem_msg_bot1 = $rem_msg_bot+1;
    $rem_edt_top  = $rem_msg_bot+2;
    $rem_edt_bot  = $rem_bot;
    $rem_dots     = '-'x($rem_cols-3) . '|';
    InitRemoteScreen($flag);		# draws split screen, welcome msg
}

$rem_port = 0;
$rem_iaddr = 0;
$rem_name = "remote";

### MAIN
{
    # INITIALIZE LOCAL SCREEN SIZE
    my ($rows,$cols) = GetLocalScreenSize();
    SetLocalScreenSize($rows,$cols);
    if ( $debug ) 
	{ CreateLog(); Log(sprintf("*** MAIN STARTED\n")); }

    if ( $port =~ /^(\d+)$/ ) { $port = $1; }
    else { print "$port: invalid port number\n"; }

    socket(Server, PF_INET, SOCK_STREAM, $proto)               || Exit("socket: $!");
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || Exit("setsockopt REUSE: $!");
    setsockopt(Server, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, 1)
	                                                       || Exit("setsockopt NODLY: $!");
    bind(Server, sockaddr_in($port, INADDR_ANY))	       || Exit("bind: $!");
    listen(Server,SOMAXCONN)			               || Exit("listen: $!");

    my $hostname = `hostname`; chomp($hostname);

    # TRAP ^C TO CLEANLY EXIT
    #    This will happen if local tty hits ^C while waiting for new connections.
    #    This does NOT happen during a connection; ^C checks handle that.
    #
    $SIG{INT} = sub { $SIG{INT}='IGNORE'; Exit(""); };
    $SIG{PIPE} = 'IGNORE';

    while ( 1 )
    {
        # START IN RAW MODE, ALLOWING SIGINT
	system("stty raw -echo isig -brkint");

        print STDERR
	     "\r\n\r\n".
	     "*** Server: Listening for new connections\r\n".
             "***         Screen size is $cols x $rows\r\n".
	     "***\r\n".
	     "***     Tell remote to invoke: telnet $hostname $port\r\n".
	     "***     or if behind firewall: telnet <firewall-ip> $port\r\n".
	     "***\r\n".
	     "***     Hit ^C to quit.\r\n".
	     "***\r\n";

	# ACCEPT A CONNECTION
	my $paddr = accept(Client, Server);

	# NEW CONNECTION FROM REMOTE
	$rem_init = 0;
	($rem_port, $rem_iaddr) = sockaddr_in($paddr);
	$rem_name = gethostbyaddr($rem_iaddr, AF_INET);
	if ( ! defined ( $rem_name ) ) { $rem_name = "remote"; }
	print "*** Connection from $rem_name [", inet_ntoa($rem_iaddr), "] on port $rem_port\007\n";
	if ( $debug ) { Log("*** New connection from $rem_name\n"); }

        # ENTER RAW MODE, DISABLE SIGINT
	system("stty raw -echo -isig -brkint");

	select(Client); $|=0; 
	select(STDERR); $|=0;
	select(STDOUT); $|=0;

	InitLocalScreen(1);
	# InitRemoteScreen(1);		# NOTE: will be redrawn after a NAWS negotiation

	# LOCAL MESSAGE
	AddMessage("*** New connection from [$rem_name] at ".inet_ntoa($rem_iaddr));
	AddMessage("");
	AddMessage("    -- WELCOME --");
	AddMessage("    You can just start typing..");
	AddMessage("    Hit ^C to close connection.");
	AddMessage("    Lines are not sent until you hit Enter.");
	AddMessage("");

	if ( $logdir ne "" )
	{
	    close(LOG);
	    my $date = `/bin/date +%Y-%m-%d-%H-%M`;	# UNIX
	    chomp($date);
	    $chatlog = "$logdir/talkerco-chat-log-$date.txt";
	    ChatLog("--- Connection from $rem_name (".inet_ntoa($rem_iaddr).") on ".ctime(time())."\n");
	}

	# GIVE A BUSY SIGNAL TO OTHERS TRYING TO CONNECT
	$busy_pid = BusySignal();

	# INITIALIZE REMOTE TELNET CLIENT
	syswrite(Client, $T_IAC.$T_WILL.$T_SUPGA);
	syswrite(Client, $T_IAC.$T_DO.$T_SUPGA);
	syswrite(Client, $T_IAC.$T_DONT.$T_ECHO);
	syswrite(Client, $T_IAC.$T_WILL.$T_ECHO);
	syswrite(Client, $T_IAC.$T_DONT.$T_FLOW);
	syswrite(Client, $T_IAC.$T_WILL.$T_LINEMODE);	# will establish linemode on/off

	# DISABLE ALL LINEMODE'S FLAGS
	syswrite(Client, $T_IAC.$T_SB.$T_LINEMODE.$T_LINEMODE_MODE."\x00".$T_IAC.$T_SE, 7);

	# REQUEST WINSIZE NEGOTIATION
	syswrite(Client, $T_IAC.$T_DO.$T_NAWS);

	# RESET GLOBALS
	$loc_linebuf = "";
	$rem_linebuf = "";
	$loc_count = 0;
	$rem_count = 0;
	$tn_iacmode = 0;
	$tn_sbmode = 0;
	$tn_nawsmode = 0;		# 1=receiving NAWS sequence
	$tn_nawswidth = 0;		# NAWS scratch area for receiving width
	$tn_nawsheight = 0;		# NAWS scratch area for receiving height
	# SetRemoteScreenSize(25, 80, 1);	# default screen size for remote (overwritten by a NAWS negotiation)
	syswrite(Client, VT100_Clear().VT100_Position(0,999));	# move cursor to bottom

	my $c;
	while ( 1 ) 
	{
	    # Prepare select() bit fields..
	    my $rin = '';
	    vec($rin, fileno(Client), 1) = 1;
	    vec($rin, fileno(STDIN),  1) = 1;

	    # Do a select(2) to wait for input from someone.
	    my $rout;
	    my ($numready, $timeleft) = select($rout=$rin, undef, undef, undef);

	    # REMOTE TYPING?
	    if ( vec($rout, fileno(Client), 1) ) 
	    {
	        my $nread = sysread(Client, $c, 1);
		if ( ! defined($nread) ) 
		{
		    last;
		} 
		elsif ( $nread == 1 )
		{
		    if ( HandleRemote($c) ) { last; }
		}
	    }

	    # LOCAL TTY TYPING?
	    if ( vec($rout, fileno(STDIN), 1) ) 
	    {
	        my $nread = sysread(STDIN, $c, 1);
		if ( ! defined($nread) )
		{
		    last;
		} 
		elsif ( $nread == 1 )
		{
		    if ( HandleLocal($c) ) { last; }
		}
	    }
	}

	# END CONNECTION
	shutdown(Client, 2);
	close(Client);
	ChatLog("*** Ends ".ctime(time())."\n");
	$chatlog = "";

	# DISABLE "BUSY SIGNAL" PROCESS
	kill(9, $busy_pid);

	# RESET SCROLL REGION TO NORMAL
	print STDERR VT100_ScrollRegion($loc_top, $loc_bot).
		     VT100_Position(0, $loc_top);
    }
}