Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^4: RFC: beginner level script improvement

by georgecarlin (Acolyte)
on Sep 25, 2013 at 13:30 UTC ( #1055684=note: print w/ replies, xml ) Need Help??


in reply to Re^3: RFC: beginner level script improvement
in thread RFC: beginner level script improvement

I have looked into the guides and cpan docs as well as the multiple hints that were linked/referenced here and revised the first part of the script. If nothing else it looks a lot more structured and improved my understanding of some aspects of perl.

Next up will be the connect parts although I'm not sure how to break down the code in those subs yet. I discovered that as is the parent waits indefinetly for the childs to report back which is bad, so I'm looking into signal handling and alarming to remedy that. Lastly I haven't used print here in this part because I didn't feel it was needed.

So here is what I have revised so far. (the hashes that will be passed to most functions are still capitalized I will change that once development is complete, for now I find it convenient)

Feedback/criticsm is very aprecciated unless you wish to wait for the full revisal.

Not a lot changed in the template package

package eod_templates_V2; use strict; use warnings; use Data::Dumper; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 1.13; @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = qw(get_tmpl); %EXPORT_TAGS = ( ALL => [qw(&get_tmpl)], ); sub get_tmpl { my $request = $_[0]; my %templates = ( version => "same bla as before\n", config => 'same wall of text as before', ); return "$templates{$request}"; } 1;

revised and additonal functions so far. I might consolidate the two substitute functions and just substitute depending on the order the array_refs are passed to the sub. Haven't thought that through yet though.

EDIT after posting:
- modified sub populate_config_hash as per jwkrahn's post
- modified sub populate_config_hash to include call to below sub
- added sub get_username_and_password_from_stdin
- added sub get_username_and_password_from_file
- added sub process_static_config_setting
- modified sub get_config_from_file to call above subs

package eod_functions_V2; use strict; use warnings; use Cwd 'abs_path'; use File::Find; BEGIN { ##Discover and use required modules automatically at compile t +ime my $ABS_PATH = abs_path($0); find(\&wanted, $ABS_PATH); sub wanted { if ( $_ eq "eod_templates_V2.pm"){unshift(@INC,$File::Find::di +r);} } } use Data::Dumper; use Exporter; use eod_templates_V2 qw(:ALL); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 1.10; @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = qw(print_help_and_exit populate_static_hashes populate +_config_hash validate_command_line_args get_config_from_file); %EXPORT_TAGS = ( ALL => [qw(&print_help_and_exit &populate_static_hashes &populate_ +config_hash &validate_command_line_args &get_config_from_file)], ); ## BEGIN FUNCTIONS ################################################# +################################################ ## SUB HELP ######################################################## +################################################ sub print_help_and_exit { my $name = $_[0]; print " \nSECTION-USAGE: This script is highly versatile, make sure you familarize your +self with it properly, before using it\n All options are case sensitive. Option/Argument handling is un +ix standard.\n mandatory arguments: --readfile|-r read cli commands from file and perform t +hem on all CPEs (default = $name.cfg. see section config file for hel +p) --connection-proto|-c define the protocol to use to connect + to the devices. (ssh OR telnet. No default setting) optional arguments: --prompt-based-auth|-p provide username + password for devi +ce access when asked. (default = enabled) WARNING: Supercedes LOGIN details in config file y +ou provide! --file-based-auth|-f provide username + password for device + access via the config-file. (default = disabled) --outfile|-o expects filename of csv to write the outpu +t to. (default = $name.csv) --no-quiet|-n log to STDOUT instead of logfile (mandato +ry if --debug is enabled, default = quiet) --debug|-d activate debug-log-level WARNING: do NOT use + with multiple CPEsoutput is massive!!! (default = disabled) --help|-h print this help and exit --verbose|-v enable verbose feedback in outputfil +e. Depending on the executed commands this can be several hundred cha +racters!!! (default = disabled) --Version|-V display extenensive version information an +d exit\n advanced optional arguments (case sensitive): --sendmail|-s expects comma separated list of e-mail ad +dresses to send generated report to as argument (default = disabled) alternatively it can be invoked multiple times wit +h different addresses. (First occurence will always be TO, all others + CC) --max-connections|-m run script in forked mode (massively e +nhances performance) with the specified ammount of max child processe +s (1-25) (default = disabled) --tacacs|-t verify tacacs functionality on VPN-Hubsite +before attempting to process devices. will abort script execution if +tacacs service is unresponsive (default = disabled) \nSECTION-CONFIG-FILE: Keep in mind some devices handle commands case sensitive! The file that you provide will be reset to its defaults during + script execution!!! open the default config file $name.CFG with an editor of your +choice and study the instructions it contains. You may modify the default file or create a new one and pass i +t to the script with option -r Note: please report all unexpected behavior to ###. ty\n\n"; exit 0; } ### SUB create_data_structs ## DOES: populate data structs ########## +############################################ sub populate_static_hashes { my ($STATIC,$REPORT) = @_; %$STATIC = ( MODE_EN => "", MODE_CFG => "", MODE_WR => "", CHAR_DIS => "", CHAR_EN => "", CHAR_CFG => "", CMD_EN => "", CMD_CFG => "", CMD_WR => "", CHAR_NL => "", CHAR_INVALID => "", CHAR_PAGE => "", CMD_QUIT => "", CHAR_CONFIRM => "", CMD_CONFIRM => "", CMD_ROOTDIR => "", CMD_SKIP => "", CMD_SET_NO_PAGE => "", ); %$REPORT = ( UNREACHABLE => '0', OK => '0', NOK => '0', NOFEEDBACK => '0', ERROR => '0', ); } ### SUB populate_config ### Does: populate config hash with command +line arguments ################################# sub populate_config_hash { my ($CONFIG,$arrayref) = @_; my ($name,$prompt,$configf,$quiet,$outf,$debug,$batchsize,$proto,$ +tacacs,$verbose,$header,$mailref,$path) = @{ $arrayref }; my $range = '1000000'; my $rand = int(rand($range)); ##generate random temp-db filename t +o allow for simultanous script execution #put first element in array as mail_to and all others as CC my $mailto = shift @{ $mailref }; my $mailcc = join '', @{ $mailref}; %$CONFIG = ( username => "", password =>"", verbose => "$verbose", quiet => "$quiet", hubsite => '1.1.1.1', log => "$name.log", lockfile => "$name.lock", tempdb => "$path/$rand.db", tacuser => "user", tacpass => "pass", cfg => "$configf", outcsv => "$outf", batchsize => "$batchsize", mail_to => "$mailto", mail_from => 'NMS-script@me.net', mail_sub => "", mail_cc => "$mailcc", mail_data => "", proto => "$proto", tacacs => "$tacacs", ); if ($prompt == 1){ get_username_and_password_from_stdin(\%$CONFIG); #if -p was se +lected, get username and password now otherwise when parsing config-f +ile } } ### SUB get_username_and_password_from_stdin ### DOES: gets username + and password from stdin ######################## sub get_username_and_password_from_stdin { my $CONFIG = $_[0]; eval { local $SIG{ALRM} = sub { die("timeout waiting for user input. +Aborting script execution\n") }; alarm 10; print "please enter device or tacacs username\n"; $CONFIG->{username} = <STDIN>; alarm 0; chomp $CONFIG->{username}; alarm 10; print "please enter device or tacacs password\n"; $CONFIG->{password} = <STDIN>; alarm 0; chomp $CONFIG->{password}; }; if ($@){ die($@); } } ### SUB get_username_and_password_from_file ### DOES: parses userna +me and password string + store in hash ######## sub get_username_and_password_from_file { my ($CONFIG,$line) = @_; my @temp = split(/\=/, $line); #split setting and value my $string = lc $temp[0]; $string =~ s/your-//; unless(! defined( $temp[1]) ){ #config file setting supersedes + prompt, unless its undefined $CONFIG->{$string} = $temp[1]; #wichever it was is now in +the CONFIG hash as a key(username or password) with the corresponding + value } } ### SUB validate_command_line_args ### DOES: perform various sanity + checks on command line arguments ############# sub validate_command_line_args { my ($name,$prompt,$configf,$quiet,$outf,$debug,$batchsize,$proto,$ +tacacs,$verbose,$header,$maildst,$path) = @{ $_[0] }; if ( $header ){ print get_tmpl('version'); exit 0; } unless($proto =~ /ssh|telnet/i){ die("$0:ERROR: Connection protocol must be specified.\n"); } unless( -e $configf){ die("$0:ERROR: $configf not found in $path. +typo or missing path?\n");} if ($debug == 1 && $quiet == 1){ die("$0:ERROR: log-level=debug ca +n NOT be used in quiet mode to avoid massive logfiles!\n");} if ( $batchsize > 30 ){ warn("$0:WARNING: More than 25 simultanous connections are NOT + allowed!\nReducing Max_Connections to 25.\n"); $batchsize=25; }elsif ( $batchsize < 0 ){ warn("$0:WARNING: Negative Max_Connections are not permitted, +forking has been disabled.\n"); $batchsize = 0; } } ## SUB process_static_config_setting ### DOES: check if setting is v +alid and store in hash or discard ############# sub process_static_config_setting { my ($STATIC,$line) = @_; $line =~ s/DEFINE//; my @t=split(/=/,$line); #split statement into key => value pairs $t[0] =~ s/\s*//; $t[1] =~ s/\\//; if ( exists $STATIC->{$t[0]} ){ $STATIC->{$t[0]}=$t[1]; #key is supported, set value }else{ warn("$0:WARNING $t[0] is NOT a valid static configuration opt +ion and will be ignored!\n"); #key is not supported and will be ignor +ed } } ## SUB get_config_from_file ### DOES: process config file and set pop +ulate hashes accordingly ###################### sub get_config_from_file { my ($DATA,$CONFIG,$STATIC) = @_; my $count = 0; open(my $input, "<", "$CONFIG->{cfg}") or die("$0:ERROR unable to + read from $CONFIG->{cfg}. ERR: $?/$!"); while (<$input>){ chomp $_; if ( $_ =~ /your-username/i || $_ =~ /your-password/i ){ #this + line contains either the username or the password, it's irrelevant w +hich get_username_and_password_from_file($CONFIG,$_); next; } if ( $_ =~ m/^#/ || ! $_ =~ /[a-z]|[A-Z]/ ){ next; } #ignore +commented and empty lines, as well as password + username. if ( $_ =~ m/^DEFINE/ && $_ =~ /\=/){ #process config definiti +ons process_static_config_setting($STATIC,$_); next; } if ( $_ =~ m/^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){ +3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?):/ ){ #line contains a vali +d ipv4 IP addr, this is a device-commands set my (@metachars,@translations); populate_static_arrays(\@metachars,\@translations); $_ = substitute_escaped_metachars($_,\@metachars,\@transla +tions); #substitute escaped metachars to prevent config parser from i +nterpreting them my @temp = split(/,/, $_); #split line from config-file in +to command sub-sets, first one containing device IP as well my (@commands,@matches,$ip); for (my $i=0; $i < @temp; $i++){ #process each subset if ($i == 0){ my @temp1 = split(/:/, $temp[0]); #this is the fir +st subset, it contains the IP $ip = $temp1[0]; $count++; $temp[0] =~ s/^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9 +][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)://; #remove IP + from subset } my @arr; if ($temp[$i] =~ /\=/ ){ #this subset contains pattern +-matching instructions my @temp2 = split(/\=/, $temp[$i]); #split subset +into further subsets, first containing the command, the rest are patt +erns $temp2[0] = substitute_placeholders($temp2[0],\@me +tachars,\@translations); #all splitting is done on this string, rever +t it back to its original form $commands[$i] = $temp2[0]; #this is the command for (my $c=1; $c < @temp2; $c++){ #these are all t +he patterns $temp2[$c] = substitute_placeholders($temp2[$c +],\@metachars,\@translations); ##undo prior substitutions $arr[$c] = $temp2[$c]; } $matches[$i] = \@arr; }else{ #this subset does not contain pattern matching +instructions $temp[$i] = substitute_placeholders($temp[$i],\@me +tachars,\@translations); ##undo prior substitutions $commands[$i] = $temp[$i]; $arr[$i] = "no-match-hook"; ##set flag for easy id +entification later on in the script $matches[$i] = \@arr; } } $$DATA{$ip}->{commands} = \@commands; $$DATA{$ip}->{matches} = \@matches; } } $CONFIG->{devices_count} = $count; if ( $count == 0 ) { die("$0:ERROR $CONFIG->{cfg} does not contai +n valid Device-instruction-sets\n");} close($input); open(my $input1, ">", "$CONFIG->{cfg}") or warn("$0:WARNING unable + to write to $CONFIG->{cfg}. CLEAR IT manually! ERR: $!/$?"); print $input1 get_tmpl("config"); #replace specified config file + with template for security reasons close($input1); while ( my($key,$value) = (each %$STATIC)){ unless(defined($value) && $value ne ""){ die("$0:ERROR: $key d +efinition missing in $CONFIG->{cfg}.Aborting Execution.\n");} #missin +g key definition, this can not be tolerated } } ### SUB populate_static_arrays ### DOES: populate static arrays meta +chars and translations ######################## sub populate_static_arrays { my ($meta_ref,$trans_ref) = @_; @{ $meta_ref } = (':','=','!',','); #declare config metachars @{ $trans_ref } = ('#00','#01','#02','#03') #declare bi-direction +al placeholders } ### SUB substitute_escaped_metachars ### DOES: substitute ctrl-chars + for escaped metachars in $LINE ############### sub substitute_escaped_metachars { my ($line,$meta_ref,$trans_ref) = @_; for (my $i=0; $i<@{ $meta_ref };$i++){ $line =~ s/\#\Q$meta_ref->[$i]/$trans_ref->[$i]/g; ## hardco +ded ESCSEQ => # } return $line; } ### SUB substitute_placeholders ### DOES: revert string to its origi +nal form priot to escapeing #################### sub substitute_placeholders { my ($line,$meta_ref,$trans_ref) = @_; for (my $i=0; $i<@{ $trans_ref };$i++){ $line =~ s/$trans_ref->[$i]/$meta_ref->[$i]/g; } return $line; } 1;

main script so far

#!/usr/bin/perl -w use strict; use File::Find; use Cwd 'abs_path'; BEGIN { ##Discover and use required modules automatically at compile t +ime my $ABS_PATH = abs_path($0); find(\&wanted, $ABS_PATH); sub wanted { if ( $_ eq "eod_templates_V2.pm" or $_ eq "eod_functions_V2.pm +"){unshift(@INC,$File::Find::dir);} } } use IO::Handle; use Expect; use Net::Telnet; use Data::Dumper; use Parallel::ForkManager; use Fcntl; use MIME::Lite; use Fcntl qw(:DEFAULT :flock); use Getopt::Long; Getopt::Long::Configure ("bundling"); use eod_templates_V2 qw(:ALL); use eod_functions_V2 qw(:ALL); my $path = Cwd::getcwd(); my $name = $0; $name =~ s/\.pl//; $name =~ s/\.\///; my $exitstate = 0; unless( ! @ARGV ){ $exitstate = Main(); }else{ print_help_and_exit($name); } exit($exitstate); sub process_command_line_args { #set default values for dynamic config settings my ($prompt,$configf,$quiet,$outf,$debug,$batchsize,$proto,$tacacs +,$verbose,$header,@maildst) = (1,"$name.cfg",1,"$name.csv",0,0,"none" +,0,0); GetOptions ( 'file-based-auth|f' => sub { $prompt = 0;}, 'prompt-based-auth|p' => \$prompt, 'readfile|r=s' => \$configf, 'outfile|o=s' => \$outf, 'no-quiet|n' => sub { $quiet = 0; }, 'debug|d' => \$debug, 'Version|V' => \$header, 'max-connections|m=s' => \$batchsize, 'sendmail|s=s' => \@maildst, 'connection-proto|c=s' => \$proto, 'tacacs|t' => \$tacacs, 'verbose|v' => \$verbose, 'help|h' => sub { print_help_and_exit($name);} ) or print_help_and_exit($name); @maildst=split(/,/,join(',',@maildst)); #in case -s was invoked wi +th a comma separated list instead of multiple times my $mailref = \@maildst; my @args = ($name,$prompt,$configf,$quiet,$outf,$debug,$batchsize, +$proto,$tacacs,$verbose,$header,$mailref,$path); return \@args; } sub Main { #get user defined dynamic config settings and perform various sani +ty checks my $argref = process_command_line_args(); validate_command_line_args($argref); #all args check out now create and populate static hashes my (%STATIC,%REPORT); populate_static_hashes(\%STATIC,\%REPORT); #fill dynamic hash my %CONFIG; populate_config_hash(\%CONFIG,$argref); #retrieve config settings from file my %DATA; get_config_from_file(\%DATA,\%CONFIG,\%STATIC); return $exitstate; #will be set depending on outcome of actual dev +ice operations }


Comment on Re^4: RFC: beginner level script improvement
Select or Download Code
Re^5: RFC: beginner level script improvement
by jwkrahn (Monsignor) on Sep 26, 2013 at 03:14 UTC
    my ($c,$mailcc,$mailto) =(0,'',''); foreach ( @{ $mailref } ){ #put first element in array as mail_to +and all others as CC if ($c == 0){ $mailto .= $_; }else{ $mailcc .= $_; } }

    You don't change $c inside the loop so $mailto gets everything and $mailcc gets nothing.    What you want is:

    # put first element in array as mail_to and all others as CC my $mailto = shift @$mailref; my $mailcc = join '', @$mailref;
      ah I forgot the increment there (should have tried -s with multiple args before posting the code here, apologies for the sloppyness). thank you for noticing as well as providing this shorter and more elegant solution. I suspect there are multiple places where shift/join might be better than what I am doing, I'll check out the join documentation and see if it's a better fit. Thanks again.

        Perhaps you should also look at using operators like push, for example in your code:

        my (@commands,@matches,$ip); for (my $i=0; $i < @temp; $i++){ #process each subset if ($i == 0){ my @temp1 = split(/:/, $temp[0]); #this is the fir +st subset, it contains the IP $ip = $temp1[0]; $count++; $temp[0] =~ s/^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9 +][0-9]?)\.){3}(?:25[0-5]|2[0-4 +][0-9]|[01]?[0-9][0-9]?)://; #remove IP from subset } my @arr; if ($temp[$i] =~ /\=/ ){ #this subset contains pattern +-matching instructions my @temp2 = split(/\=/, $temp[$i]); #split subset +into further subsets, first co +ntaining the command, the rest are patterns $temp2[0] = substitute_placeholders($temp2[0],\@me +tachars,\@translations); #all +splitting is done on this string, revert it back to its original form $commands[$i] = $temp2[0]; #this is the command for (my $c=1; $c < @temp2; $c++){ #these are all t +he patterns $temp2[$c] = substitute_placeholders($temp2[$c +],\@metachars,\@translations); + ##undo prior substitutions $arr[$c] = $temp2[$c]; } $matches[$i] = \@arr; }else{ #this subset does not contain pattern matching +instructions $temp[$i] = substitute_placeholders($temp[$i],\@me +tachars,\@translations); ##und +o prior substitutions $commands[$i] = $temp[$i]; $arr[$i] = "no-match-hook"; ##set flag for easy id +entification later on in the s +cript $matches[$i] = \@arr; } } $$DATA{$ip}->{commands} = \@commands; $$DATA{$ip}->{matches} = \@matches;

        It looks like you could use push instead of array indexes.    Something like this:

        my ( @commands, @matches, $ip ); for my $i ( 0 .. $#temp ) { #process each subset if ( $i == 0 ) { my @temp1 = split /:/, $temp[ 0 ]; #this is the fi +rst subset, it contains the IP $ip = $temp1[ 0 ]; $count++; $temp[ 0 ] =~ s/^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0 +-9][0-9]?)\.){3}(?:25[0-5]|2[0-4 +][0-9]|[01]?[0-9][0-9]?)://; #remove IP from subset } my @arr; if ( $temp[ $i ] =~ /=/ ) { #this subset contains patt +ern-matching instructions my @temp2 = split /=/, $temp[ $i ]; #split subset +into further subsets, first co +ntaining the command, the rest are patterns push @commands, substitute_placeholders( $temp2[ 0 + ], \@metachars, \@translations ); #all +splitting is done on this string, revert it back to its original form for my $c ( 1 .. $#temp2 ) { #these are all the pa +tterns push @arr, substitute_placeholders( $temp2[ $c + ], \@metachars, \@translations ); + ##undo prior substitutions } push @matches, \@arr; } else { #this subset does not contain pattern matchin +g instructions push @commands, substitute_placeholders( $temp[ $i + ], \@metachars, \@translations ); ##und +o prior substitutions push @arr, "no-match-hook"; ##set flag for easy id +entification later on in the s +cript push @matches, \@arr; } } $$DATA->{ $ip }{ commands } = \@commands; $$DATA->{ $ip }{ matches } = \@matches;
Re^5: RFC: beginner level script improvement
by jwkrahn (Monsignor) on Sep 28, 2013 at 20:32 UTC
    ### SUB validate_command_line_args ### DOES: perform various sanity + checks on command line argume +nts ############# sub validate_command_line_args { my ($name,$prompt,$configf,$quiet,$outf,$debug,$batchsize,$proto,$ +tacacs,$verbose,$header,$maild +st,$path) = @{ $_[0] }; ... if ( $batchsize > 30 ){ warn("$0:WARNING: More than 25 simultanous connections are NOT + allowed!\nReducing Max_Connec +tions to 25.\n"); $batchsize=25; }elsif ( $batchsize < 0 ){ warn("$0:WARNING: Negative Max_Connections are not permitted, +forking has been disabled.\n") +; $batchsize = 0; } }

    The $batchsize variable is lexically scoped to this subroutine so changing its value will have no effect on anything outside this subroutine.

      ah yes, thank you for noticing. It's fixed via return to and set in main now.

      I've transformed all of the code but the expect parts by now but want to complete and throughly test it before posting the version 2. However I'm not entirely sure if what I have in mind is going to work.

      The expect-interaction is entirely independent on the protocol so I will consolidate both prior subs, but since most expect calls are similar I would like to create abstract subs and pass params to them as well as an exp-handle ref. is this possible?

      rough example:
      sub expect_main { my $exp = new Expect; $exp->configure_stuff; my $FB = expect_do_something(\$exp, \@expectthese, \@sendthese); } sub expect_do_something { my ($exp,$expectthese,$sendthese) = @_; $exp->expect(5, [ qr/$expectthese->[0]/, sub { $exp->send("$sendthese->[0]");}], [ qr/$expectthese->[1]/, sub { $exp->send("$sendthese->[1]");}], ); my $fb = $exp->before(); return $fb; }
      Would this work or is it impossible to interact with the expect handle and methods this way? Or is there maybe a better way? Thanks in advance.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1055684]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2014-08-30 04:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (291 votes), past polls