Control-CLI
view release on metacpan or search on metacpan
1.05 2013-08-25
* As of this version, Telnet & SSH connections can now be run over IPv6, as long as IO::Socket::IP is installed
* SSH failed connection now gives error message "SSH unable to connect" instead of "SSH unable to password authenticate"
* Net-SSH2 (libssh2) eof still not working, and now returning a different error on disconnection; updated eof method
* Some devices have a crude SSH implementation with no authentication and instead use an interactive login after the SSH
connection is established (just like Telnet does); the connect() method is now changed to allow these SSH connections
* Added connection_timeout for Telnet and SSH connections; previously no consistent connection timeout was enforced
* Method connect() now accepts '$host [$port]' which will work for IPv6 addresses; syntax '$host[:$port]' is deprecated
* Serial port disconnect() now flushes recent writes before closing the connection; needed with Device::SerialPort
* Method waitfor() now catches invalid Perl regular expression patterns passed to it and performs the error mode action
* Added a flush_credentials method to undefine stored credentials
* Code changes to pass Perl Critic severity 4 and above violations
1.06 2014-04-21
* Method login() in list context did not return output received from host device if the login failed
* Version 1.05 on MSWin32 was not working anymore with newest Net::Telnet 3.04 (due to bug id 94913); added workaround
2.00 2014-12-31
* As of this version, methods connect(), login(), cmd() and waitfor() support a non-blocking mode for
which they now have a poll method: connect_poll(), login_poll(), cmd_poll() and waitfor_poll()
* New generic non-blocking poll() object/class method to poll multiple objects of this class simultaneously
* Method waitfor() was incorrectly setting s option on match, i.e. treating string as single line (. matches a newline)
* Method change_baudrate() was incorrectly returning undef if the requested baudrate was already set
* Error mode 'die' would always show CLI.pm as the die file and not the actual file where the error occurred
* Error message for blocking read() timeout was incorrectly reported as "Received eof from connection"
* Timer for readwait() method, previously hard coded to 100 millisecs, is now configurable via readwait_timer() method
* Method break() now accepts a configurable duration argument for generating break signal over serial port connections
* Prompt_credentials now resets Term::ReadKey ReadMode to whatever was in use before calling connect() / login()
* Debug levels are now bit based; only bits 1 & 2 are defined in this class; new debugMsg() method for sub-classes
* Added a socket method to return the IO::Socket::IP or IO::Socket::INET object
* Fixed "Can't call method "ext_data" on an undefined value at Control/CLI.pm line X" which was caused by SSH
connecting to a device that only accepts publickey authentication, with no keys provided
* SSH & Serial, methods input_log, output_log and dump_log were not returning the filehandle when called with no arguments
* All methods now handle error mode correctly if called before a connection is established or after disconnect
* Added a connected() method to check status of connection
* Carp messages from Win32::SerialPort are now always suppressed, unless debug level is active on bit1
* Method change_baudrate() now can also be used to change Parity, Databits, Stopbits and Handshake settings
* Method read(Blocking => 1, Timeout => $secs) using Device::SerialPort was ignoring the Timeout argument
* SSH connect() is now able to also handle keyboard-interactive authentication method
2.01 2015-03-08
* poll_read() and poll_readwait() were not catching errors from non-blocking read in non-blocking poll mode
* change_baudrate() was not working properly on some devices; had to add a 100ms delay between tearing down and restarting
the connection; to avoid this delay in non-blocking mode, the method is now pollable via new poll_change_baudrate()
* prompt_credentials can now be set either as a code ref or as an array ref where the 1st element is a code ref
* poll() poll_code argument will now also accept an array ref where the 1st element is a code ref
* 2.00 destroy method could cause: (in cleanup) Can't call method X on an undefined value ... during global destruction
2.02 2016-02-07
* Added data_with_error() and argument to readwait() for handling case where some data is read followed by a read error
* Sub-classing method syntax changed to more flexible hash style arguments (old list style format still accepted)
* Added match_list argument to waitfor() method
* When setting error mode or prompt_credentials or poll() poll_code to an array ref with 1st element a code ref, this was
working on the first call but not in subsequent calls as the array was shifted in callCodeRef during the first call
* Sub-classing method poll_readwait() was incorrectly triggering error mode action twice on non-blocking read error
* Net::Telnet always appends a null character to carriage returns which are not followed by a line feed, which becomes
a problem (inability to login) when the output_record_separator is set to just carriage return, as required by certain
devices. Control::CLI is now enhanced with logic to prevent Net::Telnet from behaving in that manner. The new logic
consists of resetting Net::Telnet's telnetmode to 0 for the duration of any transmits over the Telnet connection.
This new logic only applies to Telnet use and only when output_record_separator() has been set to just carriage return
* Added terminal_type() and window_size() methods to negotiate terminal parameters for both SSH and Telnet connections
* Added ssh_authentication() method to indicate the ssh authentication used: publickey, password or keyboard-interactive
examples/nonblockpoll-ex1.pl view on Meta::CPAN
],
);
print "Using Control::CLI $Control::CLI::VERSION\n";
MAIN:{
my (%cli, %output);
#
# Get credentials if not already set
#
$username = promptClear("Please enter username to use for hosts") unless defined $username;
$password = promptHide("Please enter password to use for hosts") unless defined $password;
#
# Create CLI objects
#
print "\nCreated CLI object for:\n";
foreach my $host (keys %Devices) {
$cli{$host} = new Control::CLI(
Use => $connectionType,
Timeout => $timeout,
Connection_timeout => $connectionTimeout,
Input_log => $debug ? $host.'.in' : undef,
Output_log => $debug ? $host.'.out' : undef,
Dump_log => $debug ? $host.'.dump' : undef,
Blocking => 0,
Prompt_credentials => 1,
Debug => $debug,
);
print " - $host\n";
}
#
# Connect to all hosts
#
print "$connectionType connecting to hosts ";
foreach my $host (keys %cli) {
examples/nonblockpoll-ex2.pl view on Meta::CPAN
],
);
print "Using Control::CLI $Control::CLI::VERSION\n";
MAIN:{
my (%cli, %output, $count, $running, $completed);
#
# Get credentials if not already set
#
$username = promptClear("Please enter username to use for hosts") unless defined $username;
$password = promptHide("Please enter password to use for hosts") unless defined $password;
#
# Create CLI objects
#
print "\nCreated CLI object for:\n";
foreach my $host (keys %Devices) {
$cli{$host} = new Control::CLI(
Use => $connectionType,
Timeout => $timeout,
Connection_timeout => $connectionTimeout,
Input_log => $debug ? $host.'.in' : undef,
Output_log => $debug ? $host.'.out' : undef,
Dump_log => $debug ? $host.'.dump' : undef,
Blocking => 0,
Prompt_credentials => 1,
Debug => $debug,
);
print " - $host\n";
}
#
# Connect to all hosts
#
print "$connectionType connecting to hosts ";
foreach my $host (keys %cli) {
examples/nonblockpoll-ex3.pl view on Meta::CPAN
return if $count == $completed; # No further objects have completed
$count = $completed;
print "<$completed>";
}
MAIN:{
my (%cli, %output, $count);
#
# Get credentials if not already set
#
$username = promptClear("Please enter username to use for hosts") unless defined $username;
$password = promptHide("Please enter password to use for hosts") unless defined $password;
#
# Create CLI objects
#
print "\nCreated CLI object for:\n";
foreach my $host (keys %Devices) {
$cli{$host} = new Control::CLI(
Use => $connectionType,
Timeout => $timeout,
Connection_timeout => $connectionTimeout,
Input_log => $debug ? $host.'.in' : undef,
Output_log => $debug ? $host.'.out' : undef,
Dump_log => $debug ? $host.'.dump' : undef,
Blocking => 0,
Prompt_credentials => 1,
Debug => $debug,
);
print " - $host\n";
}
#
# Connect to all hosts
#
print "$connectionType connecting to hosts ";
foreach my $host (keys %cli) {
examples/nonblockpoll-ex4.pl view on Meta::CPAN
],
);
print "Using Control::CLI $Control::CLI::VERSION\n";
MAIN:{
my (%cli, %output, $count, $running, $completed, $failed, $lastCompleted, $lastFailed);
#
# Get credentials if not already set
#
$username = promptClear("Please enter username to use for hosts") unless defined $username;
$password = promptHide("Please enter password to use for hosts") unless defined $password;
#
# Create CLI objects
#
print "\nCreated CLI object for:\n";
foreach my $host (keys %Devices) {
$cli{$host} = new Control::CLI(
Use => $connectionType,
Timeout => $timeout,
Connection_timeout => $connectionTimeout,
Input_log => $debug ? $host.'.in' : undef,
Output_log => $debug ? $host.'.out' : undef,
Dump_log => $debug ? $host.'.dump' : undef,
Blocking => 0,
Prompt_credentials => 1,
Debug => $debug,
Errmode => 'return', # Always return on error
Errmsg_format => 'terse',
);
print " - $host\n";
}
#
# Connect to all hosts
#
examples/usingthreads-ex1.pl view on Meta::CPAN
#
# Return output if any
#
$output = "\nOutput from $host:\n---------------------\n" . $output if length $output;
return $output;
}
MAIN:{
#
# Get credentials if not already set
#
$username = promptClear("Please enter username to use for hosts") unless defined $username;
$password = promptHide("Please enter password to use for hosts") unless defined $password;
#
# Start threads
#
print "\nStarting threads to connect to hosts:\n";
foreach my $host (keys %Devices) {
print " - $host\n";
lib/Control/CLI.pm view on Meta::CPAN
my %Default = ( # Hash of default object settings which can be modified on a per object basis
timeout => 10, # Default Timeout value in secs
connection_timeout => undef, # Default Connection Timeout value in secs
connection_timeout_nb => 20, # If above is undefined, still need to set a value for connections in non-blocking mode
blocking => 1, # Default blocking mode
return_reference => 0, # Whether methods return data (0) or hard referece to it (1)
read_attempts => 5, # Empty reads to wait in readwait() before returning
readwait_timer => 100, # Polling loop timer for readwait() in millisecs, for further input
data_with_error => 0, # Readwait() behaviour in case of read error following some data read
prompt_credentials => 0, # Interactively prompt for credentials (1) or not (0)
tcp_port => {
SSH => 22, # Default TCP port number for SSH
TELNET => 23, # Default TCP port number for TELNET
},
read_block_size => {
SSH => 4096, # Default Read Block Size for SSH
SERIAL_WIN32 => 1024, # Default Read Block Size for Win32::SerialPort
SERIAL_DEVICE => 255, # Default Read Block Size for Device::SerialPort
},
baudrate => 9600, # Default baud rate used when connecting via Serial port
lib/Control/CLI.pm view on Meta::CPAN
report_query_status => 0, # Default setting of report_query_status for class object
prompt => '.*[\?\$%#>](?:\e\[00?m)?\s?$', # Default prompt used in login() and cmd() methods
username_prompt => '(?i:user(?: ?name)?|login)[: ]+$', # Default username prompt used in login() method
password_prompt => '(?i)(?<!new )password[: ]+$', # Default password prompt used in login() method
terminal_type => 'vt100', # Default terminal type (for SSH)
window_size => [], # Default terminal window size [width, height]
debug => 0, # Default debug level; 0 = disabled
);
our @ConstructorArgs = ( 'use', 'timeout', 'errmode', 'return_reference', 'prompt', 'username_prompt', 'password_prompt',
'input_log', 'output_log', 'dump_log', 'blocking', 'debug', 'prompt_credentials', 'read_attempts',
'readwait_timer', 'read_block_size', 'output_record_separator', 'connection_timeout', 'data_with_error',
'terminal_type', 'window_size', 'errmsg_format', 'report_query_status', 'binmode',
);
# Debug levels can be set using the debug() method or via debug argument to new() constructor
# Debug levels defined:
# 0 : No debugging
# bit 1 : Debugging activated for for polling methods + readwait() and enables carping on Win32/Device::SerialPort
# This level also resets Win32/Device::SerialPort constructor $quiet flag only when supplied in Control::CLI::new()
# bit 2 : Debugging is activated on underlying Net::SSH2 and Win32::SerialPort / Device::SerialPort
lib/Control/CLI.pm view on Meta::CPAN
TELNETMODE => 1,
PUSHBACKCR => '', # Always defined; used to push back CR in newline translation with binmode disabled
POLL => undef, # Storage hash for poll-capable methods
POLLING => 0, # Flag to track if in polling-capable method or not
POLLREPORTED => 0, # Flag used by poll() to track already reported objects
WRITEFLAG => 0, # Flag to keep track of when a write was last performed
timeout => $Default{timeout},
connection_timeout => $Default{connection_timeout},
blocking => $Default{blocking},
return_reference => $Default{return_reference},
prompt_credentials => $Default{prompt_credentials},
read_attempts => $Default{read_attempts},
readwait_timer => $Default{readwait_timer},
data_with_error => $Default{data_with_error},
read_block_size => $Default{read_block_size}{$connectionType},
ors => $Default{ors},
binmode => $Default{binmode},
errmode => $Default{errmode},
errmsg => '',
errmsg_format => $Default{errmsg_format},
prompt => $Default{prompt},
lib/Control/CLI.pm view on Meta::CPAN
elsif ($arg eq 'timeout') { $self->timeout($args{$arg}) }
elsif ($arg eq 'connection_timeout') { $self->connection_timeout($args{$arg}) }
elsif ($arg eq 'read_block_size') { $self->read_block_size($args{$arg}) }
elsif ($arg eq 'blocking') { $self->blocking($args{$arg}) }
elsif ($arg eq 'read_attempts') { $self->read_attempts($args{$arg}) }
elsif ($arg eq 'readwait_timer') { $self->readwait_timer($args{$arg}) }
elsif ($arg eq 'data_with_error') { $self->data_with_error($args{$arg}) }
elsif ($arg eq 'return_reference') { $self->return_reference($args{$arg}) }
elsif ($arg eq 'output_record_separator') { $self->output_record_separator($args{$arg}) }
elsif ($arg eq 'binmode') { $self->binmode($args{$arg}) }
elsif ($arg eq 'prompt_credentials') { $self->prompt_credentials($args{$arg}) }
elsif ($arg eq 'prompt') { $self->prompt($args{$arg}) }
elsif ($arg eq 'username_prompt') { $self->username_prompt($args{$arg}) }
elsif ($arg eq 'password_prompt') { $self->password_prompt($args{$arg}) }
elsif ($arg eq 'terminal_type') { $self->terminal_type($args{$arg}) }
elsif ($arg eq 'window_size') { $self->window_size(@{$args{$arg}}) }
elsif ($arg eq 'report_query_status') { $self->report_query_status($args{$arg}) }
elsif ($arg eq 'input_log') { $self->input_log($args{$arg}) }
elsif ($arg eq 'output_log') { $self->output_log($args{$arg}) }
elsif ($arg eq 'dump_log') { $self->dump_log($args{$arg}) }
elsif ($arg eq 'debug') { $self->debug($args{$arg}) }
lib/Control/CLI.pm view on Meta::CPAN
my $self = shift;
my %args;
if (@_ == 1) { # Method invoked in the shorthand form
$args{host} = shift;
if ($args{host} =~ /^(.+?)\s+(\d+)$/ || $args{host} =~ /^([^:\s]+?):(\d+)$/) {
($args{host}, $args{port}) = ($1, $2);
}
}
else {
my @validArgs = ('host', 'port', 'username', 'password', 'publickey', 'privatekey', 'passphrase',
'prompt_credentials', 'baudrate', 'parity', 'databits', 'stopbits', 'handshake',
'errmode', 'connection_timeout', 'blocking', 'terminal_type', 'window_size',
'callback', 'forcebaud', 'atomic_connect');
%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
}
# Initialize the base POLL structure
$self->poll_struct( # $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList
$pkgsub,
__PACKAGE__->can('connect_poll'),
defined $args{blocking} ? $args{blocking} : $self->{blocking},
lib/Control/CLI.pm view on Meta::CPAN
username => $args{username},
password => $args{password},
publickey => $args{publickey},
privatekey => $args{privatekey},
passphrase => $args{passphrase},
baudrate => $args{baudrate},
parity => $args{parity},
databits => $args{databits},
stopbits => $args{stopbits},
handshake => $args{handshake},
prompt_credentials => defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
terminal_type => $args{terminal_type},
window_size => $args{window_size},
callback => $args{callback},
forcebaud => $args{forcebaud},
atomic_connect => $args{atomic_connect},
# Declare method storage keys which will be used
stage => 0,
authPublicKey => 0,
authPassword => 0,
};
lib/Control/CLI.pm view on Meta::CPAN
my $self = shift;
my $output = join($self->{ors}, @_) . $self->{ors};
return $self->_put($pkgsub, \$output);
}
sub login { # Handles basic username/password login for Telnet/Serial login and locks onto 1st prompt
my $pkgsub = "${Package}::login";
my $self =shift;
my @validArgs = ('username', 'password', 'prompt_credentials', 'prompt', 'username_prompt', 'password_prompt',
'timeout', 'errmode', 'return_reference', 'blocking');
my %args = parseMethodArgs($pkgsub, \@_, \@validArgs);
# Initialize the base POLL structure
$self->poll_struct( # $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList
$pkgsub,
__PACKAGE__->can('login_poll'),
defined $args{blocking} ? $args{blocking} : $self->{blocking},
defined $args{timeout} ? $args{timeout} : $self->{timeout},
defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef,
1,
wantarray,
defined $args{return_reference} ? $args{return_reference} : $self->{return_reference},
undef, # n/a
);
$self->{POLL}{$pkgsub} = { # Populate structure with method arguments/storage
# Set method argument keys
username => $args{username},
password => $args{password},
prompt_credentials => defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
prompt => defined $args{prompt} ? $args{prompt} : $self->{prompt_qr},
username_prompt => defined $args{username_prompt} ? $args{username_prompt} : $self->{username_prompt_qr},
password_prompt => defined $args{password_prompt} ? $args{password_prompt} : $self->{password_prompt_qr},
# Declare method storage keys which will be used
stage => 0,
login_attempted => undef,
};
local $self->{POLLING} = 1; # True until we come out of this polling-capable method
local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};
return __PACKAGE__->can('poll_login')->($self, $pkgsub); # Do not call a sub-classed version
lib/Control/CLI.pm view on Meta::CPAN
sub binmode { # Set/read bimode
my ($self, $newSetting) = @_;
my $currentSetting = $self->{binmode};
$self->{binmode} = $newSetting if defined $newSetting;
return $currentSetting;
}
sub prompt_credentials { # Set/read prompt_credentials mode
my $pkgsub = "${Package}::prompt_credentials";
my ($self, $newSetting) = @_;
my $currentSetting = $self->{prompt_credentials};
if (defined $newSetting) {
if (ref($newSetting) && !validCodeRef($newSetting)) {
carp "$pkgsub: First item of array ref must be a code ref";
}
$self->{prompt_credentials} = $newSetting;
}
return $currentSetting;
}
sub flush_credentials { # Clear the stored username, password, passphrases, if any
my $self = shift;
$self->{USERNAME} = $self->{PASSWORD} = $self->{PASSPHRASE} = undef;
return 1;
}
sub prompt { # Read/Set object prompt
my ($self, $newSetting) = @_;
my $currentSetting = $self->{prompt};
if (defined $newSetting) {
lib/Control/CLI.pm view on Meta::CPAN
my $pkgsub = shift;
my $pollsub = "${Package}::connect";
unless ($self->{POLLING}) { # Sanity check
my (undef, $fileName, $lineNumber) = caller;
croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
}
unless (defined $self->{POLL}{$pollsub}) { # Only applicable if called from another method already in polling mode
my @validArgs = ('host', 'port', 'username', 'password', 'publickey', 'privatekey', 'passphrase',
'prompt_credentials', 'baudrate', 'parity', 'databits', 'stopbits', 'handshake',
'errmode', 'connection_timeout', 'terminal_type', 'window_size', 'callback',
'forcebaud', 'atomic_connect');
my %args = parseMethodArgs($pkgsub, \@_, \@validArgs, 1);
if (@_ && !%args) { # Legacy syntax
($args{host}, $args{port}, $args{username}, $args{password}, $args{publickey}, $args{privatekey}, $args{passphrase}, $args{baudrate},
$args{parity}, $args{databits}, $args{stopbits}, $args{handshake}, $args{prompt_credentials}, $args{timeout}, $args{errmode}) = @_;
}
# In which case we need to setup the poll structure here (the main poll structure remains unchanged)
$self->{POLL}{$pollsub} = { # Populate structure with method arguments/storage
# Set method argument keys
host => $args{host},
port => $args{port},
username => defined $args{username} ? $args{username} : $self->{USERNAME},
password => defined $args{password} ? $args{password} : $self->{PASSWORD},
publickey => $args{publickey},
privatekey => $args{privatekey},
passphrase => defined $args{passphrase} ? $args{passphrase} : $self->{PASSPHRASE},
baudrate => $args{baudrate},
parity => $args{parity},
databits => $args{databits},
stopbits => $args{stopbits},
handshake => $args{handshake},
prompt_credentials => defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
terminal_type => $args{terminal_type},
window_size => $args{window_size},
callback => $args{callback},
forcebaud => $args{forcebaud},
atomic_connect => $args{atomic_connect},
# Declare method storage keys which will be used
stage => 0,
authPublicKey => 0,
authPassword => 0,
# Declare keys to be set if method called from another polled method
lib/Control/CLI.pm view on Meta::CPAN
return $self->poll_return(0) unless $self->{POLL}{blocking};
}
else {
carp "$pkgsub: Callback is not a valid code ref; ignoring";
}
}
}
if ($connect->{stage} < 4) { # Find out available SSH authentication options
$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
unless ( defined $connect->{username} ) {
return $self->poll_return($self->error("$pkgsub: Username required for SSH authentication")) unless $connect->{prompt_credentials};
$connect->{username} = promptCredential($connect->{prompt_credentials}, 'Clear', 'Username');
# Reset timeout endtime
$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
}
if ( !$self->{POLL}{blocking} && time > $self->{POLL}{endtime} ) { # Check if over time in non-blocking mode
return $self->poll_return($self->error("$pkgsub: connection timeout expired (before auth_list)"));
}
my @authList = $self->{PARENT}->auth_list($connect->{username});
foreach my $auth (@authList) {
$connect->{authPublicKey} = 1 if $auth eq 'publickey';
$connect->{authPassword} |= 1 if $auth eq 'password'; # bit1 = password
lib/Control/CLI.pm view on Meta::CPAN
if ($connect->{authPublicKey}) { # Try Public Key authentication...
if (defined $connect->{publickey} && defined $connect->{privatekey}) { # ... if we have keys
return $self->poll_return($self->error("$pkgsub: Public Key '$connect->{publickey}' not found"))
unless -e $connect->{publickey};
return $self->poll_return($self->error("$pkgsub: Private Key '$connect->{privatekey}' not found"))
unless -e $connect->{privatekey};
unless ($connect->{passphrase}) { # Passphrase not provided
my $passphReq = passphraseRequired($connect->{privatekey});
return $self->poll_return($self->error("$pkgsub: Unable to read Private key")) unless defined $passphReq;
if ($passphReq) { # Passphrase is required
return $self->poll_return($self->error("$pkgsub: Passphrase required for Private Key")) unless $connect->{prompt_credentials};
# We are allowed to prompt for it
$connect->{passphrase} = promptCredential($connect->{prompt_credentials}, 'Hide', 'Passphrase for Private Key');
# Reset timeout endtime
$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
}
}
if ( !$self->{POLL}{blocking} && time > $self->{POLL}{endtime} ) { # Check if over time in non-blocking mode
return $self->poll_return($self->error("$pkgsub: connection timeout expired (before auth_publickey"));
}
$ok = $self->{PARENT}->auth_publickey(
$connect->{username},
$connect->{publickey},
$connect->{privatekey},
$connect->{passphrase},
);
if ($ok) { # Store the passphrase used if publickey authentication succeded
$self->{PASSPHRASE} = $connect->{passphrase} if $connect->{passphrase};
$self->{SSHAUTH} = 'publickey';
}
elsif ( !($connect->{authPassword} && (defined $connect->{password} || $connect->{prompt_credentials})) ) {
# Unless we can try password authentication next, throw an error now
return $self->poll_return($self->error("$pkgsub: SSH unable to publickey authenticate"));
}
return $self->poll_return(0) unless $self->{POLL}{blocking};
}
elsif (!$connect->{authPassword}) { # If we don't have the keys and publickey authentication was the only one possible
return $self->poll_return($self->error("$pkgsub: Only publickey SSH authenticatication possible and no keys provided"));
}
}
}
if ($connect->{stage} < 6) { # Try password authentication
$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
if ($connect->{authPassword} && !$self->{PARENT}->auth_ok) { # Try password authentication if not already publickey authenticated
unless ( defined $connect->{password} ) {
return $self->poll_return($self->error("$pkgsub: Password required for password authentication")) unless $connect->{prompt_credentials};
$connect->{password} = promptCredential($connect->{prompt_credentials}, 'Hide', 'Password');
# Reset timeout endtime
$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
}
if ( !$self->{POLL}{blocking} && time > $self->{POLL}{endtime} ) { # Check if over time in non-blocking mode
return $self->poll_return($self->error("$pkgsub: connection timeout expired (before auth_password)"));
}
if ($connect->{authPassword} & 1) { # Use password authentication
$self->{PARENT}->auth_password($connect->{username}, $connect->{password})
or return $self->poll_return($self->error("$pkgsub: SSH unable to password authenticate"));
$self->{SSHAUTH} = 'password';
lib/Control/CLI.pm view on Meta::CPAN
my $self = shift;
my $pkgsub = shift;
my $pollsub = "${Package}::login";
unless ($self->{POLLING}) { # Sanity check
my (undef, $fileName, $lineNumber) = caller;
croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
}
unless (defined $self->{POLL}{$pollsub}) { # Only applicable if called from another method already in polling mode
my @validArgs = ('username', 'password', 'prompt_credentials', 'prompt', 'username_prompt', 'password_prompt', 'timeout', 'errmode');
my %args = parseMethodArgs($pkgsub, \@_, \@validArgs, 1);
if (@_ && !%args) { # Legacy syntax
($args{username}, $args{password}, $args{prompt}, $args{username_prompt}, $args{password_prompt},
$args{prompt_credentials}, $args{timeout}, $args{errmode}) = @_;
}
# In which case we need to setup the poll structure here (the main poll structure remains unchanged)
$self->{POLL}{$pollsub} = { # Populate structure with method arguments/storage
# Set method argument keys
username => defined $args{username} ? $args{username} : $self->{USERNAME},
password => defined $args{password} ? $args{password} : $self->{PASSWORD},
prompt => defined $args{prompt} ? $args{prompt} : $self->{prompt_qr},
username_prompt => defined $args{username_prompt} ? $args{username_prompt} : $self->{username_prompt_qr},
password_prompt => defined $args{password_prompt} ? $args{password_prompt} : $self->{password_prompt_qr},
prompt_credentials => defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
# Declare method storage keys which will be used
stage => 0,
login_attempted => undef,
# Declare keys to be set if method called from another polled method
errmode => $args{errmode},
};
# Cache poll structure keys which this method will use
$self->poll_struct_cache($pollsub, $args{timeout});
}
my $login = $self->{POLL}{$pollsub};
lib/Control/CLI.pm view on Meta::CPAN
if ($self->{POLL}{local_buffer} =~ /$login->{username_prompt}/) { # Handle username prompt
if ($login->{login_attempted}) {
return $self->poll_return($self->error("$pkgsub: Incorrect Username or Password"));
}
unless ($login->{username}) {
if ($self->{TYPE} eq 'SSH') { # If an SSH connection, we already have the username
$login->{username} = $self->{USERNAME};
}
else {
unless ($login->{prompt_credentials}) {
$self->{LOGINSTAGE} = 'username';
return $self->poll_return($self->error("$pkgsub: Username required"));
}
$login->{username} = promptCredential($login->{prompt_credentials}, 'Clear', 'Username');
}
}
$self->print(line => $login->{username}, errmode => 'return')
or return $self->poll_return($self->error("$pkgsub: Unable to send username // ".$self->errmsg));
$self->{LOGINSTAGE} = '';
$login->{login_attempted} =1;
$self->{POLL}{local_buffer} = '';
next;
}
if ($self->{POLL}{local_buffer} =~ /$login->{password_prompt}/) { # Handle password prompt
unless (defined $login->{password}) {
unless (defined $login->{prompt_credentials}) {
$self->{LOGINSTAGE} = 'password';
return $self->poll_return($self->error("$pkgsub: Password required"));
}
$login->{password} = promptCredential($login->{prompt_credentials}, 'Hide', 'Password');
}
$self->print(line => $login->{password}, errmode => 'return')
or return $self->poll_return($self->error("$pkgsub: Unable to send password // ".$self->errmsg));
$self->{LOGINSTAGE} = '';
$self->{POLL}{local_buffer} = '';
next;
}
}} until ($self->{POLL}{local_buffer} =~ /($login->{prompt})/);
$self->{LASTPROMPT} = $1;
$self->{WRITEFLAG} = 0;
lib/Control/CLI.pm view on Meta::CPAN
[Errmode => $errmode,]
[Errmsg_format => $msgFormat,]
[Return_reference => $flag,]
[Prompt => $prompt,]
[Username_prompt => $usernamePrompt,]
[Password_prompt => $passwordPrompt,]
[Input_log => $fhOrFilename,]
[Output_log => $fhOrFilename,]
[Dump_log => $fhOrFilename,]
[Blocking => $flag,]
[Prompt_credentials => $flag,]
[Read_attempts => $numberOfReadAttemps,]
[Readwait_timer => $millisecs,]
[Data_with_error => $flag,]
[Read_block_size => $bytes,]
[Output_record_separator => $ors,]
[Terminal_type => $string,]
[Window_size => [$width, $height],]
[Report_query_status => $flag,]
[Debug => $debugFlag,]
);
lib/Control/CLI.pm view on Meta::CPAN
$ok = $obj->connect($host[:$port]); # Deprecated
$ok = $obj->connect(
[Host => $host,]
[Port => $port,]
[Username => $username,]
[Password => $password,]
[PublicKey => $publicKey,]
[PrivateKey => $privateKey,]
[Passphrase => $passphrase,]
[Prompt_credentials => $flag,]
[BaudRate => $baudRate,]
[ForceBaud => $flag,]
[Parity => $parity,]
[DataBits => $dataBits,]
[StopBits => $stopBits,]
[Handshake => $handshake,]
[Connection_timeout => $secs,]
[Blocking => $flag,]
[Errmode => $errmode,]
[Terminal_type => $string,]
lib/Control/CLI.pm view on Meta::CPAN
$ok = $obj->connect($host[:$port]); # Deprecated
$ok = $obj->connect(
Host => $host,
[Port => $port,]
[Username => $username,]
[Password => $password,]
[PublicKey => $publicKey,]
[PrivateKey => $privateKey,]
[Passphrase => $passphrase,]
[Prompt_credentials => $flag,]
[Connection_timeout => $secs,]
[Blocking => $flag,]
[Errmode => $errmode,]
[Terminal_type => $string,]
[Window_size => [$width, $height],]
[Callback => \&codeRef,]
[Atomic_connect => $flag,]
);
If not specified, the default port number for SSH is 22.
A username must always be provided for all SSH connections. If not provided and prompt_credentials is true then this method will prompt for it.
Once the SSH connection is established, this method will attempt one of two possible authentication types, based on the accepted authentications of the remote host:
=over 4
=item *
B<Publickey authentication> : If the remote host accepts it and the method was supplied with public/private keys. The public/private keys need to be in OpenSSH format. If the private key is protected by a passphrase then this must also be provided or...
=item *
B<Password authentication> : If the remote host accepts either 'password' or 'keyboard-interactive' authentication methods. A password must be provided or, if prompt_credentials is true, this method will prompt for the password. If password authentic...
=back
There are some devices, with a crude SSH implementation, which will accept an SSH connection without any SSH authentication, and then perform an interactive login, like Telnet does. In this case, the connect() method, will not perform any SSH authent...
The optional "prompt_credentials" argument is provided to override the global setting of the parameter by the same name which is by default false. See prompt_credentials().
If a code reference is provided via the 'callback' argument, that code will be called immediately after setting up the SSH connection and before attempting any authentication. You can use this callback to check the key of the remote host against a li...
An example on how to verify the host key against your known hosts is provided in the documentation of Net::SSH2::KnownHosts.
Note that Net::SSH2 methods remote_hostkey and known_hosts methods only exists as of version 0.54. This class does not require a minimum version of Net::SSH2 but your code will need to require a version of 0.54, or verify the availability of those me...
Instead of a code reference, an array reference can also be used provided that the first element in the array is a code reference. In this case the remainder of the array elements will be inserted as arguments to the code being called to which this c...
$ok = &$codeRef($netSsh2Obj);
($ok, [$error_message]) = &$codeRef($netSsh2Obj);
lib/Control/CLI.pm view on Meta::CPAN
On failure the error mode action is performed. See errmode().
Note that most devices have a limited input buffer and if you try and send too many commands in this manner you risk losing some of them at the far end. It is safer to send commands one at a time using the cmd() method which will acknowledge each com...
=item B<login() & login_poll()> - handle login for Telnet / Serial port
$ok = $obj->login(
[Username => $username,]
[Password => $password,]
[Prompt_credentials => $flag,]
[Prompt => $prompt,]
[Username_prompt => $usernamePrompt,]
[Password_prompt => $passwordPrompt,]
[Blocking => $flag,]
[Timeout => $secs,]
[Errmode => $errmode,]
);
($ok, $output || $outputRef) = $obj->login(
[Username => $username,]
[Password => $password,]
[Prompt_credentials => $flag,]
[Prompt => $prompt,]
[Username_prompt => $usernamePrompt,]
[Password_prompt => $passwordPrompt,]
[Blocking => $flag,]
[Timeout => $secs,]
[Return_reference => $flag,]
[Errmode => $errmode,]
);
Polling method (only applicable in non-blocking mode):
lib/Control/CLI.pm view on Meta::CPAN
In the first form only a success/failure value is returned in scalar context, while in the second form, in list context, both the success/failure value is returned as well as any output received from the host device during the login sequence; the lat...
For this method to succeed the username & password prompts from the remote host must match the default prompts defined for the object or the overrides specified via the optional "username_prompt" & "password_prompt" arguments. By default these regula...
'(?i:user(?: ?name)?|login)[: ]+$'
'(?i)(?<!new )password[: ]+$'
Following a successful authentication, if a valid CLI prompt is received, the method will return a true (1) value. The expected CLI prompt is either the globally set prompt - see prompt() - or the local override specified with the optional "prompt" a...
'.*[\?\$%#>](?:\e\[00?m)?\s?$'
On timeout or failure or if the remote host prompts for the username a second time (the method assumes that the credentials provided were invalid) then the error mode action is performed. See errmode().
If username/password are not provided but are required and prompt_credentials is true, the method will automatically prompt the user for them interactively; otherwise the error mode action is performed.
The optional "prompt_credentials" argument is provided to override the global setting of the parameter by the same name which is by default false. See prompt_credentials().
In non-blocking mode (blocking disabled) the login() method will most likely immediately return with a false, but defined, value of 0. You will then need to call the login_poll() method at regular intervals until it returns a true (1) value indicatin...
If using the login() method in non-blocking mode, the following examples illustrate how this works:
=over 4
=item *
If you do not care to retrieve the login sequence output:
lib/Control/CLI.pm view on Meta::CPAN
$prev = $obj->output_record_separator($ors);
This method gets or sets the Output Record Separator character (or string) automatically appended by print(), printlist() and cmd() methods when sending a command string to the host.
By default the Output Record Separator is a new line character "\n".
Note that by default this modules does newline translation, see binmode(), so the default new line character "\n" will always be translated to CR + LF unless binmode is enabled.
If you do not want a new line character automatically appended consider using put() instead of print().
Alternatively (or if a different character than newline is required) modify the Output Record Separator for the object via this method.
=item B<prompt_credentials()> - set whether connect() and login() methods should be able to prompt for credentials
$flag = $obj->prompt_credentials;
$prev = $obj->prompt_credentials($flag | \&codeRef | \@arrayRef);
This method gets or sets the setting for prompt_credentials for the object.
This applies to the connect() and login() methods and determines whether these methods can interactively prompt for username/password/passphrase information if these are required but not already provided. Note that enabling prompt_credentials is inco...
Prompt_credentials may be set to a code reference or an array reference (provided that the first element of the array is a code reference); in this case if the user needs to be prompted for a credential, the code reference provided will be called, fo...
=over 4
=item *
$privacy : Will be set to either 'Clear' or 'Hide', depending on whether a username or password/passphrase is requested
=item *
$credential : This will contain the text of what information is seeked from user; e.g. "Username", "Password", "Passphrase", etc.
=back
The ability to use a code reference is also true on the prompt_credentials argument override that connect() and login() offer.
If prompt_credentials is set to a true value (which is not a reference) then the object will make use of class methods promptClear() and promptHide() which both make use of Term::ReadKey. By default prompt_credentials is false (0).
=item B<flush_credentials> - flush the stored username, password and passphrase credentials
$obj->flush_credentials;
The connect() and login() methods, if successful in authenticating, will automatically store the username/password or SSH passphrase supplied to them.
These can be retrieved via the username, password and passphrase methods. If you do not want these to persist in memory once the authentication has completed, use this method to flush them. This method always returns 1.
=item B<prompt()> - set the CLI prompt match pattern for this object
$string = $obj->prompt;
$prev = $obj->prompt($string);
lib/Control/CLI.pm view on Meta::CPAN
=item B<poll_connect()> - performs a non-blocking poll for connect()
$ok = $obj->poll_connect($pkgsub,
[Host => $host,]
[Port => $port,]
[Username => $username,]
[Password => $password,]
[PublicKey => $publicKey,]
[PrivateKey => $privateKey,]
[Passphrase => $passphrase,]
[Prompt_credentials => $flag,]
[BaudRate => $baudRate,]
[Parity => $parity,]
[DataBits => $dataBits,]
[StopBits => $stopBits,]
[Handshake => $handshake,]
[Connection_timeout => $secs,]
[Errmode => $errmode,]
[Terminal_type => $string,]
[Window_size => [$width, $height],]
);
lib/Control/CLI.pm view on Meta::CPAN
These newer methods would have already set up a polling structure of their own.
When calling poll_connect() directly for the 1st time, it will detect an already existing poll structure and add itself to it (as well as caching some of it's keys; see poll_struct_cache). It will also read in the arguments provided at this point.
On subsequent calls, the arguments provided are ignored and the method simply polls the progress of the current task.
=item B<poll_login()> - performs a non-blocking poll for login()
($ok, $outputref) = $obj->poll_login($pkgsub,
[Username => $username,]
[Password => $password,]
[Prompt_credentials => $flag,]
[Prompt => $prompt,]
[Username_prompt => $usernamePrompt,]
[Password_prompt => $passwordPrompt,]
[Timeout => $secs,]
[Errmode => $errmode,]
);
Normally this is the internal method used by login() and login_poll() methods.
It is exposed so that sub classing modules can leverage the functionality within new methods themselves implementing polling.
These newer methods would have already set up a polling structure of their own.
lib/Control/CLI.pm view on Meta::CPAN
=item B<promptHide()> - prompt for password in hidden text
$password = Control::CLI::promptHide($prompt);
This method prompts (using $prompt) user to enter a value/string, typically a password or passphrase.
User input is hidden while typed in.
=item B<promptCredential()> - prompt for credential using either prompt class methods or code reference
$credential = Control::CLI::promptCredential($prompt_credentials, $privacy, $credentialNeeded);
This method should only be called when prompt_credentials is set and the value of prompt_credentials should be passed as the first argument. If prompt_credentials is not a reference and is set to a true value and privacy is 'Clear' then promptClear($...
=item B<passphraseRequired()> - check if private key requires passphrase
$yes = Control::CLI::passphraseRequired($privateKey);
This method opens the private key provided (DSA or RSA) and verifies whether the key requires a passphrase to be used.
Returns a true (1) value if the key requires a passphrase and false (0) if not.
On failure to open/find the private key provided an undefined value is returned.
( run in 0.290 second using v1.01-cache-2.11-cpan-4d50c553e7e )