prompt results from the CPAN

prompt
App-Tel
view release on metacpan or search on metacpan
        $self->{colors}->load_syntax($profile->{syntax});
        $profile->{profile_name}=$_;
    }

    # add some sane defaults if the profile doesn't have them
    $profile->{'user'} ||= $ENV{'USER'} || $ENV{'LOGNAME'};
    # need to warn if user is still not defined?
    $self->{'profile'}=$profile;
    return $profile;
}

sub _stty_rows {
    my $new_rows = shift;
    eval {
        Module::Load::load Term::ReadKey;
        my ($columns, undef, $xpix, $ypix) = GetTerminalSize(\*STDOUT);
        SetTerminalSize($columns, $new_rows, $xpix, $ypix, \*STDOUT);
    };

    warn $@ if ($@);
}

=head2 password

    my $password = $self->password;

This pulls the password from the config.  If the password is blank it checks
to see if you have a password manager, then tries to load the password from
there.  It then tries to use an OS keyring.

By default it will pull the regular password.  To pull the enable password
you can call it with $self->password('enable');

=cut

sub password {
    my ($self, $type) = @_;
    my $profile = $self->profile;
    my $router = $self->{hostname};

    $type ||= 'password';

    warn "Unknown password type $type" if ($type ne 'password' && $type ne 'enable');

    if (defined($profile->{$type}) && $profile->{$type} ne '') {
        return $profile->{$type};
    }

    # if enable is blank but password has something then use the same password
    # for enable.
    if ($type eq 'enable' and $profile->{$type} eq '' && $profile->{'password'} ne '') {
        return $profile->{'password'};
    }

    # if we get here, the password is blank so try other means
    my $pass = App::Tel::Passwd::load_from_profile($profile);
    if ($pass ne '') {
        return $pass;
    }

    # I was wondering how to decide what to prompt for, but I think it should
    # be whichever profile loaded.  So maybe we check for hostname and check
    # for profile name and then save as profile name. If they want to be
    # explicit they should specify the password format as KEYRING or
    # something.. I dunno.
    App::Tel::Passwd::keyring($profile->{user}, $profile->{profile_name}, $profile->{profile_name});

    # if they make it here and still don't have a password then none was
    # defined anywhere and we probably should prompt for one.  Consider
    # turning off echo then normal read.
    return App::Tel::Passwd::input_password($router);
}

=head2 session

    my $session = $self->session;

Expect won't let you reuse a connection that has spawned a process, so you
can call this with an argument to reset the session.  If called without an
argument it will return the current session (If it exists) or create a new
session.

=cut

sub session {
    return $_[0]->{'session'} if (!$_[1] && defined($_[0]->{'session'}));

    my $self = shift;
    my $session = $self->{'session'};

    $session->soft_close() if ($session && $session->pid());
    $session = Expect->new;

    # install sig handler for window size change
    $SIG{WINCH} = \&_winch_handler;


    $session->log_stdout(1);
    $self->{'session'} = $session;
    return $session;
}

=head2 connect

    my $session = $self->connect('routername');

This sets up the session.  If there already is a session open it closes and opens a new one.

=cut

sub connect {
    my ($self, @arguments) = @_;

    $self->connected(0);
    my $session = $self->session(1);
    $session->spawn(@arguments);
    return $session;
}

=head2 connected

    if ($self->connected);
or
    $self->connected(1);

Returns connection status, or sets the status to whatever value is supplied to
the method.

Note: This isn't the session state, but an indicator that our session has
gotten through the login stage and is now waiting for input.  i.e., the router
is at a prompt of some kind.

=cut

sub connected {
    my ($self, $status) = @_;
    if (defined($status)) {
        $self->{connected}=$status;
    }

    return $self->{connected};
}

=head2 enable

    $self->enable;

if enablecmd is set then this method attempts to enable the user.  Returns
$self.

=cut

sub enable {
    my $self = shift;
    my $profile = $self->profile;

    if ($profile->{enablecmd}) {
        $self->send($profile->{enablecmd} . "\r");

        $profile->{ena_username_prompt} ||= qr/[Uu]ser[Nn]ame:|Login:/;
        $profile->{ena_password_prompt} ||= qr/[Pp]ass[Ww]ord/;

        # we need to be able to handle routers that prompt for username and password
        # need to check the results to see if enable succeeded
        $self->expect($self->{timeout},
                [ $profile->{ena_username_prompt} => sub { $self->send("$profile->{user}\r"); exp_continue; } ],
                [ $profile->{ena_password_prompt} => sub { $self->send($self->password('enable') . "\r"); } ]
        );
    }

    $self->{enabled}=1;
    return $self;
}

=head2 enabled

    my $enabled = $self->enabled;

Check if enabled.  This returns true if the $self->enable() method succeeds.

=cut

sub enabled { $_[0]->{enabled} };

=head2 login

    $self->login("hostname");

Cycles through the connection methods trying each in the order specified by
the profile until we successfully connect to the host.  Returns $self.

=cut

sub login {
    my ($self, $hostname) = @_;

    # dumb stuff to alias $rtr to the contents of $self->{'profile'}
    # needed because we can reload the profile inside the expect loop
    # and can't update the alias.
    our $rtr;
    *rtr = \$self->{'profile'};

    my $ssho = '-o StrictHostKeyChecking=no';
    if (defined($rtr->{sshoptions}) && scalar $rtr->{sshoptions} > 0) {
        $ssho = '-o '. join(' -o ', @{$rtr->{sshoptions}});
    }
    $ssho .= $rtr->{ciphertype} ? " -c $rtr->{ciphertype}" : '';

    # because we use last METHOD; in anonymous subs this suppresses the
    # warning of "exiting subroutine via last;"
    no warnings 'exiting';
    # handle MOTD profile loading, and other things parsed from the config
    my @dynamic;
    if (defined($rtr->{prompt})) {
        push @dynamic, [ qr/$rtr->{prompt}/, sub { $self->connected(1); last METHOD; } ];
    }

    # handle prompts in foreign languages or other things we didn't think of
    $rtr->{username_prompt} ||= qr/[Uu]ser[Nn]ame:|[Ll]ogin:/;
    $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;
}

=head2 control_loop

    $self->control_loop();

This is where control should be passed once the session is logged in.  This
handles CLI commands passed via the -c option, or scripts executed with the -x
option.  It also handles auto commands passed via either option -a on the
command line, or via autocmds in the profile.

Calling this without any commands will just run interact()

=cut

sub control_loop {
    my $self = shift;
    my $profile = $self->profile;
    my $opts = $self->{opts};
    my $prompt = $profile->{prompt};
    my $pagercmd = $profile->{pagercmd};
    my $autocmds;
    my @args;

    if ($opts->{a}) {
        $autocmds = [ split(/;/, $opts->{a}) ];
    } else {
        $autocmds = $profile->{autocmds};
    }

    $self->_winch();

    # should -c override -x or be additive? or error if both are specified?

    @args = split(/;/, $opts->{c}) if ($opts->{c});

    if ($opts->{x}) {
        for (@{$opts->{x}}) {
            open(my $X, '<', $_) || die "Can't open file $_\n";
            push(@args,<$X>);
            close $X;
        }
    }

    if (@args) {
        $self->expect($self->{timeout},'-re',$prompt);
        if (ref($pagercmd) eq 'CODE') {
            $pagercmd->();
        } elsif ($pagercmd) {
            $self->run_commands("$pagercmd");
        }
        $self->run_commands(@args);
        $self->send($profile->{logoutcmd} ."\r");
    } else {
        die 'STDIN Not a tty' if (!POSIX::isatty($self->{stdin}));
        if ($autocmds) {
            $self->expect($self->{timeout},'-re',$prompt);
            eval { $self->run_commands(@$autocmds); };
            return $self if ($@);
        }

        my $color_cb = sub {
            my ($session) = @_;
            $self->_winch() if $_winch_it;
            ${*$session}{exp_Pty_Buffer} = $self->{colors}->colorize(${*$session}{exp_Pty_Buffer});
            return 1;
        };

        my $sleep_cb = sub {
            sleep($self->{opts}->{S});
            return 1;
        };
        $self->session->set_cb($self->session,$color_cb, [ \${$self->session} ]);
        $self->{stdin}->set_seq("\r",$sleep_cb) if ($self->{opts}->{S});
        $self->session->interact($self->{stdin}, '\cD');
        # q\b is to end anything that's at a More prompt or other dialog and
        # get you back to the command prompt
        # would be nice to detect if the session is closing down and not send
        # this.  I've tried checking for session and session->pid but they
        # both still exist at this point so unless we wait for soft_close
        # we're kinda stuck doing this.
        $self->send("q\b" . $profile->{logoutcmd}. "\r");
    }
    return $self;
}

1;
( run in 0.589 second using v1.01-cache-2.11-cpan-6aa56a78535 )