ExecCmds - execute a set of commands against devices defined in
Index
Code Index:
NAME
ExecCmds.pm - execute a set of commands against devices defined in
perl arrays.
SYNOPSIS
use ExecCmds;
my %config = (
.
. # See CONFIG below for details
.
);
my @devs = ( x.x.x.x, y.y.y.y, .... );
my $cmds = ExecCmds->new(%config);
$cmds->run(@devices);
DESCRIPTION
Execute a number of commands against Cisco Routers and Switches for lots
and lots of them.
We fork a number of processes to handle the bulk of the work.
Default is 5 children runing at a time but that can be changed easily.
A number of Pre/Post hard and soft conditions can be defined and executed
and changes to the device aborted if conditions fail. These conditions
can be simple commands or complete Perl proggies executed over various
information retrieved from the device in question.
Basic actions performed (eventually):
- Check usage options
- Collect device information
- Do pre-condition tests and fail if appropriately
- Update Router\Switch Config
- Check Router\Switch config is correct using defined
post-conditions.
- Log all changes
CONFIG
The format for the arguments to new() and configure() are as follows.
They can be handed in via a pre-built hash or straight. A bit like
this:
ExecCmds-_new( number=>n, debug=>1, rcmds=>[], ... );
or by building up a config hash and handing that in. I recommend
building the hash and then passing it in thus:
my %config = ();
$config{'number'} = 5;
$config{'debug'} = 1;
$config{'rcmds'} = [ .... ];
.
.
@devs = ('a','b',...'c');
my $cmd = ExecCmds->new(%config);
later
$cmd->configure('verbose'=>1);
$cmd->run(@devs);
Here is a list of the config options:
number => n, is the number of children to fork to get some parrallelism
debug => 1, -d Turns on debugging dont do anything to the devices
care => 0, don't care about failures
verbose => 0, Be verbose about what is happening
pretty => 1, Add lots of useful fluff in the logs
log => 'file', where loggin should go. Into file if specified
otherwise it goes to routername.log. If you want
loggin to STDOUT use '-' as the file name. if
you want no logging use '/dev/null'
# Our router commands to execute. These commands will be fed directly
# to the router for consumption once Questions, Preconditions and
# macro processing side effects have taken place.
rcmds => [
'show ip interface brief',
'show proc cpu',
'show proc mem',
];
# An optional User/Pass/Enable combination. Each combination
# is tried in the order show. If this arrayref is empty then
# standard TACACS passwords are tried. If you want to try
# TACACS first then fall back just make the first user TACACS
# as shown below
pass => [
{'user' => 'TACACS', 'pass' => '', 'enable' => ''},
{'user' => '', 'pass' => 'b00k1ngs', 'enable' => '0r1g1n'},
{'user' => 'tzpj07', 'pass' => '0rico001', 'enable' => 'foresite'},
];
# Our router Questions. Note: this is not a Pre/Post condition, Just
# a question over the config. We print the truth or otherwise of the
# question.
r_q_regex => [
'm/access-list 55 permit/s',
];
# Our router Pre conditions. Note: Pre conditions must execute and
# return true otherwise we halt processing
r_pre_regex => [
'm/access-list 55 permit/s'
];
# Our router Post conditions. These don't effect the final execution
# but they do define if we will say everything executed OK.
r_post_regex => [
'm/access-list 55 permit/s'
];
# Our Switch commands. A distinction is made between switches and
# routers. Really IOS and CATOS devices
scmds => [
'show proc',
'show ver',
'show loggining buffer',
'show port status'
];
# Our Switch Questions. Note: this is not a Pre/Post condition
s_q_regex => [
'm/set ip permit/s',
];
# Our Switch Pre conditions
s_post_regex => [
'm/set ip permit/s',
];
# Our Switch Post conditions
s_pre_regex => [
'm/set ip permit/s',
];
DEVICES
Devices are handed to ExecCmds::run via an array reference. It
can come in two forms.
Form1 (simple) is just an array of devices to execute
against. It is the simplest way to apply the config over a
number ofdevcies.
Form2 (complex) allows name to ipaddress mapings that don't match DNS
to be used. Also allows for macro processing, copy/paste and the
like.
Here is how we normally pick up all the devices.
# Pick up all the devices names from the DB. This could be specified
# explicitly if we liked.
use IPSM::Devices;
$db = IPSM::Devices->new() || die "Can't get Device DB connection";
@devices = $db->list_devices();
But you probably dont do this. You probably use a file or DNS or your
own DB :-)
Form1
-----
%config = (....);
@devices = ( dev1, dev2, dev3, .....) ;
my $exec = ::ExecCmds->new(%config);
$exec->run(@devices);
In this case rcmds and scmds are executed against each device just
as they were defined.
Form2
-----
@devices = (
[
{'CN' => 'ddarwa01'}, # cn is the name
{'IP' => '10.145.224.249'}, # ip is the IP address to connect to
# Some commands to execute in this order
{'$snarf0' => 'cmd("sh ip interface brief")'},
{'$loop' => '$snarf0 =~ /^(Loopback\d+)\s+10.87.71.254/m'},
],
# next device
[
{'CN' => 'nbanka01'}, # cn is the name
{'IP' => '10.49.225.232'}, # ip is the IP address to connect to
# Some commands to execute in this order
{'$snarf0' => 'cmd("sh ip interface brief")'},
{'$loop' => '$snarf0 =~ /^(Loopback\d+)\s+10.69.15.254/m'},
],
.
.
.
);
$rcmds = [
'conf t',
'int %%loop%%',
'no shut',
'exit',
'wr',
'quit',
];
%config = (..,rcmds=>$rcmds ,..);
my $exec = ::ExecCmds->new(%config);
$exec->run(@devices);
In this case the name (CN) and the IP address (IP) must be defined.
CN is used to name the output messages for logging. It will be
converted to upper case. IP is used to specify the address to connect
to (just in case CN doesn't resolve).
You can also define a number of variables that will be expanded into
your $rcmds/$scmds array refs. Above we define the variable %%loop%%
The $rcmds/$scmds commands will have %%loop%% expanded on a per device
basis before commands, queries and pre/post conditions are executed.
In the above case %%loop%% is set to contain what the $loop Perl
variable has been defined as in the devices array.
$loop contains the results of the Perl code:
$snarf0 =~ /^(Loopback\d+)\s+10.87.71.254/m';
$snarf was filled with the data from running a command against the
device. The command run was "sh ip interface brief" in this case.
Each command will be executed seperately and tested to make sure it
completed properly. Any failure will fail the run on this device.
Example 1
Turn on service password encryption for a set of devices. We already
have a copy of the configs for these devices in /home/configs/current
# Setup the config hash
%config = (
# Note we use TACACS first then xyppy2, kz2ykc, and finally try without
# any user name at all.
pass => [
{'user' => 'TACACS', 'pass' => '', 'enable' => ''},
{'user' => 'xyppy2', 'pass' => 'x2dvm413', 'enable' => 'p4f2bcuw'},
{'user' => 'kz2ykc', 'pass' => 'cHarChaR', 'enable' => 'please'},
{'user' => '', 'pass' => 'smarty', 'enable' => 'dumb'},
],
# Our router commands to execute
rcmds => [
'conf t',
'service password-encryption',
'', # This is a real control Z
'wr',
],
# Our router Pre conditions say we don't want to find service
# password-encryption turned on in the running config
r_pre_regex => [
'!m/^service password-encryption/m',
],
# Our router Post conditions say we want to see that it is turned on
# after the commands have been run
r_post_regex => [
'm/^service password-encryption/m',
],
# Our Switch commands - none
scmds => [ ],
# Our Switch Pre conditions - none
s_pre_regex => [ ],
# Our Switch Post conditions - none
s_post_regex => [ ],
);
# Collect some machines
my $cmd='find /home/configs/current -type f | xargs grep -l "no service password-encryption" | perl -pe "s{/home/configs/current/}{}"';
my @devs = `$cmd`;
# Some machines 1070 actually
@devices = map { s/\.txt\n//; $_; } @devs;
my $cmds = ExecCmds->new();
$cmds->configure(%config);
$cmds->run(@devices);
new
Usage:
my $exec = ExecCmds->new();
my $exec = ExecCmds->new(%config);
Inputs:
Nothing or a hash defining current configuration data as describe
under CONFIG above
Returns:
A reference to an ExecCmds object that can later be used to
access the API
Usage:
$exec->configure(%config);
my %config = $exec->configure();
Inputs:
A hash defining current configuration data as describe
under CONFIG above
Returns:
A hash of the current configuration
run
Usage:
$exec->run(@devices);
Args:
An array of devices to execute commands against. You must have
configured the object first before this will do anything useful.
Returns:
Nothing usually unless only one device is handed in. In which
case it will return an array describing the run.
Comments:
Output is usually logged to whereever you have specified the
'log' config variable. If you didn't set 'log' then a comentary
of the run is placed in DEVICENAME.log. Where DEVICENAME is the
name of the device from @devices above.
To get a more complete output of what was done, including the
output from the device interaction make sure the 'verbose' config
variable is set to 1.
To have ONLY the interaction with the device passed back in an
array do this;
$exec->configure('pretty'=>0, 'verbose'=>1, 'log'=>'/dev/null');
foreach (@devices)
{
my @interaction = $exec->run($_);
}
That is, set 'pretty' off, 'verbose' on and call run() with only
one device specified. Passing more than one device allows run()
to fork as many processes as defined in the 'number' setting.
More comments:
The run() method will organise a number of sub processes to
execute to get the job done. To specify how many sub process you
want run you set the 'number' config variable. Default is 5.
Setting 'number' to 1 stops forking and causes only the first
device in @devices to be accessed with the results returned in an
array.
Because we use sub processes it is easier to have each process
log its interaction to a per-process file. If you defined a log
file then it will get over written unless you set the 'log'
config variable properly thus:
$exec->configure('log'=>'/tmp/mylog-%%name%%.log');
$exec->run(@devices);
Here %%name%% will be expanded to be the device name as passed
into run().
exec_dev_cmds
Usage:
This is an internal function. Don't use it unless you know what
your doing.
ExecCmds::exec_dev_cmds(....);
Args:
$dev the device to mess with
$pass a ref to an array of hashrefs containing details of
user/pass/enable to try
$router_cmds a ref to an array of commands to add to router
if it is indeed a router
$r_q_regex a ref to an array of regex's to test for. But we
dont fail the run if these fail. Just print out if is
true or false
$r_pre_regex and $r_post_regex are refs to arrays of regex's
to run over the config. These must all succeed before/after
commands. Maybe undef
$switch_cmds a ref to an array of commands to add to swtch
if it is indeed a switch
$s_q_regex a ref to an array of regex's to test for. But we
dont fail the run if these fail. Just print out if is
true or false
$s_pre_regex and $s_post_regex are refs to arrays of regex's
to run over the config.
$txt is a string that will be modified in place with
details of the run.
Returns:
A string of details of the run.
Comments:
You can ignore this method it is used internally. The run()
method uses exec_dev_cmds() to get its job done.
exec_dev_cmds adds a new setting to a router/switch config whilst
testing pre and/or post conditions over the config. Tests can also
be performed to see if something is true or not about the
router/switch.
In the case of routers we check the 'start-config' in the
post-condition regular expression and the 'running config'
in the pre-condition. The pre/post conditions can be any Perl
expression that evaluates to True. Examples are shown below.
This example shows an access-list being dropped and rebuilt and tested
for. We are checking to make sure the access-list is already there and
failing if it isn't $r_pre_regex defines this. Once the commands are
executed we do a post check $r_post_regex. The same is done for a switch
device. If we had used $r_q_regex instead the success or failure of the
test would not stop the commands from being executed.
The routine does a check on the device to work out wether it is a switch
or router or whatever and runs the appropriate commands.
$dev = 'RN-48MA-05-2610-99';
Note: conf t, exit and write should be in all $rcmds array-refs.
$rcmds = [
'conf t',
'no access-list 55',
'access-list 55 permit 10.25.159.44',
'access-list 55 permit 10.25.155.24',
'exit',
'write',
];
$pass = []; # Just default to using our DB of info
$r_q_regex = []; # No looking and testing
$r_pre_regex = ['m/access-list 55 permit/s'];
$r_post_regexp = ['m/access-list 55 permit/s'];
# switch commands here
$scmds = ['set ip permit 10.25.155.24 telnet'];
$s_q_regex = []; # No simple tests
$s_post_regex = ['m/set ip permit/s'];
$s_pre_regex = ['m/set ip permit/s'];
Here is a call to the subroutine given the above definitions. Note well
how $ret is passed in. $ret will be populated with a run down of how the
interaction went. It will contain any success\failure strings returned
from Cisco::Utility. If no \$ret is passed in then it is ignored. Pre
and Post conditions are also ignored if not defined. $s/r_q_regex arrays
are also ignored if they are empty
my $ret = '';
if (ExecCmds::exec_dev_cmds(
$dev,$pass,$rcmds,$r_q_regex, $r_pre_regex,$r_post_regexp,
$scmds,$s_q_regex,$s_pre_regex,$s_post_regex,\$ret))
{
Great it worked
}
else
{
bummer!
}
print $ret;
AUTHOR
Mark Pfeiffer <markpf@mlp-consulting.com.au>
Jeremy Nelson <jem@apposite.com.au> provided Utility functions
COPYRIGHT
Copyright (c) 2002 Mark Pfeiffer and Jeremy Nelson. All rights
reserved. This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
Cisco is a registered trade mark of Cisco Systems, Inc.
This code is in no way associated with Cisco Systems, Inc.
All other trademarks mentioned in this document are the property of
their respective owners.
DISCLAIMER
We make no warranties, implied or otherwise, about the suitability
of this software. We shall not in any case be liable for special,
incidental, consequential, indirect or other similar damages arising
from the transfer, storage, or use of this code.
This code is offered in good faith and in the hope that it may be of use.
cheers
markp
Mon May 20 13:14:39 EST 2002 or there abouts
#
# I set my vim to handle tabstops every 4 spaces
# :ts=4
#
# Utility Package used by ExecCmds
package ExecCmds::Utility;
use Socket;
# An updated Utility library which splits the login, get conf, logout process
# so that commands can be executed under enable mode.
use Net::Telnet::Cisco;
use strict;
use vars qw(@EXPORT @ISA $VERSION);
require Exporter;
$VERSION = "1.1";
@ISA = qw(Exporter);
@EXPORT = qw($CISCO_IOS $CISCO_CATALYST $CISCO_WEIRD);
our $CISCO_IOS = 1;
our $CISCO_CATALYST = 2;
our $CISCO_WEIRD = 3;
#
#=head1 NAME
#
#
#ExecCmds::Utility - Utility functions for use with Cisco devices.
#
#=head1 SYNOPSIS
#
# my $cu = ExecCmds::Utility->new( cn=>'RN-48MA-05-2610-99' );
#
# my @r = $cu->cmd("show mac");
# print @r;
# $cu->close;
#
#=head1 DESCRIPTION
#
#
#=cut
my $g_Debug = 0;
#=cut
#
#=item new
#
#Used by passing in the name of the device (cn=RN-48MA-01-6509-01), or
#passing in the ipaddress, username, password, execpassword and type. Type
#is defined as 1 for a normal IOS box or 2 for a Catalyst device.
#
#A connection is attempted straight away, enable mode is entered and paging
#is disabled.
#
#=cut
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant; # Object or class name
my $self = { @_ };
bless($self, $class);
my %checks;
# Make sure we have enough to make a connection
for my $att ('username', 'password', 'execpassword')
{
unless( defined($self->{$att}))
{
warn "Failed to find attribute: $att\n";
return undef;
}
}
unless( defined($self->{'ipaddress'}) )
{
if( defined($self->{'cn'}) )
{
my ($name,$aliases,$addrtype,$length,@addrs) =
gethostbyname($self->{'cn'});
if( @addrs )
{
$self->{'ipaddress'} = inet_ntoa($addrs[0]);
}
else
{
warn "No IP found for ",$self->{'cn'},"\n";
return undef;
}
}
else
{
warn "No cn and or ipaddress defined\n";
return undef;
}
}
# get connected
unless($self->connect() ) {
undef($self);
}
return $self;
}
sub cn {
my ($self, $cn) = @_;
if(defined( $cn ) ) {
$self->{'cn'} = $cn;
}
return $self->{'cn'};
}
sub new_password {
my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ % ^ & *) );
return join("", @chars[ map { rand @chars } ( 1 .. 8 ) ]);
}
sub getTypeFromModel {
my $model = shift;
my %t=();
# 1: Non-Catalyst Cisco
# 2: Catalyst style Cisco
$t{'01'} = 1;
$t{'02'} = 1;
$t{'2523'} = 1;
$t{'0805'} = 1;
$t{'2610'} = 1;
$t{'2612'} = 1;
$t{'2912'} = 1;
$t{'2924'} = 1;
$t{'2948'} = 2;
$t{'2948G'} = 2;
$t{'3524'} = 1;
$t{'3640'} = 1;
$t{'3920'} = 0;
$t{'4006'} = 2;
$t{'6506'} = 2;
$t{'6509'} = 2;
$t{'7204'} = 1;
$t{'7206'} = 1;
$t{'7507'} = 1;
$t{'8540'} = 1;
$t{'MSFC'} = 1;
$t{'R1'} = 1;
if( defined( $t{$model} ) ) {
return $t{$model};
} else {
return 0;
}
}
# Assumes router name is like RN-XXXX-YY-MODEL-01
sub getTypeFromName {
my $cn = shift;
if( $cn =~ /\w\w-\w+-\w\w-(\w+)-\d+/) {
return getTypeFromModel($1);
} else {
# warn "Unknown type: $cn\n";
return 0;
}
}
#=cut
#
#=item checkPasswordSecure
#
#This confirms that the password meets the minimum requirements of IPSM. Hand
#in the plain text password, returns true or false.
#
#=cut
sub checkPasswordSecure {
my $pass = shift;
return 0 unless(length($pass) >= 8); # At least 8 characters
return 0 unless($pass =~ /\d/); # At least 1 digit
return 0 unless($pass =~ /\w/); # At least 1 letter
return 1;
}
#=cut
#
#=item getCiscoCommands
#
#Hand in the 'type' of the device and this returns a hash of equivalent
#commands- because the Catalyst and Cisco IOS command sets are different
#this can be used to abstracts the device from the implementation.
#
#=cut
sub getCiscoCommands {
my $type=shift;
my %cmd = ();
if( $type == $CISCO_IOS ) {
%cmd = (STOPPAGING => 'terminal length 0',
SHOWCONFIG => 'show running-config',
ENPROMPTRE => qr|.*[\$%#>]\s?$|,
SHOWCLOCK => 'show clock' );
} elsif( $type == $CISCO_CATALYST) {
%cmd = (STOPPAGING => 'set length 0',
SHOWCONFIG => 'show config all',
ENPROMPTRE => qr|.*\(enable\)|,
SHOWCLOCK => 'show time' );
} else {
warn "Weird type in getCiscoCommands\n";
}
return %cmd;
}
#=cut
#
#=item type
#
#If a 'type' value
#
#=cut
sub type {
my($self, $comp) = @_; # A possible 'comparison' type
unless( defined($self->{'type'}) ) {
$self->{'type'} = getTypeFromName($self->{'cn'} );
}
if( defined($comp) ) {
return ( $self->{'type'} eq $comp );
} else {
return $self->{'type'};
}
}
# Import elements of a hash without overwriting existing elements of
# $self.
sub subsume_hash {
my ($self, $hr, @q) = @_;
while(my $k = pop @q) {
$self->{$k} = $hr->{$k} unless defined $self->{$k};
}
}
# Dumb non-data base connection method
sub connect {
my ($self) = @_; # Device name and check hash ref
my ($cmd, @cmd_output);
my $cn = $self->{'cn'};
my $timeout = $self->{'timeout'} || 60;
# Connect
$self->{'checks'}{'telnet'} = 0;
my $cs = Net::Telnet::Cisco->new( Host => $self->{'ipaddress'},
Dump_Log => "/tmp/$$.dump.log",
Input_log => "/tmp/$$.input.log",
Option_log => "/tmp/$$.option.log",
Timeout => $timeout,
Errmode => 'return' );
unless(defined($cs)) {
$self->error("Connection failed for $cn" );
return 0;
}
$self->{'CS'} = $cs;
$self->{'checks'}{'telnet'} = 1;
$cs->errmode( "return" );
$cs->max_buffer_length(5 * 1024 * 1024); # 5 meg buffer
$self->status("Telnet connected OK");
# Login
# Take Note:
# This takes into account issues relating to machines that are loggin
# to the VTY we are attached to. It relys on knowing that the ;ast 3
# chars of the Net::Telnet::Cisco prompt regexp are $)/ and removing
# the $ from it. This stops the prompt trying to match up to the end
# of line
my $oldprompt = $cs->prompt(); # save original prompt
my $nonachored = $oldprompt;
$nonachored =~ s%\$\)/$%)/%;
$cs->prompt($nonachored); # prompt minus the $ anchor
$self->{'checks'}{'login'} = 0;
unless(defined($cs->login( $self->{'username'}, $self->{'password'})) )
{
$self->error("Error logging in.");
return 0;
}
$self->{'checks'}{'login'} = 1;
$self->status("Logged in");
# Enable
$self->{'checks'}{'enable'} = 0;
unless($cs->enable($self->{"execpassword"}))
{
$self->error("Can't enable: ".$cs->errmsg);
return 0;
}
$self->{'checks'}{'enable'} = 1;
$self->status("Enabled\n");
# Now make sure we stop any message logging that maybe happening on
# the vty. It clutters the ouput badly. It is OK for this command to
# fail.
my @r = $cs->cmd("set logging session disable");
my $line = join( ' ', @r);
if( $line =~ /Invalid input detected/ )
{
$self->{'type'} = $CISCO_IOS; # Probably IOS box
}
else # System logging messages will not be sent
{
$self->{'type'} = $CISCO_CATALYST;
}
# Restore our prompt to N:T:C original
$cs->prompt($oldprompt);
# Now try and determine type- uses the 'show ver' command to guess
# Not we use $self->cmd not $cs->cmd because some routers page the
# result back to us... grrr
@r = $self->cmd("show ver");
$line = join( ' ', @r);
if( $line =~ /IOS|Catalyst 1900/ ) {
$self->{'type'} = $CISCO_IOS;
} else {
$self->{'type'} = $CISCO_CATALYST;
}
# At this point we have been able to execute show ver and match the
# prompt. So we know exactly what the prompt will look like. Lets
# match on that in future as it is faster. we run sooo slooowly on
# large out put
# my $matched_prompt = $cs->last_prompt;
# $matched_prompt =~ s/(\W)/\\$1/g; #quote all non-"word" characters
# $matched_prompt = '(?m:'.$matched_prompt. '$)'; # To anchor
# $cs->prompt($matched_prompt);
my %c = getCiscoCommands( $self->type() );
unless(%c) {
$self->error("Failed to retrieve Cisco commands");
return 0;
}
$self->status("Retrieved Cisco commands");
$self->subsume_hash(\%c, 'SHOWCLOCK', 'STOPPAGING',
'SHOWCONFIG', 'ENPROMPTRE' );
$self->{'checks'}{'paging'} = 0;
$cmd = $self->{'STOPPAGING'};
unless(my @cmd_output = $cs->cmd( $cmd ) ) {
$self->error("Failed to execute command $cmd:\n\t".$cs->errmsg);
$self->{'checks'}{'paging'} = 0;
$self->status("Paging not stopped sorry\n");
return 1;
}
$self->{'checks'}{'paging'} = 1;
$self->status("Paging stopped\n");
return 1;
}
sub getConfig {
my ($self) = @_;
my $cmd = $self->{'SHOWCONFIG'};
my @c = $self->cmd($cmd);
$self->{'config'} = \@c;
return @c;
}
sub status {
my ($self, $msg) = @_;
if(defined($msg)) {
$self->{'STATUS'} = $msg;
warn uc($self->{'cn'}) . ": $msg\n" if( $self->{'debug'} );
} else {
return defined($self->{'STATUS'})?$self->{'STATUS'}:"";
}
}
sub error {
my ($self, $msg) = @_;
if(defined($msg)) {
$self->{'ERROR'} = $msg;
warn uc($self->{'cn'}) . ": $msg\n" if( $self->{'debug'} );
} else {
return defined($self->{'ERROR'})?$self->{'ERROR'}:"";
}
}
sub cmd {
my ($self, $cmd) = @_;
my $cs = $self->{'CS'};
my @cmd_output;
my $enpromptre = defined($self->{'ENPROMPTRE'})
? $self->{'ENPROMPTRE'}
: $cs->prompt;
# First clean out status and error
$self->status('');
$self->error('');
# If we managed to stop paging
if($self->{'checks'}{'paging'})
{
unless(@cmd_output = $cs->cmd( String => $cmd, Prompt => "/$enpromptre/" ) ) {
$self->error("Failed to execute command: $cmd\n\t".$cs->errmsg);
return;
}
$self->status("Command '$cmd' completed".$cs->errmsg);
return @cmd_output;
}
else # look for More ;-(
{
my ($pre,$prompt) = ('','');
my $ors = $cs->output_record_separator('');
# Clean up $enpromptre just in case it has a wrapping //
$enpromptre =~ s%^/%%;
$enpromptre =~ s%/$%%;
MORE: {
# Don't send space commands with a newline
$cmd eq ' ' ? $cs->print($cmd) : $cs->print("$cmd\n");
($pre,$prompt) = $cs->waitfor( "/$enpromptre|--More--/" );
unless( $pre )
{
$self->error("Failed to execute command: $cmd\n\t".$cs->errmsg);
return;
}
# Copy partial to @cmd_output
for my $line (split(/\n/,$pre))
{
next if $line =~ /--More--/;
push(@cmd_output,"$line\n");
}
# Get more if required
if($prompt =~ /--More--/)
{
$cmd = ' ';
redo MORE;
}
}
$self->status("Command '$cmd' completed".$cs->errmsg);
$cs->output_record_separator($ors);
return @cmd_output;
}
}
sub close {
my ($self) = @_;
$self->{'CS'}->close if(defined( $self->{'CS'} ));
}
package ExecCmds;
use strict;
# Flush STDOUT please. Helps when in debug mode. Both warn/die and print
# inter leave correctly
$| = 1;
#use ExecCmds::Utility;
use POSIX ":sys_wait_h";
use Data::Dumper;
use vars qw/$COMPLEX $DEBUG $WE_CARE $VERBOSE $ccount $PRETTY/;
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
$self->configure(@_);
return $self;
}
sub configure
{
my $self = shift;
my %config = @_;
my @array_ref = qw/rcmds pass r_q_regex r_pre_regex r_post_regex scmds
s_q_regex s_post_regex s_pre_regex/;
my @scalar = qw/debug verbose care log number pretty timeout/;
# Configure array reference variables
foreach (@array_ref)
{
if( defined $config{$_} && ref($config{$_}) ne 'ARRAY')
{
warn "ExecCmds config variable $_ should be an array reference. Skipping\n";
next;
}
$self->{$_} = $config{$_} if defined $config{$_};
# Make sure array reference variables have reasonable vaules
$self->{$_} = [] unless defined $self->{$_};
}
# Configure scalar variables
foreach (@scalar)
{
if( defined $config{$_} && ref($config{$_}))
{
warn "ExecCmds config variable $_ shouldn't be a reference. Skipping\n";
next;
}
$self->{$_} = $config{$_} if defined $config{$_};
}
# Some reasonable defaults
$self->{'log'} = '' unless defined $self->{'log'};
$self->{'number'} = 5 unless defined $self->{'number'};
$self->{'care'} = 1 unless defined $self->{'care'};
$self->{'verbose'} = 0 unless defined $self->{'verbose'};
$self->{'debug'} = 0 unless defined $self->{'debug'};
$self->{'pretty'} = 1 unless defined $self->{'pretty'};
# Do a simple test on configuration details handed in. Are they valid?
foreach my $ckey (keys %config)
{
next if grep($ckey eq $_, @array_ref, @scalar);
warn "ExecCmds: unknown configuration variable $ckey\n";
}
return %$self;
}
sub run
{
my ($self,@devices) = @_;
# $DEBUG used for printing verbage. $DEBUG used for flow control
$DEBUG = $self->{'debug'};
$VERBOSE = $self->{'verbose'};
$PRETTY = $self->{'pretty'};
# Default into a caring mode
$WE_CARE = $self->{'care'};
# Pickup any changed logging details
my $logwhere = $self->{'log'};
use vars qw/$rcmds $pass $r_q_regex $r_pre_regex $r_post_regex $scmds
$s_q_regex $s_post_regex $s_pre_regex @devices /;
# Pick up our setting as defined in the config hash ref
$rcmds = $self->{'rcmds'};
$pass = $self->{'pass'};
$r_pre_regex = $self->{'r_pre_regex'};
$r_q_regex = $self->{'r_q_regex'};
$r_post_regex = $self->{'r_post_regex'};
$scmds = $self->{'scmds'};
$s_post_regex = $self->{'s_post_regex'};
$s_pre_regex = $self->{'s_pre_regex'};
$s_q_regex = $self->{'s_q_regex'};
# if we only have one device to handle then don't fork. That way we
# can return details to the caller
my $fork = 1; # Default to forking
$fork = 0 if scalar(@devices) <= 1;
$fork = 0 if $self->{'number'} == 1;
# Setup Reaper and count of children procs
my $pid;
$SIG{CHLD} = \&REAPER;
$ccount = 0;
my $maxkids = $self->{'number'};
my $i = 0;
my $parenttime = time();
$COMPLEX = 0; # Is this a complex device to handle? Initially No
foreach my $dev (@devices)
{
# Wait until some of our kids have died. Only want a few
while($ccount >= $maxkids) {sleep(1);}
# Check to see how we are going to handle this device. If its a ref
# then we may have some command sets to execute before anything is
# done to a device.
my $name = "noname";
if(ref($dev) eq "ARRAY")
{
$COMPLEX = 1; # Global var set
$name = $dev->[0]{'CN'} || 'no name for device';
}
elsif(!ref($dev))
{
$COMPLEX = 0; # Global var set
$name = $dev;
}
else
{
warn "This referenced Device record is invalid:";
warn Dumper($dev);
warn "Continuing\n";
next;
}
# Define this runs log file
$name = uc($name);
my $logfile = $name.".log";
$logfile = $logwhere if($logwhere);
$logfile =~ s/%%name%%/$name/g;
FORK: {
if(!$DEBUG && $fork && ($pid = fork)) # don't fork if debugging
{
# Parent
$ccount++;
}
elsif($DEBUG || !$fork || defined $pid)
{
# Setup STDOUT and STDERR to log file
no warnings;
open(OLDOUT, ">&STDOUT");
open(OLDERR, ">&STDERR");
use warnings;
# Leave STDOUT alone if '-' defined as log file
unless($logwhere eq '-')
{
open(STDOUT, '>', "$logfile") || die "Can't redirect stdout";
}
open(STDERR, ">&STDOUT") || die "Can't dup stdout";
my $details = '';
my $time = time();
# Do the deed
if( exec_dev_cmds( $dev, $pass, $rcmds, $r_q_regex, $r_pre_regex,
$r_post_regex, $scmds, $s_q_regex,
$s_pre_regex, $s_post_regex,\$details))
{
print $details;
print "$name: completed commands OK.. Yippee!\n" if $PRETTY;
}
else
{
print $details;
print "$name: Failed\n" if $PRETTY;
}
my $finish = time();
print "$name: took ", $finish - $time, " seconds to complete\n\n" if $PRETTY;
# Print an indication of finishing to executor
close(STDOUT);
close(STDERR);
open(STDOUT, ">&OLDOUT");
open(STDERR, ">&OLDERR");
print "$name: took ", $finish - $time, " seconds to run\n\n" if $PRETTY;
exit unless $DEBUG || !$fork;
return split(/\n/,$details) if !$fork;
}
elsif($! =~ /No more process/)
{
sleep 5;
redo FORK;
}
else
{
# System error of some kind
die "Can't fork any more! $!";
}
};
}
# Wait for kids to finish otherwise any pipe
# we are apart of will end too early
while($ccount > 0) {sleep(1);}
print "Total Parent time = ", time() - $parenttime, "\n" if $PRETTY;
}
sub exec_dev_cmds
{
my ($cn, $pass_info, $router_cmds, $r_q_regex, $r_pre_regex, $r_post_regex,
$switch_cmds, $s_q_regex, $s_pre_regex, $s_post_regex, $ret) = @_;
my $time = time();
my (@r, $r, @t, $t, $txt);
my $rtn = \$txt;
$rtn = $ret if defined $ret && ref($ret) eq "SCALAR";
# Get our device name
my $dev = '';
if($COMPLEX) { $dev = $cn->[0]{'CN'} || ''; }
else { $dev = $cn; }
unless($dev)
{
$$rtn = "Failed no device entered\n";
return 0;
}
$dev = uc($dev) . ": ";
$dev = '' if( !$PRETTY );
# Get a new connection object
my $cu = getconnected($cn,$pass_info);
unless(defined $cu)
{
$$rtn = $dev . "Failed to connect/login.. bummer\n";
return 0;
}
print $dev . "got new connection at ", time() - $time, " seconds\n" if $DEBUG;
# True if we need to grep over the config before running commands
my $needconfig =
defined $r_q_regex->[0] || defined $r_pre_regex ||
defined $s_q_regex->[0] || defined $s_pre_regex;
$r = '';
if( $needconfig )
{
# Make sure we can get the config for the device and snarf it away
# into $r for later regexp checking
@r = runcommand($cu, $cu->{'SHOWCONFIG'} );
if(my $err = $cu->error() && $WE_CARE) { $cu->close; $$rtn .= "\n$dev$err\n"; return 0;}
$r = join("",@r);
$ret .= $dev . "picked up config OK\n";
}
# Check the type of box we are connected to
# Are we running IOS
if($cu->type( $CISCO_IOS ))
{
print $dev . "is a router box\n" if $DEBUG;
unless($router_cmds->[0])
{
$$rtn .= $dev . "no router commands to run\n";
}
# Do any complex stuff first
if($COMPLEX)
{
($t,$txt) = prepare_cmds($cu,$dev,$cn,$router_cmds);
$$rtn .= $txt; return 0 unless $t;
}
# build a simple query test
$$rtn .= dev_query($dev,$r_q_regex,$r) if defined $r_q_regex->[0];
if(defined $r_pre_regex->[0])
{
# build the eval test unless( 1 && blah && blah){die 'sucker'}
($t,$txt) = dev_assert($dev,'pre',$r_pre_regex,$r);
$$rtn .= $txt; return 0 unless $t;
}
# Ok now do the commands
for my $cmd (@$router_cmds)
{
next unless $cmd;
$$rtn .= $dev . "Issuing command $cmd\n" if $PRETTY;
next if $DEBUG; # Dont do if we are testing
@t = runcommand($cu, $cmd );
$$rtn .= $dev . join($dev ,@t) if $VERBOSE;
if(my $err = $cu->error() && $WE_CARE) { $cu->close; $$rtn .= "\n$dev$err\n"; return 0;}
$$rtn .= $dev . $cu->error() . "\n" if $cu->error();
$$rtn .= $dev . $cu->status() . "\n" if $PRETTY;
}
# If we need to do post config processing
$r = '';
if(defined $r_post_regex->[0])
{
# Do the post test and error appropriately. make sure we look in
# the startup config to be sure to be sure :-)
$$rtn .= $dev . "Issuing command show startup-config\n" if $PRETTY;
@r = runcommand($cu, 'show startup-config' );
if(my $err = $cu->error() && $WE_CARE) { $cu->close; $$rtn .= "\n$dev$err\n"; return 0;}
$$rtn .= $dev . $cu->error() . "\n" if $cu->error();
$$rtn .= $dev . $cu->status() . "\n" if $PRETTY;
$r = join("",@r);
($t,$txt) = dev_assert($dev,'post',$r_post_regex,$r);
$$rtn .= $txt; return 0 unless $t;
}
}
# Are we a Catalyst switch
elsif($cu->type( $CISCO_CATALYST ))
{
print $dev . "is a switch box\n" if $DEBUG;
unless($switch_cmds->[0])
{
$$rtn .= $dev . "no switch commands to run\n";
}
# Do any complex stuff first
if( $COMPLEX )
{
($t,$txt) = prepare_cmds($cu,$dev,$cn,$switch_cmds);
$$rtn .= $txt; return 0 unless $t;
}
# build a simple query test
$$rtn .= dev_query($dev,$s_q_regex,$r) if defined $s_q_regex->[0] ;
# Now build pre eval script and test assertions
if( defined $s_pre_regex->[0] )
{
($t,$txt) = dev_assert($dev,'pre',$s_pre_regex,$r);
$$rtn .= $txt; return 0 unless $t;
}
# Ok now do the commands
for my $cmd (@$switch_cmds)
{
next unless $cmd;
$$rtn .= $dev . "Issuing command $cmd\n";
next if $DEBUG; # Dont do if we are testing
@t = runcommand($cu, $cmd );
$$rtn .= $dev . join($dev ,@t) if $VERBOSE;
if(my $err = $cu->error() && $WE_CARE) { $cu->close; $$rtn .= "\n$dev$err\n"; return 0;}
$$rtn .= $dev . $cu->error() . "\n" if $cu->error();
$$rtn .= $dev . $cu->status() . "\n" if $PRETTY;
}
# If we need to do post config processing
$r = '';
if(defined $s_post_regex->[0])
{
# Do the post test and error appropriately. Refresh our view of
# the config to be sure to be sure :-)
@r = runcommand($cu, $cu->{'SHOWCONFIG'} );
if(my $err = $cu->error() && $WE_CARE) { $cu->close; $$rtn .= "\n$dev$err\n"; return 0;}
$$rtn .= $dev . $cu->error() . "\n" if $cu->error();
$$rtn .= $dev . $cu->status() . "\n" if $PRETTY;
$r = join("",@r);
# Now build post eval script and test assertions
($t,$txt) = dev_assert($dev,'post',$s_post_regex,$r);
$$rtn .= $txt; return 0 unless $t;
}
}
# What on earth are we?
else
{
print $dev . "Bad device type for $dev\n" if $DEBUG;
$$rtn .= $dev . "Bad device type for $dev\n";
$cu->close;
return 0;
}
$cu->close;
return 1;
}
# Create a comand much like the following and assert it
# unless(1 && test1 && test2 && ....)
# {
# die "dev: postcondition test1 && test2 && ... Failed"
# }
sub dev_assert
{
my $dev = shift;
my $prepost = shift;
my $conds = shift;
my $scan_buf = shift;
if(!defined $conds->[0])
{
return(1,$dev . "no $prepost"."condition to check, OK\n") if $PRETTY;
return(1,'');
}
my $test = 'unless( 1 && ';
for my $i (@$conds) { $test .= "$i && "; }
$test =~ s/...$//o; # remove last 3 chars
if( $WE_CARE)
{
$test .= ") { die '$dev$prepost" . "condition regexp Failed'; }";
}
else # We Don't care, so don't die in eval
{
$test .= ") { # die '$dev$prepost" . "condition regexp Failed'; }";
}
# Put conditions in the die message
my ($cond) = $test=~ m/1 && ([^)]+)/;
$test =~ s/regexp/$cond/e;
# Do the pre test and error appropriately
$_ = $scan_buf;
eval $test;
if($@)
{
return (0, $@);
}
else
{
return (1,$dev . "$prepost"."condition asserted as OK\n") if $PRETTY;
return(1,'');
}
}
# Create a comand much like the following and return the results
# unless(1 && test1 && test2 && ....)
# {
# return "dev: query test1 && test2 && ... Failed"
# }
# return "dev: query test1 && test2 && ... OK"
sub dev_query
{
my $dev = shift;
my $conds = shift;
my $scan_buf = shift;
# Jump out if no conditions to test
if(!defined $conds->[0])
{
return $dev . "no query condition to test. OK\n" if $PRETTY;
return '';
}
my $test = 'unless( 1 && ';
for my $i (@$conds) { $test .= "$i && "; }
$test =~ s/...$//o; # remove last 3 chars
$test .= ") { return '$dev" ."query condition regexp Failed'; }";
if( $PRETTY )
{
$test .= "return '$dev"."query condition regexp OK'; ";
}
else
{
$test .= "return; ";
}
# Put conditions in the die message
my ($cond) = $test=~ m/1 && ([^)]+)/;
$test =~ s/regexp/$cond/ge;
# Do the pre test and error appropriately
$_ = $scan_buf;
my $result = eval $test;
if($@)
{
return $@;
}
return $result ."\n";
}
###########################################################################
#
# Subroutine
#
# Args: prepare_cmds
#
# Rtns: $router_cmds modified in place
# $t is 0 for OK run, 1 otherwise
# $txt is any commands text picked up
#
# Description:
# Prepare_cmds will execute any preliminary commands that are
# required to gather information. This information can then be used
# to modify the $router_cmds that need to be executed. $vars are
# collected and then substitued into %%vars%%.
#
# ($t,$txt) = prepare_cmds($cu,$dev,$cn,$router_cmds) if $COMPLEX;
#
# For example given $dev and $router_cmds that look like this
#
# $dev = [
# {'CN' => 'ddarwa01'}, # cn is the name
# {'IP' => '10.145.224.249'}, # ip is the IP address to connect to
#
# # Some commands to execute in this order. The first command
# # is special and 'cmd' gets expanded to execute a command on the
# # cisco box
# {'$Snarf0' => 'cmd("sh ip interface brief")'},
#
# # This command is normal Perl. It sets the "loop" variable for the
# # template code in the router commands
# {'($loop)' => '$Snarf0 =~ /^(Loopback\d+)\s+10.87.71.254/m'},
# ],
#
#
# $router_cmds = [
# 'conf t',
# 'int %%loop%%',
# 'no shut',
# 'exit',
# 'wr',
# 'quit',
# ];
#
# Router_cmds will end up looking some thing like
#
# $router_cmds = [
# 'conf t',
# 'int Loopback0',
# 'no shut',
# 'exit',
# 'wr',
# 'quit',
# ];
#
sub prepare_cmds
{
my($cu,$dev,$cn,$cmds) = @_;
my $t = 1; # True or false return code
my $text = '';
# Loop through each $dev commands picking up any details asked for.
# Note keys CN and IP are skipped. We collect each command in order
# place them in a single eval so command substitution can happen.
for my $cmd (@$cn)
{
next if grep /^CN|^IP/i, keys %$cmd;
# $pvar is a Perl variable to hold the result. $str is the string
# to eval, $left is the left hand side of the assignment
my ($left,$str) = %$cmd;
my $pvar = $left;
# Need to sanitise our $pvar just in case it is surrounded in
# ()'s
if($left =~ m/^\s*\(\s*(\$\w+)\s*\)/) { $pvar = $1; } # ($x)
if($left =~ m/^\s*\(\s*(\@\w+)\s*\)/) { $pvar = $1; } # (@x)
if($left =~ m/^\s*\(\s*(\%\w+)\s*\)/) { $pvar = $1; } # (%x)
# Build eval command; Should really place everything in another
# package for safety...
# Handle device commands of the form cmd("command")
if( $str =~ m/^cmd\(/)
{
$str =~ s/cmd\(/\$cu->cmd(/i;
$str = 'package NN;' .
"use vars qw/\@t $pvar/;\n$pvar = '';\n".
'@t = ' . $str . ";\n$pvar = " . 'join("",@t);';
$str .= <<'EOT'
if(my $err = $cu->error())
{
$cu->close;
die $dev . "$err\n";
}
EOT
}
else # Assume normal Perl expression
{
# Handle normal case of $var = statement, or var = statement
if($left =~ /\w+/)
{
# make template names variables as well (scalar only mate)
$pvar = '$' . $pvar unless $pvar =~ /^\$|^\@|^\%/;
$str = "package NN; use vars qw/$pvar/;\n$left = " . $str;
}
# Handle possible null $left and null $pvar
elsif($left =~ /^\s*$/)
{
$str = "package NN; " . $str;
}
else # I give up
{
warn "Sorry. Don't know how to handle: $left => $str";
}
}
# Do eval. Setting any variables as side effects
$text .= $dev . "Issuing preliminary command $str\n" if $DEBUG;
eval $str;
if($@)
{
my $error = $@;
warn $error;
$text .= $error;
$t = 0;
last;
}
else
{
$text .= $dev . "Completed preliminary command $str\n" if $DEBUG;
$t = 1;
}
}
# Ok now fill up all the substitution data
my %fillings;
for my $hr (@$cn)
{
for my $fill_key (keys %$hr)
{
# Only want real fills. That is vars with no $name, @ % ...
next unless $fill_key;
next if $fill_key =~ /^CN|^IP/;
next if $fill_key =~ /\@|\%/; # Want scalars
# Need to handle ($var) stuff on the left handside of a
# command as well
$fill_key =~ s/^\s*\(\s*(\$\w+)\s*\)/$1/;
$fill_key =~ s/^\s*\$(\w+).*$/$1/; # Strip leading $
$fillings{$fill_key} = eval '$NN::'.$fill_key;
}
}
# For each command do any substituions
for my $cmd_instance (@$cmds)
{
$cmd_instance =~ s{ %% ( .*? ) %% }
{exists( $fillings{$1} )
? $fillings{$1}
: ""
}gsex
}
# OK now we need to fix up any multi line commands that may have
# crept in
my $new_cmds = [];
for my $cmd_instance (@$cmds)
{
push(@$new_cmds,split(/\n/,$cmd_instance));
}
$cmds = $new_cmds;
$_[3] = $new_cmds;
#ready to test...
if($DEBUG)
{
print "Router commands are now:\n";
print Dumper($cmds);
}
return wantarray ? ($t,$text) : $t;
}
###########################################################################
#
# Subroutine runcommand
#
# Args: connection, commands
#
# Rtns: command results
#
# Description:
# run a command or possibly multiple commands against a device
#
#
sub runcommand
{
my ($cu,$cmd) = @_;
my @result = ();
# handle single commands as ususal
return $cu->cmd( $cmd ) unless $cmd =~ /\n/s;
# Have a multi line command
for my $c (split(/\n/,$cmd))
{
my @res =$cu->cmd($c);
push(@res, $cu->error(),"\n") if $cu->error();
push(@result, @res);
last if $cu->error() && $WE_CARE;
}
return @result;
}
###########################################################################
#
# Subroutine getconnected
#
# Args: device, password information
#
# Rtns: a connection object
#
# Description:
# getconnected takes a device to connect to and an arrayref of
# hashrefs that contain user/password/enable information and tries to
# make a connection
#
#
sub getconnected
{
my ($cn,$pass_info) = @_;
my $dev = $cn; # Default to the non-complex state
my $ip = '';
if( $COMPLEX )
{
$dev = uc($cn->[0]{'CN'});
$ip = $cn->[1]{'IP'};
# Check IP address
unless($ip =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/)
{
warn "Bad IP address passed $ip";
return undef;
}
}
for my $hashref (@$pass_info)
{
# Where to put the connection object
my $cu;
# Must have each element at least defined. My be null though
next unless defined $hashref->{'user'};
next unless defined $hashref->{'pass'};
next unless defined $hashref->{'enable'};
# Is it a TACACS login using the normal DB
if($hashref->{'user'} =~ m/tacacs/io)
{
if($DEBUG)
{
$cu = ExecCmds::Utility->new( cn=>$dev,
'debug' => 1,
$COMPLEX ? (ipaddress=>$ip) : (),
);
}
else
{
$cu = ExecCmds::Utility->new( cn=>$dev ,
$COMPLEX ? (ipaddress=>$ip) : (),
);
}
}
# Else try a normal user/pass/enable
else
{
if($DEBUG)
{
print "$dev: trying user=>",$hashref->{'user'},
$COMPLEX ? " IP=>$ip" : '',
" password=>", $hashref->{'pass'},
" enable=>", $hashref->{'enable'},
"\n";
}
$cu = ExecCmds::Utility->new( cn=>$dev,
'username' => $hashref->{'user'},
'password' => $hashref->{'pass'},
'execpassword' => $hashref->{'enable'},
'debug' => 1,
$COMPLEX ? (ipaddress=>$ip) : (),
);
if($DEBUG)
{
print "$dev: user=>",$hashref->{'user'},
" password=>", $hashref->{'pass'},
" enable=>", $hashref->{'enable'},
$cu ? " Success" : " Failed", "\n";
}
}
# Success
return $cu if $cu;
}
# Failure
return undef;
}
# Sigchld reaper
sub REAPER {
my $stiff;
# see http://www.perlmonks.org/index.pl?node=reaper%20subroutines
# for why WNOHANG() and not &WNOHANG. Basically 2nd call passes @_
# to POSIX module thus WNOHANG(@_)
while (($stiff = waitpid(-1, WNOHANG())) > 0) {
# do something with $stiff if you want
$ccount--;
}
$SIG{CHLD} = \&REAPER; # install *after* calling waitpid
}