|
@@ -1,159 +0,0 @@
|
|
|
-#!/usr/bin/perl
|
|
|
|
|
-
|
|
|
|
|
-use Modern::Perl;
|
|
|
|
|
-use experimental qw/smartmatch/;
|
|
|
|
|
-
|
|
|
|
|
-package telnet;
|
|
|
|
|
-
|
|
|
|
|
-use AnyEvent::Handle qw/connect/;
|
|
|
|
|
-use Mojo::Promise;
|
|
|
|
|
-use Data::Dumper;
|
|
|
|
|
-
|
|
|
|
|
-sub new
|
|
|
|
|
-{
|
|
|
|
|
- my $class = shift;
|
|
|
|
|
- my $ip = shift;
|
|
|
|
|
-
|
|
|
|
|
- return bless {ip => $ip},"telnet";
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub connect
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
-
|
|
|
|
|
- my $promise = new Mojo::Promise;
|
|
|
|
|
-
|
|
|
|
|
- $self->{handle} = new AnyEvent::Handle
|
|
|
|
|
- connect => [$self->{ip}, 23],
|
|
|
|
|
- on_prepare => sub { 30 }, # time-out
|
|
|
|
|
- on_connect => sub { $promise->resolve },
|
|
|
|
|
- on_connect_error => sub { $promise->reject("$self->{ip}: " . $_[1]) },
|
|
|
|
|
- on_rtimeout => sub
|
|
|
|
|
- {
|
|
|
|
|
- if ($self->{promise})
|
|
|
|
|
- {
|
|
|
|
|
- $self->{promise}->reject("$self->{ip}: read timeout");
|
|
|
|
|
- }
|
|
|
|
|
- else
|
|
|
|
|
- {
|
|
|
|
|
- say "telnet error: timeout";
|
|
|
|
|
- }
|
|
|
|
|
- },
|
|
|
|
|
- on_error => sub {
|
|
|
|
|
- my ($hdl, $fatal, $msg) = @_;
|
|
|
|
|
- $hdl->destroy;
|
|
|
|
|
- if ($self->{promise})
|
|
|
|
|
- {
|
|
|
|
|
- $self->{promise}->reject("$self->{ip}: $msg");
|
|
|
|
|
- }
|
|
|
|
|
- else
|
|
|
|
|
- {
|
|
|
|
|
- say "telnet error: $msg";
|
|
|
|
|
- }
|
|
|
|
|
- };
|
|
|
|
|
-
|
|
|
|
|
- return $promise;
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub print
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- my $line = shift;
|
|
|
|
|
-
|
|
|
|
|
- say STDERR ">>> $line" if $self->{debug};
|
|
|
|
|
- $self->{handle}->push_write("$line\r\n");
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub _new_promise
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
-
|
|
|
|
|
- $self->{promise} = new Mojo::Promise;
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub _wait_for
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- my $re = shift;
|
|
|
|
|
-
|
|
|
|
|
- say STDERR "### waiting for ", $re if $self->{debug};
|
|
|
|
|
-
|
|
|
|
|
- $self->{handle}->rtimeout(60);
|
|
|
|
|
- $self->{handle}->push_read(regex => $re, sub
|
|
|
|
|
- {
|
|
|
|
|
- my ($h, $text) = @_;
|
|
|
|
|
-
|
|
|
|
|
- $h->rtimeout(0);
|
|
|
|
|
- my @lines = split(/\n/, $text);
|
|
|
|
|
-
|
|
|
|
|
- if ($self->{debug})
|
|
|
|
|
- {
|
|
|
|
|
- say "<<< $_" for @lines;
|
|
|
|
|
- }
|
|
|
|
|
-
|
|
|
|
|
- shift(@lines);
|
|
|
|
|
-
|
|
|
|
|
- @lines = map { s/\r//g; $_ } @lines;
|
|
|
|
|
-
|
|
|
|
|
- $self->{promise}->resolve(@lines) if $self->{promise};
|
|
|
|
|
- });
|
|
|
|
|
-
|
|
|
|
|
- return $self->{promise};
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub waitfor
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- my $re = shift;
|
|
|
|
|
-
|
|
|
|
|
- $self->_new_promise;
|
|
|
|
|
- return $self->_wait_for($re);
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub prompt
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- my $re = shift;
|
|
|
|
|
-
|
|
|
|
|
- $self->{prompt} = $re;
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub cmd
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- my $line = shift;
|
|
|
|
|
-
|
|
|
|
|
- $self->_new_promise;
|
|
|
|
|
- $self->print($line);
|
|
|
|
|
-
|
|
|
|
|
- return $self->_wait_for($self->{prompt});
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub reply
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- my $re = shift;
|
|
|
|
|
- my $line = shift;
|
|
|
|
|
-
|
|
|
|
|
- $self->_new_promise;
|
|
|
|
|
-
|
|
|
|
|
- return $self->_wait_for($re)->then(sub
|
|
|
|
|
- {
|
|
|
|
|
- $self->print($line);
|
|
|
|
|
- });
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub close
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- undef $self->{handle};
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-sub debug
|
|
|
|
|
-{
|
|
|
|
|
- my $self = shift;
|
|
|
|
|
- my $flag = shift;
|
|
|
|
|
- $self->{debug} = $flag;
|
|
|
|
|
-}
|
|
|
|
|
-
|
|
|
|
|
-1;
|
|
|