#!/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;