[Netmail-cvs] netmail telnetd.pl,NONE,1.1

[Pascal <pas...@us...>]

Update of /cvsroot/netmail/netmail
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv21335

Added Files:
	telnetd.pl 
Log Message:
Port to Perl


--- NEW FILE: telnetd.pl ---
#!/usr/bin/perl -W

# Copyright (C) 2010  Pascal
# Originally written for http://netmail.sourceforge.net
# Licensed under the terms of the GNU GPL, the text
# of which is included as the file named "gpl.txt".

use strict;
use warnings;
use Event::Lib;
use IO::Socket::INET;

event_new(new IO::Socket::INET(LocalPort => $ARGV[0],
                               Listen    => 65535,
                               Proto     => "tcp",
                               Reuse     => 1,
                               Blocking  => 0), EV_READ|EV_PERSIST, \&listen)->add;

my @events;

event_mainloop;

sub listen {
    my $sock;
    if (($sock = $_[0]->fh->accept) && (my $remote = $sock->peerhost)) {
        print "Connection accepted from $remote\n";
        pop(@events)->remove while @events;
        $sock->blocking(0);
        push(@events, (event_new($sock, EV_READ|EV_PERSIST, \&read, \*STDOUT)->add(), event_new(\*STDIN, EV_READ|EV_PERSIST, \&read, $sock)->add()));
    }
}

sub read {
    my $sock = $_[0]->fh;
    my $data;
    if ($_[1] != EV_TIMEOUT && sysread($sock, $data, 2048) && $data) {
        syswrite($_[2], $data);
    } else {
        pop(@events)->remove while @events;
        print "Connection closed\n";
    }
}