I can't quite see the point of reading 1 char at a time, but a small variation on the server I posted in 832715 should do the job. I've only tested it on Windows, but it should run on *nix:

#! perl -slw
use strict;
use threads;
use threads::shared;
use Thread::Queue;
use IO::Socket;

my $semSTDOUT :shared;
sub tprint{ lock $semSTDOUT; print @_; }
$|++;

my %cache;
my $Qwork = new Thread::Queue;
my $Qdone = new Thread::Queue;

my $done :shared = 0;
sub worker {
    my $tid = threads->tid;
    while( my $fno = $Qwork->dequeue ) {
        open my $client, "+<&", $fno or die $!;
        tprint "$tid: Duped $fno to $client";
        my $buffer = '';
        while( my $c = sysread( $client, $buffer, 1, length $buffer ) 
+) {
            syswrite( $client, $buffer, 1, length( $buffer ) -1 );
            while( $buffer =~ s[(^[^\n]+)\n][]g ) {
                tprint "$tid: got and echoed $1";
            }
            last if $done;
        }
        close $client;
        $Qdone->enqueue( $fno );
        tprint "$tid: $client closed";
    }
}

our $W //= 4;

my $lsn = new IO::Socket::INET(
    Listen => 5, LocalPort => '12345'
) or die "Failed to open listening port: $!\n";

my @workers = map threads->create( \&worker, \%cache ), 1 .. $W;
$SIG{ INT } = sub {
    close $lsn;
    $done = 1;
    $Qwork->enqueue( (undef) x $W );
};

while( my $client = $lsn->accept ) {
    my $fno = fileno $client;
    $cache{ $fno } = $client;
    $Qwork->enqueue( $fno );
    delete $cache{ $Qdone->dequeue } while $Qdone->pending;
}
tprint "Listener closed";
$_->join for @workers;
tprint "Workers done";
[download]

You can stress test it locally with this (thought this might leak memory on *nix apparently):

#! perl -slw
use strict;
use threads;
use IO::Socket;

our $W //= 10;

my @t = map{
    async {
        for( 1 .. rand 1000 ) {
            my $s = new IO::Socket::INET(
                'localhost:12345'
            ) or die "Failed to connect to server: $!";
            for( 1 .. rand 1000 ) {
                print $s "Message $_";
                scalar <$s>;
            }
            close $s;
        }
    };
} 1 .. $W;

$_->join for @t;
[download]

I would suggest using a more maintained and mature module like IO::Socket::Telnet::HalfDuplex.

For your error, the problem is that you're probably not connecting to a real terminal, I'm guessing you want the telnet running on localhost.

Also, please tell us what you're trying to accomplish with single character read. It's not really what telnet is about, and perhaps you don't really want telnet either since it isn't at all secure.

HTH,
SSF

I tried to use HalfDuplex module, but I have the same problem.

sub Terminal
{
    my ($server, $client) = @_;
    my $input;
    my $key;
    
    while (1) 
    {
        #ReadMode(4, $client);
        while (not defined ($key = ReadKey(0, $client))) {};
        #ReadMode(0, $client);
        if ($key eq "q")
        {
            return 1;
        }
        else
        {
            print "Got character '" . ord($key) . "'\r\n";
        }
    };
    
    return 0;
}

my $server = IO::Socket::Telnet::HalfDuplex->new
( 
    Proto => 'tcp', 
    LocalPort => 23, 
    Listen => SOMAXCONN, 
    Reuse => 1
); 

print "Starting server\n";

while (my $client = $server->accept()) 
{ 
    Terminal($server, $client);
    
    close $client;
}
[download]

The same problem occur when I don't use localhost. What I'm tring to accomplish is a terminal that will be somewhat like cisco terminal, meaning it will auto complete options when I press <tab> or <?> Thanks, Dayan Shay

Someone? I simply want a tcp server that read a single character from the client. I don't care how.