view release on metacpan or  search on metacpan

lib/App/Tel.pm  view on Meta::CPAN

    $rtr->{password_prompt} ||= qr/[Pp]ass[Ww]ord/;

    $self->{port} ||= $self->{opts}->{p} || $rtr->{port}; # get port from CLI or the profile
    # if it's not set in the profile or CLI above, it gets set in the
    # method below, but needs to be reset on each loop to change from
    # telnet to ssh defaults

    my $family = '';
    $family = '-4' if ($self->{opts}->{4});
    $family = '-6' if ($self->{opts}->{6});

    METHOD: for (@{$self->methods}) {
        my $p = $self->{port};
        if    ($_ eq 'ssh')     { $p ||= 22; $self->connect("ssh $family -p $p -l $rtr->{user} $ssho $hostname"); }
        elsif ($_ eq 'telnet')  { $p ||= ''; $self->connect("telnet $family $hostname $p"); }
        elsif ($_ eq 'test')    { $self->_test_connect($hostname); }
        else { die "No program defined for method $_\n"; }

        # suppress stdout if needed
        $self->session->log_stdout($self->{log_stdout});

        # need to make this optional
        # also need to make it display whatever the user cares about.
        print "\e[22t\033]0;$_ $hostname\007";
        $self->{title_stack}++;
        $SIG{INT} = sub { for (1..$self->{title_stack}) { print "\e[23t"; } $self->{title_stack}=0; };

        $self->expect($self->{timeout},
                @{$self->_banners},
                @dynamic,
                [ $rtr->{username_prompt} => sub {
                    $self->send("$rtr->{user}\r");
                    exp_continue;
                } ],
                [ $rtr->{password_prompt} => sub {
                    $self->send($self->password() ."\r");
                    $self->connected(1);
                    last METHOD;
                } ],
                [ qr/Name or service not known|hostname nor servname provided, or not known|could not resolve / => sub
                    {
                        # if host lookup fails then check to see if there is an alternate method defined
                        if ($rtr->{hostsearch} && !$rtr->{hostsearched}) {
                            $hostname = &{$rtr->{hostsearch}}($hostname);
                            $rtr->{hostsearched}=1;
                            redo METHOD;
                        } else {
                            warn "unknown host: $hostname\n";
                            # skip to next host if this one doesn't exist
                            last METHOD;
                       }
                    }
                ],
                # almost never needed anymore.  Some people might not want a
                # fallback to des.  If anyone does we need to make it optional
                #[ qr/cipher type \S+ not supported/ => sub { $rtr->{ciphertype}="des"; redo METHOD; } ],

                # removing these 4, they should be handled by eof anyway
                #[ qr/ssh_exchange_identification/ => sub { next METHOD; } ],
                #[ qr/[Cc]onnection (refused|closed)/ => sub { next METHOD; } ],
                #[ qr/key_verify failed/ => sub { next METHOD; } ],
                #[ qr/Corrupted/ => sub { next METHOD; } ],
                [ 'eof' => sub { next METHOD; } ],
                [ 'timeout' => sub { next METHOD; } ],
        );
    }

    $rtr->{logoutcmd} ||= "logout";
    $rtr->{prompt} ||= '#';

    warn "Connection to $hostname failed.\n" if !$self->connected;
    return $self;
}

=head2 logging

    $self->logging('filename');

Turns on logging for this session.  If you specify a filename it will log to
/tmp/<filename>.log, otherwise it will use /tmp/<hostname>.log.

=cut

sub logging {
    my $self = shift;
    return $self if (!$self->{opts}->{l});

    my $file = shift;
    $file ||= $self->{hostname};
    unlink ("/tmp/$file.log") if (-f "/tmp/$file.log");
    $self->session->log_file("/tmp/$file.log");
    return $self;
}

=head2 run_commands

    $self->run_commands(@commands);

TODO: Document this


=cut

sub run_commands {
    my $self = shift;
    my $opts = $self->{opts};

    foreach my $arg (@_) {
        $arg =~ s/\\r/\r/g; # fix for reload\ry.  I believe 'perldoc quotemeta' explains why this happens
        chomp($arg);
        $self->send("$arg\r");
        $self->expect($self->{timeout},
            [ $self->profile->{prompt} => sub { } ],
            [ 'eof' => sub { die "EOF From host.\n"; } ],
        );
        sleep($opts->{s}) if ($opts->{s});
    }

    return $self;
}