Код:
#!/usr/bin/perl -w
use strict;
use Net::Telnet ();
my $debug = 0;
my ($host, $pass) = ('host', 'pass');
my $tln = telnet_2110_connect($host, $pass);
if ($tln->errmsg()) {
print(sprintf("%s\t %s\n", $host, $tln->errmsg()));
} else {
print qq(TELNET ACTIVE\n);
$tln->close();
}
exit;
#**********************************************
sub telnet_2110_connect {
my $host = shift || '';
my $pass = shift || 'none';
my ($t, $ans, $debug, $answ);
if ($debug) {
$t = new Net::Telnet (
Timeout => 3,
Telnetmode => 0,
Binmode => 0,
Dump_Log => 'dump.hex',
Option_log => 'options.log',
Input_log => 'telnet_i.log',
Output_log => 'telnet_o.log'
);
} else {
$t = new Net::Telnet (
Telnetmode => 0,
Binmode => 0,
Timeout => 3,
Errmode => 'return'
);
}
$t->open(Host => $host,
Errmode => 'return'
);
return $t if $t->errmsg();
$t->get(Errmode => 'return', Timeout => 0.5);
return $t if $t->errmsg();
#DO ECHO
#SB NAWS IS 0x50 0 0x18 SE
$t->print(chr(255) . chr(253) . chr(1) .
chr(255) . chr(250) . chr(31) . chr(0). chr(80) . chr(0) . chr(24) . chr(255) . chr(240));
$t->get(Errmode => 'return', Timeout => 0.5);
return $t if $t->errmsg();
#SB TERMINAL TYPE IS ... SE
#
$t->print(chr(255) . chr(250) . chr(24) . chr(0). chr(88) . chr(84) . chr(82) . chr(77) . chr(255) . chr(240));
$t->get(Errmode => 'return', Timeout => 0.5);
return $t if $t->errmsg();
$t->waitfor(Match => '/password:/i',
Errmode => 'return',
Timeout => 1);
$ans = telnet_2110_cmd($pass, $t, 1, '\>|invalid');
if (not defined $ans) {
$t->errmsg('No replay');
return $t;
}
if ($ans =~ /invalid/igo) {
$t->errmsg($answ);
return $t;
}
return $t;
}
#**********************************************
sub telnet_2110_cmd {
my $cmd = shift || return undef;
my $t = shift || return undef;
my $prnt = shift || 0;
my $regx = shift || undef;
my $tmout = shift || 0.5;
my ($ans, $ret);
foreach (split '', $cmd) {
$t->put($_);
select undef, undef, undef, 0.5;
}
$t->put(chr(13));
return if not $prnt;
while ($ans = $t->get(Errmode => 'return', Timeout => $tmout)) {
$ret .= $ans;
if (defined $regx) {
last if $ans =~ /$regx/i;
}
}
return $ret;
}