File Coverage

blib/lib/Net/Telnet/Options.pm

Criterion	Covered	Total	%
statement	133	206	64.5
branch	54	128	42.1
condition	26	82	31.7
subroutine	15	17	88.2
pod	11	16	68.7
total	239	449	53.2

# Net::Telnet::Options
# Module to deal with telnet options via code refs that are called when
# an option is encountered. Defaults to refusing to do any offered options.

=head1 NAME

  Net::Telnet::Options - Telnet options over any socket

=head1 VERSION

This document describes Net::Telnet::Options version 0.0.1

=head1 SYNOPSIS

  use Net::Telnet::Options;

  my %options = (BINARY => { 'DO' => sub {} },
                 MSP    => { 'DO' => sub {} } );

  my $nto = Net::Telnet::Options->new(%options);

  OR

  my $nto = Net::Telnet::Options->new();

  # Accept and deal with incoming TERM TYPE option requests
  $nto->acceptDoOption('TTYPE', {'SB' => \&ttype_sb_callback } );

  sub ttype_sb_callback
  {
     my ($cmd, $subcmd, $data, $pos) = @_;

     $nto->sendOpt($socket, 'SB', 24, 'IS', 'VT100');
     return ;
  }

  # Actively ask the connected party to do the NAWS option
  $nto->activeDoOption('NAWS', {'SB' => \&naws_sb_callback } );

  # Parse and use the NAWS information
  sub naws_sb_callback
  {
    my ($cmd, $subcmd, $data, $pos) = @_;
    print ("NAWS SB: $cmd\n");
    return unless($cmd eq 'IS');
    my ($width, $height) = unpack('nn', $subcmd);
    print ("NAWS width, height: $width, $height\n");
    return ;
  }

  # Add a callback to deal with incoming ECHO requests
  $nto->addOption(0, 'ECHO', {'WILL' => \&willecho_callback,
                              'WONT'  => \&wontecho_callback });

  # Agree to to let them do MXP
  $nto->acceptWillOption('MXP');

  # Send the active options to the connected party
  $nto->doActiveOptions($socket);

  # Assuming $socket is an IO::Handle/Socket

  # Let NTO parse telnet options from incoming data:
  my $data;
  recv($socket, $data, 1024, 0);
  $data = $nto->answerTelnetOpts($socket, $data);

=head1 DESCRIPTION

This module is intended to handle Telnet Option requests on any given socket. Per default it refuses to do any option asked of it by the connected party. Any known telnet option can be set to be explicitly accepted or actively asked of the other side. Callback subroutines allow the user to execute some action upon receiving a particular option.

An instance of Net::Telnet::Options must be created for each socket, to keep track of the current state of each client.

=head1 INTERFACE

=head2 new (%options)

The new method can be passed a hash of default option callbacks to set. The keys of the hash are either option names, as given in the %possoptions hash at the top of this module, or option numbers from the appropriate RFCs.

The values of each item are hash references, with the keys being the option types to be handled, one of either WILL, WONT, DO, DONT, SB or RAW. The values should contain sub references of the callbacks to be called.

=head2 addOption ($activeflag, %opts)

The addOption method can be used to add more options in the same format as the new command, after the instance has been created. The additional activeflag can be set to either 0 or 1 to activate an option. An active option is one that is actively requested of the connected party.

=head2 acceptDoOption (option name/number or hash reference)

Agree to do the specific option. If just an option name/number is given, just agrees to do this option whenever requested by the connected party. (Sets up an empty callback). Can also be passed a hashref as with the hash references passed to the new method, containing callbacks to be called.

=head2 acceptWillOption (option name/number or hash reference)

Agree that the connected party will do a specific option. If just an option name/number is given, just agrees that the other party will do this option wheneverrrequested. (Sets up an empty callback). Can also be passed a hash reference as above to run callbacks.

=head2 activeDoOption (option name/number or hash reference)

Actively ask the connected party to DO a specific option. If just passed an option name/number, will just ask and ignore the response. If passed a hash reference containing WILL/WONT callbacks, these will be run when the connected party answers the request.

=head2 activeWillOption (option name/number or hash reference)

Actively declare that we want to do a specific option. If just passes an option name/number, will just declare what we want to do, and ignore any response. If passed a hash reference containing DO/DONT callbacks, these will be run when the connected party answers the request.

=head2 removeOption (option name/number)

Remove the given option from the set of options we are answering.

=head2 doActiveOptions (socket)

Requests any options set as active, and not yet negotiated,  of the connected party.

=head2 getTelnetOptState (option name/number)

Returns a hash reference containing any callbacks set for any particular command, plus 'STATUS_ME', 'STATUS_YOU' which can be any of NONE, ASKING, or WILL. STATUS_ME is the status of the local socket with regard to the option, and STATUS_ME is the status of the connected party.

=head2 answerTelnetOpts (socket, data)

This method must be called whenever data has been received from the connected party, before any other operations are done. It parses any telnet option information out of the given data, answering options as appropriate. The cleaned data is passed back. The socket is needed in order to send answers to any option requests.

If a incomplete telnet option is found in the data, eg an IAC WILL and no option number, the data will be retained, and prepended to the data given in the next call, to be checked again. Thus you can also pass in data a byte at a time and still have the options parsed.

=head2 sendOpt (socket, command, option name/number, suboptioncmd, suboption)

Send a raw telnet option to the connected party. But only if it makes sense. Eg. if DOing NAWS has been negotiated, attempting a DO NAWS with sendOpt will refuse, on the grounds that we are already doing this. Useful for testing and turning off options by hand.

=head1 CALLBACKS

Methods are provided for adding callbacks to each part of the negotiation process. Callbacks for WILL, WONT, DO, DONT commands are passed out the passed in data string, with the option removed. This string may still have other following options in it, so should be treated with caution! The callback is also passed the position which the option was found in the string. It may return a new copy of the data string which will be used for further parsing. In most cases you will not need to look at or return the data string. Be sure to return undef as the last statement in your callback, if you are not changing the data, to not accidently return the value of your last statement.

Sub option callbacks are slightly more complex. Suboptions generally have one of 2 different subcommands, either a SEND which means please send me some information, or IS, which defines the wanted information. The callback is passed either 'SEND' or 'IS' or 'SB' as the first parameter, if IS is passed, the 2nd parameter contains the information being passed, for SEND it is empty and for SB it contains the subcommand and the any information together. The 3rd parameter contains the data string, minus the actual telnet option commands, and the 4th parameter is the position the suboption was in the string.

Currently it is assumed that the module user will remember which callback has been associated with which option. (Thus the callback does not get passed the option name/number for which it is fired)

=head1 Telnet Options Explained

Telnet options are simple but complex. The definition is simple, the implementation is complex as one has to avoid entering endless negotiation loops. The simple explanation should suffice here, as this module intends to hide the complex negotiating from you.

Each Telnet connection consists of two parties, one on either side of the connection. When dealing with telnet options it is unimportant which side is the server and which is the client, important is just 'us' and 'them'. 'us' here is the side using this module, and 'them' is the party we are connected to.

There are 4 basic telnet option commands, WILL, WONT, DO, DONT. If we receive a WILL command, it means the other side wishes to start using an option themselves. If we receive a DO command, the other side wants us to start using an option. These are two separate things. We can use an option that they are not using, and vice versa. WONT and DONT are used to refuse an option.

Example:

1a. We receive a DO TTYPE from them.
1b i. We wish to comply, so we send a WILL TTYPE.
1b ii. We do not wish to comply so we send a WONT TTYPE.

2a. We would like to echo, so we send a WILL ECHO.
2b i. Thats ok with them, so they send a DO ECHO.
2b ii. They dont want us to use echo, so they send us a DONT ECHO.

Once an option has been set in this manner, each side has to remember which options both ends are using. The default for all options is WONT/DONT.

Some options have additional suboptions to set internal parameters. These are sent enclosed in SB and SE commands. (suboption, suboptionend). For example, settting the TTYPE option just indicates we are willing to answer 'what is your terminal type' questions, these are posed and answered using SB commands.

=head1 DIAGNOSTICS

(TODO)

=head1 CONFIGURATION AND ENVIRONMENT

Net:Telnet::Options requires no configuration files or environment variables.

=head1 DEPENDENCIES

None.

=head1 INCOMPATIBILITIES

None.

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Please report any bugs or feature requests to
[e-mail]>, or through the web interface at
L.

=head1 FURTHER INFORMATION

A list of available options: http://www.networksorcery.com/enp/protocol/telnet.htm

=head1 TODO

Support multiple sockets per instance.
Output list of options/names.

=head1 AUTHOR

Jess Robinson  C<< [e-mail] >>

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2004,2005, Jess Robinson C<< [e-mail] >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE 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. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE 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 THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE 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 THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.

=cut

package Net::Telnet::Options;
use Data::Dumper;

my $DEBUG = 0;
our $VERSION = '0.01';

my %possoptions = (
   BINARY          => 0, # Binary Transmission - RFC 856
   ECHO            => 1, # Echo                - RFC 857
   RCP             => 2, # Reconnection        -
   SGA             => 3, # Suppress Go Ahead   - RFC 858
   NAMS            => 4, # Approx Message Size Negotiation -
   STATUS          => 5, # Status              - RFC 859
   TM              => 6, # Timing Mark         - 860
   RCTE            => 7, # Remote Con. Trans,Echo - RFC 563,726
   NAOL            => 8, # Output Line Width   - NIC50005
   NAOP            => 9, # Output Page Size    - NIC50005
   NAOCRD          => 10, # Out. CR Disposition - RFC 652
   NAOHTS          => 11, # Out. Horiz. Tab Stops - RFC 653
   NAOHTD          => 12, # Out. Horiz. Tab Dispo. - RFC 654
   NAOFFD          => 13, # Out. Formfeed Disposition - RFC 655
   NAOVTS          => 14, # Out. Vertical Tabstops - RFC 656
   NAOVTD          => 15, # Out. Vertical Tab Dispo. - RFC 657
   NAOLFD          => 16, # Out. Linefeed Disposition - RFC 658
   XASCII          => 17, # Extended ASCII     - RFC 698
   LOGOUT          => 18, # Logout             - RFC 727
   BM              => 19, # Byte Macro         - RFC 735
   DET             => 20, # Data Entry Terminal - RFC 732,1043
   SUPDUP          => 21, # SUPDUP             - RFC 734,736
   SUPDUPOUTPUT    => 22, # SUPDUP Output      - RFC 749
   SNDLOC          => 23, # Send Location      - RFC 779
   TTYPE           => 24, # Terminal Type      - RFC 1091
   EOR             => 25, # End of Record      - RFC 885
   TUID            => 26, # TACACS User Ident. - RFC 927
   OUTMRK          => 27, # Output Marking     - RFC 933
   TTYLOC          => 28, # Terminal Location Number - RFC 946
   '3270REGIME'    => 29, # Telnet 3270 Regime - RFC 1041
   X3PAD           => 20, # X.3 PAD            - RFC 1053
   NAWS            => 31, # Negotiate Ab. Win. Size - RFC 1073
   TSPEED          => 32, # Terminal Speed     - RFC 1079
   LFLOW           => 33, # Remote Flow Control - RFC 1372
   LINEMODE        => 34, # Linemode           - RFC 1184
   XDISPLOC        => 35, # X Display Location - RFC 1096
   OLD_ENVIRON     => 36, # Environment Option - RFC 1408
   AUTHENTICATION  => 37, # Auth.- RFC 1416,2941,2942,2943,2951
   ENCRYPT         => 38, # Encryption Option - RFC 2946
   NEW_ENVIRON     => 39, # New Environment Option - RFC 1572
   TN3270E         => 40, # TN3270 ?          - RFC 2355
   XAUTH           => 41, # XAUTH             -
   CHARSET         => 42, # Negotiate charset to use - RFC 2066
   RSP             => 43, # Telnet remote serial port - RFC
   CPCO            => 44, # Com port control option - RFC 2217
   TSLE            => 45, # Telnet suppress local echo -
   STARTTLS        => 46, # Telnet Start TLS -
   KERMIT          => 46, # Kermit ?           - RFC 2840
   SENDURL         => 47, # Send URL           -
   FORWARDX        => 48, # X forwarding
   MCCP1           => 85, # Mud Compression Protocol (v1)
   MCCP2           => 86, # Mud Compression Protocol (v2)
   MSP             => 90, # Mud Sound Protocol
   MXP             => 91, # Mud eXtension Protocol
   PRAGMALOGON     => 138, # Telnet option pragma logon
   SSPILOGON       => 139, # Telnet option SSPI login
   PRAGMAHB        => 140, # Telnet option pragma heartbeat
   EXOPL           => 255, # Extended-Options-List - RFC 861
                  );
my %optposs = reverse %possoptions;

my %posscommands = (
                    GA     => 249, # you may reverse the line
                    EL     => 248, # erase the current line
                    EC     => 247, # erase the current character
                    AYT    => 246, # are you there
                    AO     => 245, # abort output--but let prog finish
                    IP     => 244, # interrupt process--permanently
                    BREAK  => 243, # break
                    DM     => 242, # data mark--for connect. cleaning
                    NOP    => 241, # nop
                    SE     => 240, # end sub negotiation
                    EOR    => 239, # end of record (transparent mode)
                    ABORT  => 238, # Abort process
                    SUSP   => 237, # Suspend process
                    EOF    => 236, # End of file
#                    SYNCH  => 242, # Data mark in urgent mode
                    );
my %commposs = reverse %posscommands;

my $chIAC = chr(255);
my $chDONT = chr(254);
my $chDO = chr(253);
my $chWONT = chr(252);
my $chWILL = chr(251);
my $chSB = chr(250);
my $chSE = chr(240);

# Auth commands
my $chNAME = chr(3);
my $chREPLY = chr(2);
my $chSEND = chr(1);
my $chIS = chr(0);
# Auth types
my %authtypes = (
                 NULL        => 0,  # RFC 2941
                 KERBEROS_V4 => 1,  # RFC 2941
                 KERBEROS_V5 => 2,  # RFC 2942
                 SPX         => 3,  # RFC 2941
                 MINK        => 4,  # RFC 2941
                 SRP         => 5,  # RFC 2944
                 RSA         => 6,  # RFC 2941
                 SSL         => 7,  # RFC 2941
                 ''          => 8,  # Unassigned
                 ''          => 9,  # Unassigned
                 LOKI        => 10, # RFC 2941
                 SSA         => 11, # Schoch ?
                 KEA_SJ      => 12, # RFC 2951
                 KEA_SJ_INTEG=> 13, # RFC 2951
                 DSS         => 14, # RFC 2943
                 NTLM        => 15, # Kahn ?
                );

my $OPT_LINEMODE_MODE = 1;
my $OPT_LINEMODE_MODE_EDIT = 1;

# The 4 telnet negotiation types, Subnegotiation, and Raw (call sub whenever
# option encountered, ie EOR)
my @opttypes = ('WILL', 'WONT', 'DO', 'DONT', 'SB', 'RAW');

sub new
{
    # Create new Net::Telnet::Options
    # Parameter: Class-Name/Reference, Properties
    my $class = shift;
    $class = ref($class) || $class;
    my $self = {};
    bless($self, $class);
    $self->initModule(@_);
    return $self;
}

sub initModule
{
    # Set default values
    # Parameter: Object, Option list (eg: NAWS => {WILL => coderef, WONT => coderef .. }
    my ($mod, %opts) = @_;

    $mod->{'telnetopts'} = {};

    foreach $opt (keys %opts)
    {
        $mod->addOption(0, $opt => $opts{$opt});
     }

    $mod->{'lastcommand'} = '';
    $mod->{'olddata'} = '';
}

sub addOption
{
    # Add a new set of option responses
    # Parameter: Object, Option hash
    my ($mod, $active, %opts) = @_;

    my $opt = $orgopt = (keys(%opts))[0];
    if (defined($possoptions{uc($opt)}) || defined($opt = $optposs{$opt}))
    {
        foreach my $opttype (@opttypes)
        {
            if (exists($opts{$orgopt}->{$opttype}))
            {
                $mod->{'telnetopts'}{uc($opt)}{$opttype} = $opts{$orgopt}->{$opttype};
            }
        }
        $mod->{'telnetopts'}{uc($opt)}{'STATUS_ME'} = 'NONE';
        $mod->{'telnetopts'}{uc($opt)}{'STATUS_YOU'} = 'NONE';
        $mod->{'telnetopts'}{uc($opt)}{'ACTIVE'} = 1 if($active);
    }
#    debug("addOption: ". Dumper($mod->{'telnetopts'}). "\n");
}

sub acceptDoOption
{
    # I'll DO option, when the other side requests it
    # Add a new option that defaults to 'DO' with no callback
    # Parameter: Object, Active, Option hash
    my ($mod, @opts) = @_;
    my %opts;
    %opts = (@opts == 1 ? (@opts, 1) : @opts);

    my $opt = (keys(%opts))[0];
    if (defined($possoptions{uc($opt)}) || defined($opt = $optposs{$opt}))
    {
        $mod->{'telnetopts'}{uc $opt}{'DO'} = \&empty_callback;
        $mod->{'telnetopts'}{uc $opt}{'DONT'} = \&empty_callback;
    }
#    debug("acceptDoOption: ". Dumper($mod->{'telnetopts'}). "\n");
    $mod->addOption(0, %opts);
}

sub acceptWillOption
{
    # I'll accept WILL option, when the other side wants to do it
    # Add a new option that defaults to 'DO' with no callback
    # Parameter: Object, Active, Option hash
    my ($mod, @opts) = @_;
    my %opts;
    %opts = (@opts == 1 ? (@opts, 1) : @opts);

    my $opt = (keys(%opts))[0];
    if (defined($possoptions{uc($opt)}) || defined($opt = $optposs{$opt}))
    {
        $mod->{'telnetopts'}{uc $opt}{'WILL'} = \&empty_callback;
        $mod->{'telnetopts'}{uc $opt}{'WONT'} = \&empty_callback;
    }
    debug("acceptWillOption: ". Dumper($mod->{'telnetopts'}). "\n");
    $mod->addOption(0, %opts);
}

sub activeDoOption
{
    # I'm  asking the other side to DO option
    # Add a new option that defaults to 'DO' with no callback
    # Parameter: Object, Active, Option hash
    my ($mod, @opts) = @_;
    my %opts;
    %opts = (@opts == 1 ? (@opts, 1) : @opts);

    my $opt = (keys(%opts))[0];
    if (defined($possoptions{uc($opt)}) || defined($opt = $optposs{$opt}))
    {
        $mod->{'telnetopts'}{uc $opt}{'WILL'} = \&empty_callback;
        $mod->{'telnetopts'}{uc $opt}{'WONT'} = \&empty_callback;
        $mod->{'telnetopts'}{uc $opt}{'ACTIVE'} = 1;
    }
#    debug("activeDoOption: ". Dumper($mod->{'telnetopts'}). "\n");
    $mod->addOption(1, %opts);
}

sub activeWillOption
{
    # I WILL do option when requested
    # Add a new option that defaults to 'DO' with no callback
    # Parameter: Object, Active, Option hash
    my ($mod, @opts) = @_;
    my %opts;
    %opts = (@opts == 1 ? (@opts, 1) : @opts);

    my $opt = (keys(%opts))[0];
    if (defined($possoptions{uc($opt)}) || defined($opt = $optposs{$opt}))
    {
        $mod->{'telnetopts'}{uc $opt}{'DO'} = \&empty_callback;
        $mod->{'telnetopts'}{uc $opt}{'DONT'} = \&empty_callback;
        $mod->{'telnetopts'}{uc $opt}{'ACTIVE'} = 1;
    }
    debug("activeWillOption: ". Dumper($mod->{'telnetopts'}). "\n");
    $mod->addOption(1, %opts);
}

sub removeOption
{
    # Remove a set of option responses
    # Parameter: Object, Option
    my ($mod, $opt) = @_;

    if(defined $possoptions{uc($opt)} || defined($opt = $optposs{$opt}))
    {
        if(exists($mod->{'telnetopts'}{uc $opt}))
        {
            delete $mod->{'telnetopts'}{uc $opt};
            return 1;
        }
    }
}

sub doActiveOptions
{
    # Go through the options that are set as active, and not yet negotiated.
    # If passed a socket, send to socket, else option_callback..
    # Parameters: Object, Socket?
    my ($mod, $sock) = @_;

    foreach my $opt (keys %{$mod->{'telnetopts'}})
    {
        if($mod->{'telnetopts'}{$opt}{'ACTIVE'})
        {
            if($mod->{'telnetopts'}{$opt}{'WILL'})
            {
                $mod->sendOpt($sock, 'DO', $opt);
            }
            elsif($mod->{'telnetopts'}{$opt}{'DO'})
            {
                $mod->sendOpt($sock, 'WILL', $opt);
            }
        }
    }
}

sub getTelnetOptState
{
    # Return the current state of an option by name/number
    # If not available, assume '0' = dont know this option
    # Parameter: Object, Option
    my ($mod, $opt) = @_;
    $opt = $optposs{$opt} if(!$possoptions{uc $opt});
    return if(!$opt);

    if (exists($mod->{'telnetopts'}{uc($opt)}))
    {
        return $mod->{'telnetopts'}{uc($opt)};
    }
    return 'NONE';
}

# Callback for answers to options? (ie dont pass in socket)

sub answerTelnetOpts
{
    # Answer all telnetoptions and remove from the given stream,
    # according to settings.
    # Object, Socket (for answers), Data
    my ($mod, $sock, $data) = @_;
    my $pos = -1;
    my $option;

    {
        $data = $mod->{'lastcommand'} . $data;
        $mod->{'lastcommand'} = '';
    }

    while (($pos = index($data, $chIAC, $pos)) > -1)
    {
        #		debug("Found IAC\n");
        my $nextchar = substr($data, $pos + 1, 1);
        if (!length($nextchar))
        {
            $mod->{'lastcommand'} = $chIAC;
            chop($data);
            last;
        }
        if ($nextchar eq $chIAC)
        {
            substr($data, $pos, 1) = '';
            $pos++;
        }
        elsif ($nextchar eq $chDONT or $nextchar eq $chDO or
               $nextchar eq $chWONT or $nextchar eq $chWILL)
        {
            $option = substr($data, $pos + 2, 1);
            if (!length($option))
            {
                $mod->{'lastcommand'} .= $chIAC . $nextchar;
                chop($data);
                chop($data);
                last;
            }
            substr($data, $pos, 3) = '';

            $data = $mod->negotiate_option($sock, $data, $nextchar, ord($option), $pos);
        }
        elsif ($nextchar eq $chSB)
        {
            my $endpos = index($data, $chSE, $pos);
            if ($endpos == -1)
            {
                $mod->{'lastcommand'} .= substr($data, $pos);
                substr($data, $pos) = '';
                last;
            }
            my $subcmd = substr($data, $pos + 2, $endpos - $pos + 1);
            substr($data, $pos, $endpos - $pos + 1) = '';

            $data = $mod->negotiate_suboption($sock, $data, $nextchar, $subcmd, $pos);
        }
#        elsif ($nextchar eq $chEOR)
#        {
#            # extract prompt from datastring
#            # debug("Extracting prompt..\n");
#            $testdata = $mod->{'olddata'} . $data;
#            substr($data, $pos, 2) = '';
#        }
        else                    # Unknown option, delete
        {
            debug("Command: " . $commposs{ord($nextchar)} . "\n");
            substr($data, $pos, 2) = '';
            if($commposs{ord($nextchar)} &&
               $mod->{'telnetopts'}{$commposs{ord($nextchar)}} &&
               (my $coderef = $mod->{'telnetopts'}{$commposs{ord($nextchar)}}{'RAW'}))
            {
                $coderef->($mod->{'olddata'} . $data, $pos+
                           length($mod->{'olddata'}));
            }
        }
    }
    # Add previous data line because of EORs/prompts
    $mod->{'olddata'} = $data;

    return $data;
}

sub negotiate_option
{
    # Given a telnet option found, do the actual answering etc.
    # Parameter: Object, Socket, Data stream, Option Type, Option #, Position
    my ($mod, $socket, $data, $opt_req, $opt, $optpos) = @_;
    debug("Mud sent option request:" . ord($opt_req) . ":" . $opt . "\n");
    if ($opt_req eq $chDO)
    {
        debug("Do " . $optposs{$opt} . "\n");
        if (exists($mod->{'telnetopts'}{$optposs{$opt}}) &&
            $mod->{'telnetopts'}{$optposs{$opt}}{'DO'})
        {
            if ($mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_ME'} ne 'ASKING')
            {
                print $socket $chIAC . $chWILL . chr($opt);
            }
            $mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_ME'} = 'WILL';
            my $res = $mod->{'telnetopts'}{$optposs{$opt}}{'DO'}->
              ($data, $optpos);
            $data = $res if(defined($res));
        }
        else
        {
            print $socket $chIAC . $chWONT . chr($opt);
        }
    }
    elsif ($opt_req eq $chWILL)
    {
        debug("Will ". $optposs{$opt} . "\n");
        if (exists($mod->{'telnetopts'}{$optposs{$opt}}) &&
            $mod->{'telnetopts'}{$optposs{$opt}}{'WILL'})
        {
            if ($mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_YOU'} ne 'ASKING')
            {
                print $socket $chIAC . $chDO . chr($opt);
            }
            $mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_YOU'} = 'WILL';
            my $res = $mod->{'telnetopts'}{$optposs{$opt}}{'WILL'}->
              ($data, $optpos);
            $data = $res if(defined($res));
        }
        else
        {
            print $socket $chIAC . $chDONT . chr($opt);
        }
    }
    elsif ($opt_req eq $chWONT)
    {
        debug("Wont " . $optposs{$opt} . "\n");
        if (exists($mod->{'telnetopts'}{$optposs{$opt}}) &&
            $mod->{'telnetopts'}{$optposs{$opt}}{'WONT'})
        {
            if ($mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_YOU'} eq 'ASKING')
            {
                $mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_YOU'} = 'NONE';
                print $socket $chIAC . $chDONT . chr($opt);
            }
            my $res = $mod->{'telnetopts'}{$optposs{$opt}}{'WONT'}->
              ($data, $optpos);
            $data = $res if(defined($res));
        }
        else
        {
            print $socket $chIAC . $chDONT . chr($opt);
        }
    }
    elsif ($opt_req eq $chDONT)
    {
        debug("Wont ". $optposs{$opt} . "\n");
        if (exists($mod->{'telnetopts'}{$optposs{$opt}}) &&
            $mod->{'telnetopts'}{$optposs{$opt}}{'DONT'})
        {
            if ($mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_ME'} eq 'ASKING')
            {
                $mod->{'telnetopts'}{$optposs{$opt}}{'STATUS_ME'} = 'NONE';
                print $socket $chIAC . $chWONT . chr($opt);
            }
            my $res = $mod->{'telnetopts'}{$optposs{$opt}}{'DONT'}->
              ($data, $optpos);
            $data = $res if(defined($res));
        }
        else
        {
            print $socket $chIAC . $chWONT . chr($opt);
        }
    }
    return $data;
}

sub negotiate_suboption
{
    my ($mod, $socket, $data, $opt_req, $cmd, $optpos) = @_;
    my $option = substr($cmd, 0, 1);
    # IAC, SB, TTYPE, SEND, IAC, SE
    debug("Got suboption request:" . ord($opt_req) . " :" .
          ord($option). "\n");

    debug("Option: ". $optposs{ord($option)}."\n");
    debug(Dumper($mod->{'telnetopts'}{$optposs{ord($option)}})."\n");

    return $data unless(exists($mod->{'telnetopts'}{$optposs{ord($option)}}));

    if($mod->{'telnetopts'}{$optposs{ord($option)}}{'STATUS_ME'} eq 'WILL' ||
       $mod->{'telnetopts'}{$optposs{ord($option)}}{'STATUS_YOU'} eq 'WILL')
    {
        my $coderef = $mod->{'telnetopts'}{$optposs{ord($option)}}{'SB'};
        return $data unless($coderef);
        if (substr($cmd, 1, 1) eq $chSEND)
        {
            my $res = $coderef->('SEND', '', $data, $optpos);
            $data = $res if(defined($res));
        }
        elsif(substr($cmd, 1, 1) eq $chIS)
        {
            my $res = $coderef->('IS', substr($cmd, 1), $data, $optpos);
            $data = $res if(defined($res));
        }
        else
        {
            my $res = $coderef->('SB', $cmd, $data, $pos);
            $data = $res if(defined($res));
        }
    }

    return $data;
}

sub sendOpt
{
    # Request a telnet option direct
    # Parameter: Object, Socket, DO/WILL/DONT/WONT/SB, Option number, suboption
    my ($mod, $socket, $req, $opt, $subopt1, $subopt2) = @_;
    $subopt1 ||='';
    $subopt2 ||='';
    debug("SendOpt: $req, $opt, $subopt1, $subopt2\n");

    if (defined($possoptions{uc($opt)}) || ($opt = $optposs{$opt}))
#    $opt = $optposs{$opt} if(!defined($possoptions{$opt}));
#    return if(!$opt);
    {
        if ($req eq 'WILL')
        {
            if ($mod->{'telnetopts'}{$opt}{'STATUS_ME'} eq 'ASKING' ||
                $mod->{'telnetopts'}{$opt}{'STATUS_ME'} eq 'WILL')
            {
                carp("Already asking $opt.\n");
                return;
            }
            print $socket $chIAC . $chWILL . chr($possoptions{$opt});
            $mod->{'telnetopts'}{$opt}{'STATUS_ME'} = 'ASKING';
        }
        if ($req eq 'WONT')
        {
            if ($mod->{'telnetopts'}{$opt}{'STATUS_ME'} ne 'WILL' &&
                $mod->{'telnetopts'}{$opt}{'STATUS_ME'} ne 'ASKING')
            {
                carp("We're not wanting that anyway!\n");
                return;
            }
            print $socket $chIAC . $chWONT . chr($possoptions{$opt});
            $mod->{'telnetopts'}{$opt}{'STATUS_ME'} = 'NONE';
        }
        if ($req eq 'DO')
        {
            if ($mod->{'telnetopts'}{$opt}{'STATUS_YOU'} eq 'WILL' ||
                $mod->{'telnetopts'}{$opt}{'STATUS_YOU'} eq 'ASKING')
            {
                carp("Already wanting $opt.\n");
                return;
            }
            print $socket $chIAC . $chDO . chr($possoptions{$opt});
            $mod->{'telnetopts'}{$opt}{'STATUS_YOU'} = 'ASKING';
        }
        if ($req eq 'DONT')
        {
            if ($mod->{'telnetopts'}{$opt}{'STATUS_YOU'} ne 'WILL' &&
                $mod->{'telnetopts'}{$opt}{'STATUS_YOU'} ne 'ASKING')
            {
                carp("We're not wanting that anyway!\n");
                return;
            }
            print $socket $chIAC . $chDONT . chr($possoptions{$opt});
            $mod->{'telnetopts'}{$opt}{'STATUS_YOU'} = 'ASKING';
        }
        if ($req eq 'SB')
        {
            debug("Sendopt: $opt, Status: $mod->{telnetopts}{$opt}\n");
            if($mod->{'telnetopts'}{$opt}{'STATUS_YOU'} eq 'WILL' &&
               $subopt1 eq 'SEND')
            {
                print $socket $chIAC . $chSB . chr($possoptions{$opt}) .
                    $chSEND . $subopt2 . $chIAC . $chSE;
            }
            elsif($mod->{'telnetopts'}{$opt}{'STATUS_ME'} eq 'WILL' &&
                  $subopt1 eq 'IS')
            {
                print $socket $chIAC . $chSB . chr($possoptions{$opt}) .
                  $chIS . $subopt2 . $chIAC . $chSE;
            }
            elsif($mod->{'telnetopts'}{$opt} &&
                  ($mod->{'telnetopts'}{$opt}{'STATUS_YOU'} eq 'WILL' ||
                   $mod->{'telnetopts'}{$opt}{'STATUS_ME'} eq 'WILL'
                  ))
            {
                print $socket $chIAC . $chSB . chr($possoptions{$opt}) .
                  $subopt2 . $chIAC . $chSE;
            }
            else
            {
                carp("Option $opt not turned on!\n");
            }
        }
    }
}


sub empty_callback
{
}

sub debug
{
#    ::main::debug(@_);

    print @_, "\n" if($DEBUG);
}

1;

# Deafult 'NONE' means 'WONT' ?
# POD:
# Calls WILL, DO, WONT, DONT, RAW coderefs with $data and $pos
# Calls SB coderef with SEND/IS/SB, Rest, $data, $pos
#
# Active doing/wanting of options..

  #
  # Us:   DO   X -- X_YOU = 'ASKING'
  # Them: WONT X
  # If X_YOU eq 'ASKING' -> 'NONE', confirm change of plan with 'DONT X'
  # Else agree 'DONT X'
  #
  # Them: WILL X
  # if X_YOU eq 'ASKING' -> 'DO', no reply
  # Else if 'WILL X' set, answer 'DO X' 'DO' (we havent requested, but would like)
  # Else refuse 'DONT X'
  #
  # Us:   WILL X -- X_ME = 'ASKING'
  # Them: DONT X
  # If X_ME eq 'ASKING' -> 'NONE', confirm change of plan with 'WONT X'
  # Else agree WONT X
  #
  # Them: DO X
  # If X_ME eq 'ASKING' -> 'WILL', no reply
  # Else if 'DO X' set, answer 'WILL X' (will do) -> 'WILL'
  # Else refuse 'WONT X'