# # 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; =head1 NAME ExecCmds.pm - execute a set of commands against devices defined in perl arrays. =head1 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); =head1 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 =head1 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', ]; =head1 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. =head1 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); =cut # 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/; =head1 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 =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); $self->configure(@_); return $self; } =head1 configure 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 =cut 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; } =head1 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(). =cut 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; } =pod =head1 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; =cut 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 } =pod =head1 AUTHOR Mark Pfeiffer Jeremy Nelson provided Utility functions =head1 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. =head1 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 =cut