Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

RFC: beginner level script improvement

by georgecarlin (Acolyte)
on Sep 19, 2013 at 11:25 UTC ( #1054837=perlmeditation: print w/ replies, xml ) Need Help??

The script is running as intended (despite being a work in progress) but I would like to escape the general "self-taught-nastyness" it has and consequently improve my understanding and style. The purpose of the script is to connect to any amount of devices of any vendor with any OS by telnet or SSH and execute any amount of commands. Optionally pattern matching may be performed. It was tested and doesn't put much of a strain on the server its running on. I would really aprecciate any and all critical comments and advise. With the exception of "use xyz.pm" unless its part of the core perl package. Additonal modules may not be installed (which is why it features some questionable stuff) If the tabs make it too hard to read (written in vim) I can provide the correctly formatted files if anyone is interested. vv contains config and templates vv

package eod_templates; use strict; use warnings; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 1.01; @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = qw(printversion printtmpl); %EXPORT_TAGS = ( ALL => [qw(&printversion &printtmpl)], ); ###################################################################### +################################################ ## TEMPLATES ####################################################### +################################################ ###################################################################### +################################################ sub printversion { my $HEADER= ' ################# HEADER ################################ #Does: Perform any amount of tasks in any mode on any # # amount of devices of any OS by logging in to # # them via SSH or telnet # # Optionally perform pattern matching on results # Requires: # # r/w-permisson on Logfile, csvfile, lockfile, # # tempdb and inputfile # # eod_templates.pm and eod_functions.pm need # # to be in the same dir as the script itself # #To DOs: # # clean up namespace and sub scopes # # make connections more abstract and put into # # eod_functions package # # complete CLASS PRESETS # # throroughly test escaping # # excessive telnet/ssh testing # # excessive character/behavior testing # # excessive error/exception handling testing # # assess PERM requirement. # #Exit states: # # 0 = all tasks done, no errors encountered # # 0 = invoked with -v/-h or unsupported args # # 1 = defined error (e.g. file handle error) # # 1 = undefined error $? # #Version: 0.7.1 ALPHA # #last change: # #Author: # ################# /HEADER ############################### '; $HEADER .= "\n"; return $HEADER; } sub printtmpl { my $TEMPLATE= "\n ################################################################## +################################################# #---CONFIG FILE FOR EXECUTE ON DEVICE SCRIPT---------------------- +------------------------------------------------# ################################################################## +################################################# ################################################################## +################################################# #---HELP---------------------------------------------------------- +------------------------------------------------# ################################################################## +################################################# #Remove leading >#< to enable lines or add # to have script ignore + them. #Remember that this file is reset to its default during script exe +cution. #Make a copy if you may need it again. #STATIC CLASS PRESETS SETTING DEFINITIONS ##select the actions the script needs to perform automatically (en +able CLI, enter config mode, write when configuration was applied) #DEFINE MODE_EN= #DEFINE MODE_CFG= #DEFINE MODE_WR= ## set the last character of the device's prompt in disabled, enab +led and configure mode. (e.g. >,\$,#) #DEFINE CHAR_DIS= #DEFINE CHAR_EN= #DEFINE CHAR_CFG= ## set the command to disable paging (e.g. terminal length 0) #DEFINE CMD_SET_NO_PAGE= ## set the device specific message, that is displayed when paging +occurs (e.g. PRESS ANY KEY TO CONTINUE, --more--) #DEFINE CHAR_PAGE= ## set the command to jump to the end of paged output (e.g. NL,SPA +CE,skip) #DEFINE CMD_SKIP= ## set the command to log off the device (e.g. exit, logout) #DEFINE CMD_QUIT= ## set the Newline/Carriage Return character(s) this device expect +s (e.g. NL = \n, CR = \r, CRLF=\r\l) #DEFINE CHAR_NL= ## set the message the device displays when a command violates the + input syntax (e.g. INVALID COMAND, Bad Command) #DEFINE CHAR_INVALID= ## set the enable command this device expects (e.g. enable) #DEFINE CMD_EN= ## set the configure mode command (e.g. conf t, conf priv) #DEFINE CMD_CFG= ## set the command to save configuration changes (e.g. wr, commit) #DEFINE CMD_WR= ##set the command to return to the root path (e.g. end, cd) #DEFINE CMD_ROOTDIR= ##set the prompt the device displays when it requires confirmation + (e.g. [yes/no]:) #DEFINE CHAR_CONFIRM= ##set the command the device expects to confirm/negate decisions #DEFINE CMD_CONFIRM= ##If none of the existing class presets apply you can use a custom +ized class. #If you do not need a specific definition in your customized CLASS + set it to ?. ################################################################## +################################################# #---BEGIN CONFIG-------------------------------------------------- +------------------------------------------------# ################################################################## +################################################# ################################################################## +################################################# #-<-SECTION LOGIN->----------------------------------------------- +------------------------------------------------# ################################################################## +################################################# YOUR-USERNAME= YOUR-PASSWORD= ################################################################## +################################################# #-<-SECTION STATIC CLASSES->-------------------------------------- +------------------------------------------------# ################################################################## +################################################# #--<-STATIC CLASS PRESET CISCO 19xx->----------------------------- +------------------------------------------------# ################################################################## +################################################# DEFINE MODE_EN=yes DEFINE MODE_CFG=yes DEFINE MODE_WR=no DEFINE CHAR_DIS=> DEFINE CHAR_EN=# DEFINE CHAR_CFG=# DEFINE CMD_EN=en DEFINE CMD_CFG=conf t DEFINE CMD_WR=wr DEFINE CMD_SET_NO_PAGE=terminal length 0 DEFINE CHAR_PAGE=--more-- DEFINE CMD_SKIP=NL DEFINE CMD_QUIT=exit DEFINE CHAR_NL=NL DEFINE CHAR_INVALID=INVALID COMMAND DEFINE CHAR_CONFIRM=[yes/no]: DEFINE CMD_CONFIRM=yes DEFINE CMD_ROOTDIR=end ################################################################## +################################################# #--<-STATIC CLASS PRESET ASPEN-->--------------------------------- +------------------------------------------------# ################################################################## +################################################# #DEFINE MODE_EN=no #DEFINE MODE_CFG=no #DEFINE MODE_WR=no #DEFINE CHAR_DIS=> #DEFINE CHAR_EN=> #DEFINE CHAR_CFG=? #DEFINE CMD_EN=? #DEFINE CMD_CFG=? #DEFINE CMD_WR=? #DEFINE CMD_SET_NO_PAGE=? #DEFINE CHAR_PAGE=Press #DEFINE CMD_SKIP=SPACE #DEFINE CMD_QUIT=logout #DEFINE CHAR_NL=CR #DEFINE CHAR_INVALID=Bad Command #DEFINE CHAR_CONFIRM=? #DEFINE CMD_CONFIRM=? ################################################################## +################################################# #--<-STATIC CLASS CUSTOMIZED->------------------------------------ +------------------------------------------------# ################################################################## +################################################# #DEFINE MODE_EN= #DEFINE MODE_CFG= #DEFINE MODE_WR= #DEFINE CHAR_DIS= #DEFINE CHAR_EN= #DEFINE CHAR_CFG= #DEFINE CMD_EN= #DEFINE CMD_CFG= #DEFINE CMD_WR= #DEFINE CMD_SET_NO_PAGE= #DEFINE CHAR_PAGE= #DEFINE CMD_SKIP= #DEFINE CMD_QUIT= #DEFINE CHAR_NL= #DEFINE CHAR_INVALID= #DEFINE CHAR_CONFIRM= #DEFINE CMD_CONFIRM= ################################################################## +################################################# #---SECTION COMMAND SETS------------------------------------------ +------------------------------------------------# ################################################################## +################################################# #IP:COMMAND1=MATCH1=MATCH2=MATCH...N,COMMAND2=MATCH2 # LIST OF METACHARACTERS!!!DO NOT USE ANY OF THESE EXCEPT FOR THEI +R INTENTED PURPOSE!!! # : <= separates the device IP from the COMMAND INSTANCES # , <= separates all COMMAND Instances from each other (optionally + these instances may include pattern matching instructions) # = <= separates patterns. Matching is performed on the OUTPUT of +the COMMAND. Applies ONLY to scope of the COMMAND instance. # ! <= makes this pattern matching instance an inverse matching in +struction. i.e. output does NOT contain pattern. # # <= escapes any of the above Metacharacters. This needs to be p +ut infront of Metacharacters that you do NOT want the script to inter +prete as such. (e.g. #= will escape the =) #IP:COMMAND=MATCH=!DONTMATCH ################################################################## +################################################# #---END CONFIG---------------------------------------------------- +------------------------------------------------# ################################################################## +################################################# "; return $TEMPLATE; } ###################################################################### +################################################ ## / TEMPLATES ##################################################### +################################################ ###################################################################### +################################################ 1;

vv functions I have taken out of the actual script to make it structured vv

package eod_functions; use strict; use warnings; use Data::Dumper; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 1.10; @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = qw(help sanatize taint gettime parsetempdb); %EXPORT_TAGS = ( ALL => [qw(&help &sanatize &taint &gettime &parsetempdb)], ); ###################################################################### +################################################ ## BEGIN FUNCTIONS ################################################# +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB HELP ######################################################## +################################################ ###################################################################### +################################################ sub help { my $NAME = $_[0]; $NAME =~ s/\.pl//; $NAME =~ s/\.\///; print "\nSECTION-USAGE: $0 \nThis script is highly versatile, make + sure you familarize yourself with it properly, before using it\n"; print "All options are case sensitive. Option/Argument handlin +g is unix 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) --quiet|-q log to logfile (default = enabled) --no-quiet|-n log to STDOUT instead of logfile (mandato +ry if --debug is enabled, default = disabled) --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"; print " 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)\n"; print " \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 \n"; print "Note: please report all unexpected behavior to e-mail t +y\n\n"; return 1; } ###################################################################### +################################################ ## / SUB HELP ###################################################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB SANATIZE ### DOES: substitute ctrl-chars for escaped metachar +s in $LINE #################################### ###################################################################### +################################################ sub sanatize { my ($LINE,$METACHARS,$TRANSLATIONS) = @_; for (my $I=0; $I<@$METACHARS;$I++){ $LINE =~ s/\#\Q$$METACHARS[$I]/$$TRANSLATIONS[$I]/g; ## hardco +ded ESCSEQ => # } return $LINE; } ###################################################################### +################################################ ## / SUB SANATIZE ################################################## +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB TAINT ### DOES: substitute ctrl-chars for unescaped metachar +s in $LINE #################################### ###################################################################### +################################################ sub taint { my ($LINE,$METACHARS,$TRANSLATIONS) = @_; for (my $I=0; $I<@$TRANSLATIONS;$I++){ $LINE =~ s/$$TRANSLATIONS[$I]/$$METACHARS[$I]/g; } return $LINE; } ###################################################################### +################################################ ## / SUB TAINT ##################################################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB GETTIME ### DOES: returns SQL compatible TS in UK format ## +################################################ ###################################################################### +################################################ sub gettime { my @months = qw(01 02 03 04 05 06 07 08 09 10 11 12); my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun); my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $da +yOfWeek, $dayOfYear, $daylightSavings) = localtime(); my $year = 1900 + $yearOffset; my $T_GER = "$hour:$minute:$second, $weekDays[$dayOfWeek] $dayOfMo +nth/$months[$month]/$year"; my $T_UK = "$weekDays[$dayOfWeek] $months[$month]/$dayOfMonth/$yea +r $hour:$minute:$second"; return $T_UK; } ###################################################################### +################################################ ## / SUB GETTIME ################################################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB PARSETEMPDB ### DOES: parses tempdb and generates humanly re +adible REPORT in %REPORT ###################### ###################################################################### +################################################ sub parsetempdb { my ($REPORT,$CONFIG) = @_; my $STRING; open(my $CSV, ">$$CONFIG{OUTCSV}") || die("$0::PARSETEMPDB:ERROR U +nable to open $$CONFIG{OUTCSV} for writing!\n"); my $TH = "DATE;IP"; open(my $DB, "<$$CONFIG{TEMPDB}") || die("$0::PARSETEMPDB:ERROR Un +able to open $$CONFIG{TEMPDB}!\n"); my @LINES; $LINES[0]="TH"; my ($COUNT,$COUNTREF)=(0,0); while (<$DB>){ $_ =~ s/\|\|\|//; my @TEMP = split(/\|\|/, $_); $COUNT = @TEMP; if ($COUNT > $COUNTREF){$COUNTREF = $COUNT;} if ($_ =~ /h00kme/i ){ $_ =~ s/h00kme/IP is unreachable/; push(@LINES, $_); $$REPORT{UNREACHABLE}++; next; } if ($_ =~ /noble/i ){ $_ =~ s/noble/Changing into privileged mode failed/; push(@LINES, $_); $$REPORT{ERROR}++; next; } $STRING = ""; for (my $C=0; $C <= @TEMP; $C++){ unless(! defined($TEMP[$C])){ $STRING .= "$TEMP[$C];";} } $STRING =~ s/\s+/ /g; push(@LINES, $STRING); if ( $STRING =~ /NOK/ ) { $$REPORT{NOK}++; next; } if ( $STRING =~ /OK/ ) { $$REPORT{OK}++; next; } if ( $STRING =~ /ERROR/ ) { $$REPORT{ERROR}++; } } $TH = "DATE;IP"; for ( my $C = 2; $C <= $COUNTREF; $C++ ){ $TH .= ";COMMAND;RESULT;DETAILS"; if($$CONFIG{VERBOSE} == 1){$TH .= ";VERBOSE FEEDBACK"; $C +=1; +} $C += 2; } $LINES[0]=$TH; foreach (@LINES){ print $CSV "$_\n"; } close($DB); close($CSV); return %$REPORT; } ###################################################################### +################################################ ## / SUB PARSETEMPDB ############################################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB SENDMAIL ### DOES: generates and sends e-mail to all recipie +nts with attached csv report ################## ###################################################################### +################################################ #####NOT EXPORTED YET sub sendmail { my ($REPORT,$CONFIG,$RESULT) = @_; my $T = gettime(); my $MAIL_TO = $$CONFIG{MAIL_TO}[0]; delete $$CONFIG{MAIL_TO}[0]; my @MAIL_CC = $$CONFIG{MAIL_TO}; if ($RESULT == 1){ ##CASE: Script execution OK $$CONFIG{MAIL_DATA} .= " Overview - completed $T: Pattern matches successful: $$REPORT{OK} Pattern matches unsuccessful: $$REPORT{NOK} DEVICE UNREACHABLE: $$REPORT{UNREACHABLE} ERRORS: $$REPORT{ERROR} command success, but no output: $$REPORT{NOFEEDBACK +} "; $$CONFIG{MAIL_SUB} .= "processed $$CONFIG{DEVICES_COUNT} devic +es. $$REPORT{UNREACHABLE} unreachable. "; my $mh = MIME::Lite->new( From => $$CONFIG{MAIL_FROM}, To => $$MAIL_TO, Cc => @MAIL_CC, Subject => $$CONFIG{MAIL_SUB}, Type => 'multipart/mixed' ) or die("$0::SENDMAIL:ERROR creating new mail object: $!/ +$?\n"); $mh->attach ( Type => 'TEXT', Data => $$CONFIG{MAIL_DATA}, ) or die("$0::SENDMAIL:ERROR adding the text message part: + $!/$?\n"); $mh->attach ( Type => "text/csv", Path => $$CONFIG{OUTCSV}, Filename => $$CONFIG{OUTCSV}, Disposition => 'attachment' ) or die("$0::SENDMAIL:ERROR adding $$CONFIG{OUTCSV} to ma +il object: $!/$?\n"); $mh->send; }else{ ##CASE: Script execution aborted because tacacs verificatio +n failed $$CONFIG{MAIL_DATA} .= "ERROR: TACACS SERVICE VERIFICATION FAI +LED!\nReason:"; if ($RESULT == 1){ $$CONFIG{MAIL_DATA} .= "HUBSITE: $$CONFIG{H +UBSITE} is unreachable\n";} if ($RESULT == 2){ $$CONFIG{MAIL_DATA} .= "Provided Username/p +assword combination failed Authentication\n";} if ($RESULT == 2){ $$CONFIG{MAIL_DATA} .= "Provided Username/p +assword combination passed Authentication, but tacacs profile doesn't + allow privileged mode\n";} $$CONFIG{MAIL_SUB} .= "$$CONFIG{NAME}: tacacs service verifica +tion failed. script execution aborted"; my $mh = MIME::Lite->new( From => $$CONFIG{MAIL_FROM}, To => $MAIL_TO, Cc => @MAIL_CC, Subject => $$CONFIG{MAIL_SUB}, Type => 'multipart/mixed' ) or die("$0::SENDMAIL:ERROR creating new mail object: $!/ +$?\n"); $mh->attach ( Type => 'TEXT', Data => $$CONFIG{MAIL_DATA}, ) or die("$0::SENDMAIL:ERROR adding the text message part: + $!/$?\n"); $mh->send; } return $RESULT; } ###################################################################### +################################################ ## / SUB SENDMAIL ################################################## +################################################ ###################################################################### +################################################ 1;

vv main script vv

#!/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.pm" or $_ eq "eod_functions.pm"){uns +hift(@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"); ##=> not supported on NMS5, ("ig +norecase_always"); use eod_templates qw(:ALL); use eod_functions qw(:ALL); ###################################################################### +################################################ ## CLA CHECK ######################################################## +################################################ ###################################################################### +################################################ if ($#ARGV < 0 ) { &help($0); exit 0;} my $PATH = Cwd::getcwd(); my $NAME = $0; $NAME =~ s/\.pl//; $NAME =~ s/\.\///; my ($TACUSER,$TACPASS,$VERSION,%DEFINES,%DATA,@MAILDST); my ($QUIET,$DEBUG,$PROMPT,$BATCHSIZE,$OUTFILE,$CONFIGFILE,$TACACS,$PRO +TO,$VERBOSE) = (1,0,1,0,"$NAME.csv","$NAME.cfg",0,"NONE",0); GetOptions ( 'file-based-auth|f' => sub { $PROMPT = 0;}, 'prompt-based-auth|p' => \$PROMPT, 'readfile|r=s' => \$CONFIGFILE, 'quiet|q' => \$QUIET, 'outfile|o=s' => \$OUTFILE, 'no-quiet|n' => sub { $QUIET = 0; }, 'debug|d' => \$DEBUG, 'Version|V' => \$VERSION, 'max-connections|m=s' => \$BATCHSIZE, 'sendmail|s=s' => \@MAILDST, 'connection-proto|c=s' => \$PROTO, 'tacacs|t' => \$TACACS, 'verbose|v' => \$VERBOSE, 'help|h' => sub { &help($0); exit 0;} ) || die(&help($0)); #perform various sanity checks if ( $VERSION ){ print printversion(); exit 0; } unless($PROTO =~ /ssh|telnet/i){ die("$0::MAIN:ERROR: Connection proto +col must be specified.\n");} unless( -e $CONFIGFILE){ die("$0::MAIN:ERROR: $CONFIGFILE not found in + $PATH. typo or missing path?\n");} if ($DEBUG == 1 && $QUIET == 1){ die("$0::MAIN:ERROR: log-level=debug +can NOT be used in quiet mode to avoid massive logfiles!\n");} if ( $BATCHSIZE > 30 ){ warn("$0::MAIN:WARNING: More than 25 simultanous connections are N +OT allowed!\nReducing Max_Connections to 25.\n"); $BATCHSIZE=25; }elsif ( $BATCHSIZE < 0 ){ warn("$0::MAIN:WARNING: Negative Max_Connections are not permitted +, forking has been disabled.\n"); $BATCHSIZE = 0; } @MAILDST=split(/,/,join(',',@MAILDST)); ## GET LOGIN DATA ################################################## +################################################ open(my $FH, "<$CONFIGFILE") || die("$0::MAIN::ERROR Unable to read fr +om $CONFIGFILE\n"); if ( $PROMPT == 1 ){ print "Starting Prompt based authentication (default. consult help + for more information):\n"; print "please enter device or tacacs username\n"; $TACUSER = <STDIN>; chomp $TACUSER; print "please enter device or tacacs password\n"; $TACPASS = <STDIN>; chomp $TACPASS; }else{ while (<$FH>) { if ( $_ =~ /your-username/i ){ my @TMP = split(/=/,$_); if ( $TMP[1] =~ /username/i || @TMP < 2 ){ die("$0::MAIN:E +RROR: file-based-authentication was selected but no username was prov +ided in the config file!\n");} $TACUSER = $TMP[1]; chomp $TACUSER; }elsif ( $_ =~ /your-password/i ){ my @TMP1 = split(/=/,$_); if ( $TMP1[1] =~ /username/i || @TMP1 < 2){ die("$0::MAIN: +ERROR: file-based-authentication was selected but no password was pro +vided in the config file!\n");} $TACPASS = $TMP1[1]; chomp $TACPASS; }else{ next; } } } unless( $TACUSER && $TACPASS ){ die("$0::MAIN:ERROR: Retrieval of LOGIN DATA from $CONFIGFILE fail +ed, please try editing it again or switch to prompt based authenticat +ion\n"); } close($FH); ## / GET LOGIN DATA ################################################ +################################################ ###################################################################### +################################################ ## / CLA CHECK ##################################################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## STATIC CONFIGURATION AND DATA STRUCT INIT ####################### +################################################ ###################################################################### +################################################ my $TEMPLATE = printtmpl(); our (@METACHARS,@TRANSLATIONS); ($METACHARS[0],$METACHARS[1],$METACHARS[2],$METACHARS[3]) = (':','=',' +!',','); ($TRANSLATIONS[0],$TRANSLATIONS[1],$TRANSLATIONS[2],$TRANSLATIONS[3]) + = ('#00','#01','#02','#03'); my %STATIC = ( ##initalize static device-config 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 => "", ); my $RANGE = '1000000'; my $RAND = int(rand($RANGE)); ##generate random temp-db filename to al +low for simultanous script execution my %CONFIG = ( ## initalize dynamic config VERBOSE => "$VERBOSE", QUIET => "$QUIET", HUBSITE => '1.1.1.1', LOG => "$NAME.log", LOCKFILE => "$NAME.lock", TEMPDB => "$PATH/$RAND.db", DEBUG => "$DEBUG", USER => "$TACUSER", PASS => "$TACPASS", TACUSER => "user", TACPASS => "pass", CFG => "$CONFIGFILE", OUTCSV => "$OUTFILE", BATCHSIZE => "$BATCHSIZE", MAIL_TO => \@MAILDST, MAIL_FROM => 'NMS-script@me.net', MAIL_SUB => "", MAIL_CC => "", MAIL_DATA => "", PRESET => "$TEMPLATE", PROTO => "$PROTO", TACACS => "$TACACS", ); my %REPORT = ( UNREACHABLE => '0', OK => '0', NOK => '0', NOFEEDBACK => '0', ERROR => '0', ); ###################################################################### +################################################ ## / STATIC CONFIGURATION AND DATA STRUCT INIT ##################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## MAIN ############################################################ +################################################ ###################################################################### +################################################ open(my $PERM, ">>$CONFIG{OUTCSV}") || die("$0::MAIN:Unable to create/ +write to $CONFIG{OUTCSV}. ERROR: $?"); print $PERM ""; close($PERM); our $OUT; my ($RESULT,@ERRORS,$LF) = (0); if ( $QUIET == 1 ){ open($OUT, ">>$CONFIG{LOG}") || die("$0::MAIN:ERROR Unable to open + $CONFIG{LOG} for writing"); open(STDERR, ">>$CONFIG{LOG}") || die("$0::MAIN:ERROR Unable to ap +pend STDERR to $CONFIG{LOG}\n"); # open($LF, ">$CONFIG{LOG}.lock") || warn("$0::main unable to open +lockfile to ensure log clearing consistency!\n"); }else{ open($OUT, ">&STDOUT") || die("$0::MAIN:ERROR Unable to append out +put to STDOUT\n"); } $OUT->autoflush(1); #print Dumper \%STATIC; $RESULT = &getdata(\%DATA,\%CONFIG,\%STATIC); ##read config-file print Dumper \%DATA; #print Dumper \%CONFIG; #print Dumper \%STATIC; if($CONFIG{TACACS} == 1){ $RESULT = &verify_tacacs(\%CONFIG); ##connect to static site to ve +rify general tacacs functionality } if($RESULT != 0 && $TACACS == 1){ my $RESPONSE = &sendmail(\%REPORT,\%CONFIG,$RESULT); ## tacacs fai +led, send mail + exit with ERROR die("$0::MAIN:ERROR tacacs service functionality verification fail +ed. Aborting script execution!\n"); } ##tacacs functionality verified process all tasks on all devices (in c +hilds) and print output to temp-db if ($PROTO =~ m/ssh/i){ %DATA = &connect2cpe_SSH(\%DATA,\%CONFIG,\%STATIC); }else{ %DATA = &connect2cpe_TELNET(\%DATA,\%CONFIG,\%STATIC); } %REPORT = parsetempdb(\%REPORT,\%CONFIG); ##join tempdb in humanly rea +dable format and generate final output unlink $CONFIG{LOCKFILE} || warn("$0::MAIN:WARNING Unable to delete $C +ONFIG{LOCKFILE}\n"); unlink $CONFIG{TEMPDB} || warn("$0::MAIN:WARNING Unable to delete $CON +FIG{TEMPDB}\n"); if ( @MAILDST > 0 ){ $RESULT = &sendmail(\%REPORT,\%CONFIG,"1"); ##generate report, att +ach to generated email send email } close($OUT); #if ($CONFIG{QUIET} == 1){ close($LF); } exit($RESULT); ###################################################################### +################################################ ## / MAIN ########################################################## +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB GETDATA ##################################################### +################################################ ###################################################################### +################################################ sub getdata { my ($DATA,$CONFIG,$STATIC) = @_; my $COUNT = 0; my (@TEMP,@TEMP1,@TEMP2,$IP); if ( $CONFIG{CFG} ne "" ){ open(my $INPUT, "<$CONFIG{CFG}") || die("$0::GETDATA:ERROR un +able to read from $CONFIG{CFG}. ERR: $!"); while (<$INPUT>){ chomp $_; if ( $_ =~ m/^#/ || $_ =~ /your-username/i || $_ +=~ /your-password/i || ! $_ =~ /[a-z]|[A-Z]/ ){ next; } if ( $_ =~ m/^DEFINE/ && $_ =~ /\=/){ $_ =~ s/DEFINE//; my @T=split(/=/,$_); $T[0] =~ s/\s*//; $T[1] =~ s/\\//; if ( exists $STATIC{$T[0]} ){ $STATIC->{$T[0]}=$T[1]; }else{ die("$0::GETDATA:ERROR: $T[0] is NOT a valid stati +c configuration option!\n"); } } 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]?):/ ){ my @COMMANDS; my @MATCHES; $_ = sanatize($_,\@METACHARS,\@TRANSLATIONS); @TEMP = split(/,/, $_); for (my $I=0; $I < @TEMP; $I++){ if ($I == 0){ @TEMP1 = split(/:/, $TEMP[0]); $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]?)://; } my @ARR; if ($TEMP[$I] =~ /\=/ ){ @TEMP2 = split(/\=/, $TEMP[$I]); $TEMP2[0] = taint($TEMP2[0],\@METACHARS,\@TRAN +SLATIONS); $COMMANDS[$I] = $TEMP2[0]; for (my $C=1; $C < @TEMP2; $C++){ $TEMP2[$C] = taint($TEMP2[$C],\@METACHARS, +\@TRANSLATIONS); $ARR[$C] = $TEMP2[$C]; } for(my $I=0; $I<@ARR;$I++){ unless(defined($_)){ delete $ARR[$I]; } } $MATCHES[$I] = \@ARR; }else{ ##no-match-hook $TEMP[$I] = taint($TEMP[$I],\@METACHARS,\@TRAN +SLATIONS); $COMMANDS[$I] = $TEMP[$I]; $ARR[$I] = "no-match-hook"; $MATCHES[$I] = \@ARR; } } $DATA{$IP}->{COMMANDS} = \@COMMANDS; $DATA{$IP}->{MATCHES} = \@MATCHES; } } $CONFIG{DEVICES_COUNT} = $COUNT; if ( $COUNT == 0 ) { die("$0::GETDATA:ERROR $CONFIG{CF +G} does not contain valid Device-instruction-sets\n");} close($INPUT); open(my $INPUT1, ">$CONFIG{CFG}") || warn("$0::GETDATA:WARNING + unable to write to $CONFIG{CFG}. CLEAR IT manually! ERR: $!/$?"); + print $INPUT1 "$CONFIG{PRESET}"; close($INPUT1); while ( my($KEY,$VALUE) = (each %STATIC)){ unless(defined($VALUE) && $VALUE ne ""){ die("$0::GETDAT:E +RROR: $KEY definition missing in $CONFIG{CFG}.Aborting Execution.\n") +;} } } return 1; } ###################################################################### +################################################ ## / SUB GETDATA ################################################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB VERIFY TACACS ############################################### +################################################ ###################################################################### +################################################ sub verify_tacacs { my ($CONFIG) = @_; my $SHELL = 1; my $exp = new Expect; $exp->log_stdout($CONFIG{DEBUG}); ##For debugging only $exp->exp_internal($CONFIG{DEBUG}); ##For debugging only $exp->log_user($CONFIG{DEBUG}); ##For Debugging only $exp->raw_pty(1); $exp->match_max(1000000); $exp->spawn("ssh", "-l$CONFIG{TACUSER}", "$CONFIG{HUBSITE}") || di +e("$0::VERIFY_TACACS:ERROR can not spawn ssh to $CONFIG{HUBSITE}. ERR +/SYS: $! / $?"); sleep 0.1; $exp->expect(10, [ qr/\? /, sub { $exp->send("yes\n"); sleep 1; $exp->send("$CONFIG{TACPASS}\n"); $SHELL = '0';}], [ qr/assword:/, sub { sleep 0.1; $exp->send("$CONFIG{TACPASS}\n"); $SHELL = '0';}], ); unless ( $SHELL == '1' ) ##auth-req success, SHELL = 0, proceed { $exp->expect(10, [ qr/>/, sub { $exp->send("en\n"); sleep 0.1; $exp->send("$CONFIG{PASS}\n"); }], ## verify + user has correct privileges in tacacs [ qr/#/, sub { $exp->send("\n");}], ##all good Shell stay +s at 0 [ qr/assword:/, sub { ##auth failed => SHELL = 2 unless($exp->soft_close()){$exp->hard_close(); +} $SHELL = 2; }], ); if ($SHELL == 1){ $exp->expect(10, [ qr/>/, sub { $exp->send("exit\n"); ## auth for priv mode failed + => SHell = 3 $SHELL = 3; }], [ qr/#/, sub { $exp->send("exit\n"); ## priv auth successful => S +hell = 0 $SHELL = 1;}], ); } } return $SHELL; ## ERRORCODES: # 0 = OK # 1 = NOK - HUBSITE unreachable # 2 = NOK - login to HUBSITE failed # 3 = NOK - changing privileges failed } ###################################################################### +################################################ ## / SUB VERIFY TACACS ############################################## +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB CONNECT2CPE_SSH ############################################# +################################################ ###################################################################### +################################################ sub connect2cpe_SSH { my ($DATA,$CONFIG) = @_; my ($SHELL,$FB,$T,$STRING,$ROUTER,$COMMAND,$MATCH,%TEMP,$RESULT,@R +ESULTS) = (0); my $pm = new Parallel::ForkManager($CONFIG{BATCHSIZE}); $pm->run_on_finish( sub { my ($PID, $EXITCODE) = @_; if ($CONFIG{QUIET} == 0){ if ($EXITCODE == 1){ print $OUT "child(PID = $PID) terminated with + exit state: NOK\n"; }else{ print $OUT "child(PID = $PID) terminated with +exit state: OK\n"; } } } ); $pm->run_on_start( sub { if ($CONFIG{QUIET} == 0){ print $OUT "Forking child...\n"; } } ); $pm->run_on_wait( sub { #print "control\n"; }, 0.1 ); for my $ID (keys %DATA){ next unless $ID ne 'CFG'; #####following code is run in child-processes##### my $PID = $pm->start($ID) and next; my $EXIT = 0; my $exp = new Expect; $exp->log_stdout($CONFIG{DEBUG}); ##For debugging only $exp->exp_internal($CONFIG{DEBUG}); ##For debugging only $exp->log_user($CONFIG{DEBUG}); ##For Debugging only $exp->raw_pty(1); $exp->match_max(1000000); $exp->spawn("ssh", "-l$CONFIG{USER}", "$ID") || die("$0::CONNE +CT2CPE_SSH:ERROR can not spawn ssh process to $ID. ERR/SYS: $! / $?") +; sleep 0.1; my $SBC = $STATIC{CHAR_DIS}; my ($NL,$SKIP) = ($STATIC{NL},$STATIC{SKIP}); if ($STATIC{CHAR_NL} eq "NL"){ $NL = "\n"; }elsif($STATIC{CHAR_NL} eq "CR"){ $NL = "\r"; }elsif($STATIC{CHAR_NL} eq "CRLF"){ $NL = "\r\l"; }elsif($STATIC{CHAR_NL} eq "HEXNL"){ ##still needs testing $NL = ""; } if ($STATIC{CMD_SKIP} eq "SPACE"){ $SKIP = "\032"; }elsif($STATIC{CMD_SKIP} eq "NL"){ $SKIP = $NL; }else{ $SKIP = "$STATIC{CMD_SKIP}$NL"; } $exp->expect(10, [ qr/\? /, sub { $exp->send("yes$NL"); sleep 1; $SHELL = 1; $exp->send("$CONFIG{PASS}$NL");}], [ qr/assword:/, sub { $SHELL = 1; sleep 0.1; $exp->send("$CONFIG{PASS}$NL");}], ); $exp->expect(5, [ qr/assword:/, sub { unless($exp->soft_close()){$exp->hard_close();} $SHELL = '2';}], [ qr/$STATIC{CHAR_DIS}/, sub { $exp->send("$NL"); $SHELL = '0';}], [ qr/$STATIC{CHAR_EN}/, sub { $exp->send("$NL"); $SHELL = '0';}], ); unless ( $SHELL == '2' || $SHELL == '1' ) { if ($STATIC{MODE_EN} eq "yes"){ $exp->expect(5, [ qr/$SBC/, sub { $exp->send("$STATIC{CMD_EN}$NL");}], [ qr/$STATIC{CHAR_EN}/, sub { $exp->send("$NL");}], ); $exp->expect(5, [ qr/assword:/, sub { $exp->send("$CONFIG{PASS}$NL");}], [ qr/$STATIC{CHAR_EN}/, sub { $exp->send("$NL");}], ); $SBC = $STATIC{CHAR_EN}; } if ($STATIC{CMD_SET_NO_PAGE} ne '?'){ $exp->send("$STA +TIC{CMD_SET_NO_PAGE}$NL");} if ($STATIC{MODE_CFG} eq "yes"){ $exp->expect(5, [ qr/$SBC/, sub { $exp->send("$STATIC{CMD_CFG}$NL");}], [ qr/$STATIC{CHAR_CFG}/, sub { $exp->send("$NL");}], ); $exp->expect(5, [ qr/assword:/, sub { $exp->send("$CONFIG{PASS}$NL");}], [ qr/$STATIC{CHAR_CFG}/, sub { $exp->send("$NL");}], ); $SBC = $STATIC{CHAR_CFG}; } $exp->clear_accum(); $exp->send("$NL"); $exp->expect(5, [ qr/$SBC/, sub { $ROUTER = $exp->b +efore();}] ); $ROUTER =~ s/\s//g; for (my $C=0; $C < @{ $DATA{$ID}{COMMANDS} }; $C++){ + my $COMMAND = $DATA{$ID}{COMMANDS}[$C]; my @MATCHES = $DATA{$ID}{MATCHES}[$C]; #print Dumper \@MATCHES; $exp->clear_accum(); $exp->send("$COMMAND$NL"); sleep 2; ##wait for router to execute comma +nd my $LB = 0; $FB = ''; LOOPCTRL: while ($LB < 10){ $exp->expect(5, [ qr/\Q$STATIC{CHAR_PAGE}/, sub { ##CASE 1 +: PAGED OUTPUT, send SKIP and next with COUNTER+1 $FB .= $exp->before(); $exp->send("$SKIP"); $LB++; next LOOPCTRL; }], [ qr/\Q$STATIC{CHAR_CONFIRM}/, sub { ##CAS +E 2: CONFIRM, send COMMAND and exit loop $FB .= $exp->before(); $exp->clear_accum(); $exp->send("$STATIC{CMD_CONFIRM}$N +L"); $LB = 9; next LOOPCTRL }], ); $exp->expect(1, ##this needs to be here bec +ause it matches before above conditons do [ qr/$SBC/, sub { ##PAGED + CONFIRM done i +f they occured, now one forced SBC match $FB .= $exp->before(); $FB .= $exp->after(); ################ +#some devices echo commands, this needs to be fixed by dynamic pty se +ttings last LOOPCTRL; }], ##none of the a +boce occured, exit loop ); } my ($PATTERNS,$NEGPATTERNS); $FB =~ s/$ROUTER/ /; my ($METHOD,$ADDPOS,$ADDNEG,$CASE,$RES) = (0,"incl +usive patterns: * ","exclusive patterns: * ",1, "OK "); foreach (@{ $MATCHES[0] }){ next unless defined($_); $MATCH = "$_"; if ( $MATCH =~ m/^\!/ ) { $MATCH =~ s/\!//; $METHOD = "1"; $NEGPATTERNS .= "$MATCH*"; }else{ $PATTERNS .= "$MATCH*"; $METHOD = "0"; } if ( $FB ne '' ){ if ($MATCH eq 'no-match-hook' && ! +( $FB =~ /$STATIC{CHAR_INVALID}/i ) ){ $CASE = 2; last; }elsif ($MATCH eq 'no-match-hook' & +& $FB =~ /$STATIC{CHAR_INVALID}/i){ $RES = "ERROR"; $FB = "INVALID COMMAND"; $CASE = 0; last; } if ( $METHOD == 0){ ##method pos. pattern if ( $FB =~ /$MATCH/i ){ $ADDPOS .= "$MATCH*"; }else{ $RES = "NOK "; } }elsif ($METHOD == 1 && $CASE == 1){ ##met +hod exclusive pattern match if ( ! ($FB =~ /$MATCH/i) ){ $ADDNEG .= "$MATCH*"; }else{ $RES = "NOK "; } } }else{ $RES = 'ERROR '; $FB = "Device didn't react to comma +nd"; $CASE = 0; last; } } my $RESREF; if ($CASE == 0){ $RESREF = "$RES||$FB"; }elsif ($CASE == 2){ $RESREF = "$RES||No patterns were provided"; + }else{ $RES .= "matched "; my $TMP = "specified patterns were =>"; if(defined($PATTERNS)){$RES .=$ADDPOS; $TMP .= + "inclusive: $PATTERNS"; } if(defined($NEGPATTERNS)){$RES .=$ADDNEG; $TMP + .= "exclusive: $NEGPATTERNS";} $RESREF = "$RES||$TMP"; } if ($CONFIG{VERBOSE} == 1){ $FB =~ s/\n/ /g; push(@RESULTS,"$RESREF||$FB"); }else{ push(@RESULTS,"$RESREF"); } sleep 0.1; } sleep 0.1; unless($STATIC{MODE_CFG} eq "no"){ $exp->send("$STATIC +{CMD_ROOTDIR}$NL");} unless($STATIC{MODE_WR} eq "no" ){ $exp->send(" +$STATIC{CMD_WR}$NL");} $exp->send("$STATIC{CMD_QUIT}$NL"); sleep 0.1; $TEMP{$ID}->{RESULTS} = \@RESULTS; }else{ $EXIT = $SHELL; } unless($exp->soft_close()){$exp->hard_close();} #print Dumper \%TEMP; #####%TEMP is written to tempdb##### my ($I,$CHK,$FH)=(0); while ( $I<=50 ){ $I++; sleep 0.1; open($CHK, ">$CONFIG{LOCKFILE}") || next; open($FH, ">>$CONFIG{TEMPDB}") || die("$0::CONNECT2 +CPE_SSH*child*($ID):ERROR Unable to write to file $CONFIG{TEMPDB}\n") +; flock($FH, LOCK_EX) ||die("$0::CONNECT2CPE_SSH*chil +d*($ID):ERROR LOCK_EX FAILED on $FH\n"); my $STRING; if ( $EXIT == 0 ) { while (my ($KEY,$VALUE) = (each %TEMP) ){ $STRING .= "$KEY"; for (my $C=0; $C < @{ $TEMP{$ID}{RESULTS} }; $C++) +{ my $COMMAND = $DATA{$ID}{COMMANDS}[$C]; my $RESULT = $TEMP{$ID}{RESULTS}[$C]; $RESULT =~ s/\r//g; $RESULT =~ s/\n/ /g; $STRING .= "||$COMMAND||$RESULT"; } $T = gettime(); print $FH "$T||$STRING|||\n"; } }elsif ($EXIT == 1){ $T = gettime(); print $FH "$T;$ID;h00kme\n"; }elsif ($EXIT == 2){ $T =gettime(); print $FH "$T;$ID;noble\n"; } close($FH); sleep 0.1; close($CHK); last; } sleep 0.1; $pm->finish($EXIT); ### EXIT with 0 as OK and 1 as IP u +nreachable } $pm->wait_all_children; return %DATA; } ###################################################################### +################################################ ## / SUB CONNECT2CPE_SSH ########################################### +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB CONNECT2CPE_TELNET ########################################## +################################################ ###################################################################### +################################################ sub connect2cpe_TELNET { my ($DATA,$CONFIG,$STATIC) = @_; my ($SHELL,$FB,$T,$STRING,$ROUTER,$COMMAND,$MATCH,%TEMP,$RESULT,@R +ESULTS) = (1); my $pm = new Parallel::ForkManager($CONFIG{BATCHSIZE}); $pm->run_on_finish( sub { my ($PID, $EXITCODE) = @_; if ($CONFIG{QUIET} == 0){ if ($EXITCODE == 1){ print $OUT "child(PID = $PID) terminated with + exit state: NOK\n"; }else{ print $OUT "child(PID = $PID) terminated with +exit state: OK\n"; } } } ); $pm->run_on_start( sub { if ($CONFIG{QUIET} == 0){ print $OUT "Forking child...\n"; } } ); $pm->run_on_wait( sub { #print "control\n"; }, 0.1 ); for my $ID (keys %DATA){ next unless $ID ne 'CFG'; #####following code is run in child-processes##### my $PID = $pm->start($ID) and next; my $EXIT = 0; my $exp = new Expect; $exp->log_stdout($CONFIG{DEBUG}); ##For debugging only $exp->exp_internal($CONFIG{DEBUG}); ##For debugging only $exp->log_user($CONFIG{DEBUG}); ##For Debugging only $exp->raw_pty(0); $exp->match_max(1000000); $exp->spawn("telnet", "$ID") || die("$0::CONNECT2CPE_TELNET:ER +ROR Unable to spawn telnet session to $ID. ERR/SYS: $! / $?"); sleep 0.1; my $SBC = $STATIC{CHAR_DIS}; my ($NL,$SKIP) = ($STATIC{NL},$STATIC{SKIP}); if ($STATIC{CHAR_NL} eq "NL"){ $NL = "\n"; }elsif($STATIC{CHAR_NL} eq "CR"){ $NL = "\r"; }elsif($STATIC{CHAR_NL} eq "CRLF"){ $NL = "\r\l"; }elsif($STATIC{CHAR_NL} eq "HEXNL"){ ##still needs testing $NL = "\0xa"; } if ($STATIC{CMD_SKIP} eq "SPACE"){ $SKIP = "\032"; }elsif($STATIC{CMD_SKIP} eq "NL"){ $SKIP = $NL; }else{ $SKIP = "$STATIC{CMD_SKIP}$NL"; } $exp->expect(10, [ qr/ogin:/, sub { $exp->send("$CONFIG{USER}$NL"); $SHELL = '2';}], [ qr/ser:/, sub { $exp->send("$CONFIG{USER}$NL"); $SHELL = '2';}], [ qr/name:/, sub { $exp->send("$CONFIG{USER}$NL"); $SHELL = '2';}], ); unless ( $SHELL == '1' ){ $exp->expect(10, [ qr/assword:/, sub { $exp->send("$CONFIG{PASS}$NL"); $SHELL = '0';}], [ qr/ogin: /, sub { $exp->send("$CONFIG{PASS}$NL"); $SHELL = '0';}], ); } unless ( $SHELL == '2' || $SHELL == '1' ) { if ($STATIC{MODE_EN} eq "yes"){ $exp->expect(10, [ qr/$SBC/, sub { $exp->send("$STATIC{CMD_EN}$NL");}], [ qr/$STATIC{CHAR_EN}/, sub { $exp->send("$NL");}], ); $SBC = $STATIC{CHAR_EN}; } if ($STATIC{MODE_CFG} eq "yes"){ $exp->expect(10, [ qr/$SBC/, sub { $exp->send("$STATIC{CMD_CFG}$NL");}], [ qr/$STATIC{CHAR_CFG}/, sub { $exp->send("$NL");}], ); $SBC = $STATIC{CHAR_CFG}; } $exp->clear_accum(); $exp->send("$NL"); $exp->expect(10, [ qr/$SBC/, sub { $ROUTER = $exp->b +efore();}] ); $ROUTER =~ s/\s//g; if ( $STATIC{CMD_SET_NO_PAGE} ne '?' ){ print '$exp->s +end("$STATIC{CMD_SET_NO_PAGE}$NL")';} ##still needs to be verified + for (my $C=0; $C < @{ $DATA{$ID}{COMMANDS} }; $C++){ + my $COMMAND = $DATA{$ID}{COMMANDS}[$C]; my @MATCHES = $DATA{$ID}{MATCHES}[$C]; #print Dumper \@MATCHES; my $CNT = 0; while ($CNT < 4){ $exp->clear_accum(); $exp->send("$COMMAND$NL"); sleep 2; ##wait for router to execute c +ommand my $LB = 0; $FB = ''; while($LB < 10){ $exp->expect(5, [ qr/$SBC/, sub { $FB .= $exp->before(); $LB = 10; }], [ qr/$STATIC{CHAR_PAGE}/, sub { $FB .= $exp->before(); $exp->send("$SKIP"); $LB++;}], ); } if ( $FB ne ''){ last; } $CNT++; } my ($PATTERNS,$NEGPATTERNS); $FB =~ s/$ROUTER/ /; my ($METHOD,$ADDPOS,$ADDNEG,$CASE,$RES) = (0,"incl +usive patterns: * ","exclusive patterns: * ",1, "OK "); foreach (@{ $MATCHES[0] }){ next unless defined($_); $MATCH = "$_"; if ( $MATCH =~ m/^\!/ ) { $MATCH =~ s/\!//; $METHOD = "1"; $NEGPATTERNS .= "$MATCH*"; }else{ $PATTERNS .= "$MATCH*"; $METHOD = "0"; } if ( $FB ne '' ){ if ($MATCH eq 'no-match-hook' && ! +( $FB =~ /$STATIC{CHAR_INVALID}/i ) ){ $CASE = 2; last; }elsif ($MATCH eq 'no-match-hook' & +& $FB =~ /$STATIC{CHAR_INVALID}/i){ $RES = "ERROR"; $FB = "INVALID COMMAND"; $CASE = 0; last; } if ( $METHOD == 0){ ##method pos. pattern if ( $FB =~ /$MATCH/i ){ $ADDPOS .= "$MATCH*"; }else{ $RES = "NOK "; } }else{ ##method exclusive pattern match if ( ! ($FB =~ /$MATCH/i) ){ $ADDNEG .= "$MATCH*"; }else{ $RES = "NOK "; } } }else{ $RES = 'ERROR '; $FB = "Device didn't react to comma +nd"; $CASE = 0; last; } } my $RESREF; if ($CASE == 0){ $RESREF = "$RES||$FB"; }elsif ($CASE == 2){ $RESREF = "$RES||No patterns were provided"; + }else{ $RES .= "matched "; my $TMP = "specified patterns were =>"; if(defined($PATTERNS)){$RES .=$ADDPOS; $TMP .= + "inclusive: $PATTERNS"; } if(defined($NEGPATTERNS)){$RES .=$ADDNEG; $TMP + .= "exclusive: $NEGPATTERNS";} $RESREF = "$RES||$TMP"; } if ($CONFIG{VERBOSE} == 1){ $FB =~ s/\n/ /g; push(@RESULTS,"$RESREF||$FB"); }else{ push(@RESULTS,"$RESREF"); } sleep 0.1; } sleep 0.1; unless($STATIC{MODE_CFG} eq "no"){ $exp->send("$STATIC +{CMD_ROOTDIR}$NL");} unless($STATIC{MODE_WR} eq "no" ){ $exp->send(" +$STATIC{CMD_WR}$NL");} $exp->send("$STATIC{CMD_QUIT}$NL"); sleep 0.1; $TEMP{$ID}->{RESULTS} = \@RESULTS; }else{ $EXIT = $SHELL; } unless($exp->soft_close()){$exp->hard_close();} #print Dumper \%TEMP; #####%TEMP is written to tempdb##### my ($I,$CHK,$FH)=(0); while ( $I<=50 ){ $I++; sleep 0.1; $T = gettime(); open($CHK, ">$CONFIG{LOCKFILE}") || next; open($FH, ">>$CONFIG{TEMPDB}") || die("$0::CONNECT2 +CPE_TELNET*child*($ID):ERROR Unable to write to file $CONFIG{TEMPDB}\ +n"); flock($FH, LOCK_EX) ||die("$0::CONNECT2CPE_TELNET*c +hild**($ID):ERROR LOCK_EX FAILED $!/$?\n"); my $STRING; if ( $EXIT == 0 ) { while (my ($KEY,$VALUE) = (each %TEMP) ){ $STRING .= "$KEY"; for (my $C=0; $C < @{ $TEMP{$ID}{RESULTS} }; $C++) +{ my $COMMAND = $DATA{$ID}{COMMANDS}[$C]; my $RESULT = $TEMP{$ID}{RESULTS}[$C]; $RESULT =~ s/\r//g; $RESULT =~ s/\n/ /g; $STRING .= "||$COMMAND||$RESULT"; } $T = gettime(); print $FH "$T||$STRING|||\n"; } }elsif ($EXIT == 1){ $T = gettime(); print $FH "$T;$ID;h00kme\n"; }elsif ($EXIT == 2){ $T =gettime(); print $FH "$T;$ID;noble\n"; } close($FH); sleep 0.1; close($CHK); last; } sleep 0.1; $pm->finish($EXIT); ### EXIT with 0 as OK and 1 as IP u +nreachable } $pm->wait_all_children; return %DATA; } ###################################################################### +################################################ ## / SUB CONNECT2CPE_TELNET ######################################## +################################################ ###################################################################### +################################################ ###################################################################### +################################################ ## SUB SENDMAIL #################################################### +################################################ ###################################################################### +################################################ sub sendmail { my ($REPORT,$CONFIG,$RESULT) = @_; my $T = gettime(); my $MAIL_TO = $CONFIG{MAIL_TO}[0]; delete $CONFIG{MAIL_TO}[0]; my @MAIL_CC = $CONFIG{MAIL_TO}; if ($RESULT == 1){ $CONFIG{MAIL_DATA} .= " Overview - completed $T: Pattern matches successful: $REPORT{OK} Pattern matches unsuccessful: $REPORT{NOK} DEVICE UNREACHABLE: $REPORT{UNREACHABLE} ERRORS: $REPORT{ERROR} command success, but no output: $REPORT{NOFEEDBACK} "; $CONFIG{MAIL_SUB} .= "processed $CONFIG{DEVICES_COUNT} devices +. $REPORT{UNREACHABLE} unreachable. "; my $mh = MIME::Lite->new( From => $CONFIG{MAIL_FROM}, To => $MAIL_TO, Cc => @MAIL_CC, Subject => $CONFIG{MAIL_SUB}, Type => 'multipart/mixed' ) or die("$0::SENDMAIL:ERROR creating new mail object: $!/ +$?\n"); $mh->attach ( Type => 'TEXT', Data => $CONFIG{MAIL_DATA}, ) or die("$0::SENDMAIL:ERROR adding the text message part: + $!/$?\n"); $mh->attach ( Type => "text/csv", Path => $CONFIG{OUTCSV}, Filename => $CONFIG{OUTCSV}, Disposition => 'attachment' ) or die("$0::SENDMAIL:ERROR adding $CONFIG{OUTCSV} to mai +l object: $!/$?\n"); $mh->send; }else{ $CONFIG{MAIL_DATA} .= "ERROR: TACACS SERVICE VERIFICATION FAIL +ED!\nReason:"; if ($RESULT == 1){ $CONFIG{MAIL_DATA} .= "HUBSITE: $CONFIG{HUB +SITE} is unreachable\n";} if ($RESULT == 2){ $CONFIG{MAIL_DATA} .= "Provided Username/pa +ssword combination failed Authentication\n";} if ($RESULT == 2){ $CONFIG{MAIL_DATA} .= "Provided Username/pa +ssword combination passed Authentication, but tacacs profile doesn't +allow privileged mode\n";} $CONFIG{MAIL_SUB} .= "$CONFIG{NAME}: tacacs service verificati +on failed. script execution aborted"; my $mh = MIME::Lite->new( From => $CONFIG{MAIL_FROM}, To => $MAIL_TO, Cc => @MAIL_CC, Subject => $CONFIG{MAIL_SUB}, Type => 'multipart/mixed' ) or die("$0::SENDMAIL:ERROR creating new mail object: $!/ +$?\n"); $mh->attach ( Type => 'TEXT', Data => $CONFIG{MAIL_DATA}, ) or die("$0::SENDMAIL:ERROR adding the text message part: + $!/$?\n"); $mh->send; } return $RESULT; } ###################################################################### +################################################ ## / SUB SENDMAIL ################################################## +################################################ ###################################################################### +################################################

Comment on RFC: beginner level script improvement
Select or Download Code
Re: RFC: beginner level script improvement
by toolic (Chancellor) on Sep 19, 2013 at 12:33 UTC
    With the exception of "use xyz.pm" unless its part of the core perl package.
    You are violating your own constraint:
    corelist Parallel::ForkManager MIME::Lite Net::Telnet Parallel::ForkManager was not in CORE (or so I think) MIME::Lite was not in CORE (or so I think) Net::Telnet was not in CORE (or so I think)

      I should have elaborated on that, sorry for the vague explanation. The script is running on a server I don't have root access to and no additonal modules may be installed. I may use those already in place but can not install additonal ones. The constraint was expressed because there would be obvious choices for some stuff that I'm doing like e.g. BerkeleyDB or a forkmanager supporting shared data structs, which I cannot use. EDIT: fixed word mix-up
        Are you allowed to install modules in your home directory?
Re: RFC: beginner level script improvement (version control)
by Anonymous Monk on Sep 20, 2013 at 00:37 UTC

    version control before making any changes, so you can see how the code evolves (and you can undo any changes)

    Just curious, what is your monitor/editor size, what do you see?
    I have 1024x768 with font:DejaVu Sans Mono,size:11, and I see , I see 103 chars/columns by 33 lines
    If I go to font-size 10 I can see your 120 char

    If I run your code through perltidy (as downloaded, with either configuration below)

    ## perltidy -olq -csc -csci=10 -cscl="sub : BEGIN END" -otr -opr -ce +-nibc -i=4 -pt=0 "-nsak=*" ## perltidy -olq -csc -otr -opr -ce -nibc -i=4 -pt=0 "-nsak=*"

    The line count increases from ~1401 to ~1716, ~305 lines added for readability :)

    And perltidy warns about having two functions named sendmail -- one from eod_functions and one from your main script

    And perltidy also helps you keep consistent indentation level( you have some inconsistent ones)

    Another aide to readability is increasing skimmability ( skimmable code is the idea ), that is replace long if/else blocks with functions, for example replace

    with
    my( $NL, $SKIP ) = optionize_nl_skip( \%STATIC );

    I put in optionize cause its close but not quite a good name to describe what the function does, beside return nl and skip

    Why write it this way? Its easier to test , like this

    Also consider renaming sendmail, for example, this is the description for one of them

    ## SUB SENDMAIL ### DOES: generates and sends e-mail to all recipie +nts with attached csv report ##################

    Maybe call it mail_report() or send_report() or report_result( \%REPORT,\%CONFIG,$RESULT )

    Yeah, report_result, cause it explains action and object (send_result_report)

    Other things that need comments (explanation) are regular expressions, because this

    $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]?)://;
    doesn't explain what $TEMP is, or why it needs ...numberregex... removed .... but the whole block should be a function call, something like
    { my( $commands, $matches ) ; ( $_, $commands, $matches ) = sanitize_and_then_some_c +ommands_matches( $_, \@METACHARS,\@TRANSLATIONS ); $DATA{$IP}->{COMMANDS} = $commands; $DATA{$IP}->{MATCHES} = $matches; }

    Other minor things , style related, is this  unless ( $SHELL == '2' || $SHELL == '1' )   it will work, warnings won't complain, but if you're using numeric comparison operator == you might as well save yourself some typing of '' :) see perlnumber

    More on style is  if ($#ARGV < 0 ) { &help($0); exit 0;} is perlishly written as  if( ! @ARGV ){ help($0); exit 1; }

    or  @ARGV or die help($0);

    Speaking of exit, if you put your main program into a subroutine Main you can write  Main( @ARGV ); exit( 0 ); More on this idea (and modulinos ) see Re: No such file or directory error/No such file or directory error, see template at (tye)Re: Stupid question (and see one discussion of that template at Re^2: RFC: Creating unicursal stars

    Other minor issues are 2 argument open instead of 3 argument open, see open

    Sometimes you use &function() but sometimes you use function() -- 99% of the time you don't need the & at all, so think about your reason for using it, then use the same style everywhere (good idea is to prefer less typing :)

    speaking of function names and documentation, sub taint is poorly named, as taint has a specific meaning in perl and it isn't escape_ctrl, which is a better name and more documenting

    speaking of documentation, PARSETEMPDB doesn't describe the database format , maybe you have an example database somewhere which describes the format, so this should be mentioned

    another style thing is how you're UPPERCASENAMING lots and lots and lots and lots and lots of variables, there are various style recommendations about that, one being perlstyle

    $ALL_CAPS_HERE constants only (beware clashes with perl vars!) $Some_Caps_Here package-wide global/static $no_caps_here function scope my() or local() variables

    once you make some of these changes it becomes easier to see what your program is doing, how it works, and what other changes might be recommended

    version control before making any changes, so you can see how the code evolves (and you can undo any changes)

    start a new directory for each block/change :) poor-mans version control

      @all Thank you all for taking the time and secondly for the many helpful hints and pieces of advice. As most of you will have guessed I'm not a programmer but a network engineer in an ISP surrounding so any references to other languages will be lost on me. I only know a little perl and even less bash scripting =). I have set up dir based version control as suggested, svn may not be installed on the server. I will change open, VAR and function naming and formatting as suggested. I will also get rid of redundant #-style formatting as pointed out. And The print here reference is very helpful too. Regarding the function calling I chose to call module-based functions without leading & and vice versa. I will change that too though. Once I have implemented all of the above I will try and work out a more sub'ed style and present the new and hopefully improved version. font (FixedSys) is what vim.common defaulted to in size 9 @1600x900. Format works in vi on Solaris too with the same display settings, also in FullHD on ubuntu in vim.common.

        font (FixedSys) is what vim.common defaulted to in size 9 @1600x900

        ah gvim, I see :) gvimportable also does that on win32, I get L39/W121 (with line numbering of course) and readability doesn't suffer

        Having played with this a bit, I see whats readable about fixedsys(9), its more bold :) the boldness really seems to contribute to readability

        L39/W121 DejaVu Sans Mono Bold,size:10 does a nice impression of fixedsys(9) but it isn't quite as bold(thick)

        even deja..11 bolds isn't quite as bold as fixedsys(9)

        Thanks

Re: RFC: beginner level script improvement
by roboticus (Canon) on Sep 20, 2013 at 00:40 UTC

    georgecarlin:

    Before I go into one of my long, meandering list of things, I'd like to say:

    • Don't get upset by the bits I write here.
    • These are opinions. They're my opinions, so of course at least half of them are right. Though we might disagree about which half that may be.
    • Congratulations! Your indentation style doesn't suck! Meaning that (a) you *use* indentation, (b) and it's consistent. Of course, it's not the best style, but that changes with the weather.

    On a more serious note: By putting your code up here for review, I think you already have the right attitude. Always wanting to improve how you do things is a great skill for a programmer to have.

    OK, then, on to the bitching! I've put it in <readmore> tags so people used to my occasional long and meandering nodes can skip it. A brief summary for them: Naming, whitespace, short subroutines! Possibly a bit more, I don't remember what I wrote, and I hate this keyboard.

      Thank you for taking this much time to help me out! As mentioned above I will implement the formatting and naming changes and then have a crack at trying to "modulize" the code more. On a sidenote I am neither upset, nor offended by people helping me improve, least of all when they spice it up with some good humor ;) I will post the revised version when I've made some progress.

        georgecarlin:

        With a name like that, I expected you to appreciate a bit of humor--or have thick skin. ;^)

        Be sure to /msg me when you post your revised code, so I don't miss it. I'll be happy to look it over again--time permitting.

        ...roboticus

        When your only tool is a hammer, all problems look like your thumb.

Re: RFC: beginner level script improvement
by eyepopslikeamosquito (Canon) on Sep 20, 2013 at 09:13 UTC

    A few random suggestions after skimming your code:

    • Prefer lower case for variable names (your code looks like it's shouting).
    • Learn Perl here documents.
    • Spend more time choosing good names (descriptive, explanatory, consistent, regular, ... spelt-correctly ;-).
    • Your main program is way too long. Decompose it into modules. Write unit tests for each module. Avoid big-arse functions.
    • Run your script through Perl::Critic.
    • Prefer three-argument open.
    • Insert $! in your error strings when a Perl function fails.
    • Prefer low precedence or to ||; for example, prefer or die to || die.
    • Don't use a leading & when calling functions.
    • Avoid C-style for loops. For example, prefer for my $item (@arr) {...$item...} to for(my $I=0;$I<@ARR;$I++) {...$ARR[$I]...}.
    • Prefer my variables to our variables. Declare variables at point of first use (do not declare a huge bunch of variables at the top of a subroutine). Minimize variable scope. Avoid global variables.

Re: RFC: beginner level script improvement
by jwkrahn (Monsignor) on Sep 21, 2013 at 21:54 UTC
    ## set the Newline/Carriage Return character(s) this device expect +s (e.g. NL = \n, CR = \r, CRLF=\r\l) $NL = "\r\l"; $NL = "\r\l";

    The \l escape sequence in interpreted by perl to mean "lower case the next character" so those strings are just the one character \r.    See lcfirst.

    $NL = "\0xa";

    'x' is not a valid octal digit so that string consists of three characters, "\0", 'x' and 'a'.    Perhaps you meant "\x0a"?

    If you need help with network compatible line endings see the Socket module.

    sleep 0.1;

    You use this statement 18 times but sleep does not accept fractions of a second, only whole seconds.    Perhaps you should look at the Time::HiRes module or Perl's select function.

Re: RFC: beginner level script improvement
by jwkrahn (Monsignor) on Sep 23, 2013 at 01:54 UTC

    You seem to be confused about references:

    $RESULT = &getdata(\%DATA,\%CONFIG,\%STATIC); ##read config-file ... if ($PROTO =~ m/ssh/i){ %DATA = &connect2cpe_SSH(\%DATA,\%CONFIG,\%STATIC); }else{ %DATA = &connect2cpe_TELNET(\%DATA,\%CONFIG,\%STATIC); }

    You are calling those functions with references to three hashes but only in getdata() do you actually dereference those hashes:

    $STATIC->{$T[0]}=$T[1]; ... $DATA{$IP}->{COMMANDS} = \@COMMANDS; $DATA{$IP}->{MATCHES} = \@MATCHES;

    Otherwise you are just modifying the file scoped hashes.

    And then for connect2cpe_SSH() and connect2cpe_TELNET() you copy the already modified %DATA back to itself?    Whether you modify %DATA directly or through a reference there is no need to copy it to itself.



    if ($#ARGV < 0 ) { &help($0); exit 0;} ... 'help|h' => sub { &help($0); exit 0;} ) || die(&help($0));

    help() returns a value but you never use that value so why return it?    You pass the $0 variable to help() but because you import help() into the current program the $0 variable is directly available inside help().    Every time you use help() you exit the program.    Perhaps you should put an exit at the end of the help() subroutine and maybe call it "print_help_and_exit"?

Re: RFC: beginner level script improvement
by jwkrahn (Monsignor) on Sep 23, 2013 at 07:10 UTC
    sub sendmail { my ($REPORT,$CONFIG,$RESULT) = @_; my $T = gettime(); my $MAIL_TO = $CONFIG{MAIL_TO}[0]; delete $CONFIG{MAIL_TO}[0]; my @MAIL_CC = $CONFIG{MAIL_TO};

    You pass in three arguments ($REPORT, $CONFIG and $RESULT) but you never actually use these references inside this subroutine.

    delete $CONFIG{MAIL_TO}[0] changes the current value of $CONFIG{MAIL_TO}[0] to undef and returns the previous value, it does not change the size of the array.    What you probably really want to do is:

    my $MAIL_TO = shift @{ $CONFIG{ MAIL_TO } };

    You assign the scalar value $CONFIG{MAIL_TO} to an array but you should just assign it to a scalar variable:

    my $MAIL_CC = $CONFIG{ MAIL_TO };


    if ($RESULT == 1){ ... }else{ $CONFIG{MAIL_DATA} .= "ERROR: TACACS SERVICE VERIFICATION FAIL +ED!\nReason:"; if ($RESULT == 1){ $CONFIG{MAIL_DATA} .= "HUBSITE: $CONFIG{HUB +SITE} is unreachable\n";} if ($RESULT == 2){ $CONFIG{MAIL_DATA} .= "Provided Username/pa +ssword combination failed Auth +entication\n";} if ($RESULT == 2){ $CONFIG{MAIL_DATA} .= "Provided Username/pa +ssword combination passed Auth +entication, but tacacs profile doesn't allow privileged mode\n";}

    The else block of if ($RESULT == 1){ means that $RESULT is NOT equal to 1 but you still test for that.

    Why do you have two tests for $RESULT == 2?

      Thank you very much for pointing out these errors. I also didn't realize that my $var outside of Blocks was a file-wide declaration, I assumed its scope was limited to "Non-Blocks". Now it makes so much more sense =) Thank you for pointing that out! I'm still in the process of rewriting the improved version so this helps me a lot.
Re: RFC: beginner level script improvement
by georgecarlin (Acolyte) on Oct 24, 2013 at 15:29 UTC

    The revised version of the script is completed. I looked into the documentation that all of you provided and added/changed loads of stuff.

    Thank all of you for your valued feedback and pointers. Obviously additional feedback will be highly aprecciated.

    main script (still a work in progress, some stuff will be modified as soon as I know how, as seen in the respective comments) There is a lot of printing for now since it's still an alpha and I prefer too much feedback over too little.

    most of the actual code is in the functions pm now. There are still some fairly large subs, but I'm not sure breaking them down further would serve any purpose, because there won't be any reusability. I tried increasing skimmability according to suggestions. I also changed the forking part considerably because the lack of signal handling and timeout turned out to be an issue.

      Some random comments on your code follow. Please keep in mind that I only casually perused (parts of) your script, so don't consider this a proper code review by any means. I also don't really understand much of the underlying functionality, so this is restricted to Perl-specific aspects of the code.

      storing config options in a list of scalars vs. a hash

      In process_command_line_args you initialize a long list of variables, and pass them back as an array reference:

      sub process_command_line_args { #set default values for dynamic config settings my ($layout,$wait_for_child,$wait_for_exec,$prompt,$configf,$quiet +,$outf,$debug,$batchsize,$proto,$tacacs,$verbose,$header,@maildst) = +(0,120,3,1,"$name.cfg",1,"$name.csv",0,0,"none",0,0); GetOptions ( ...) ... my @args = ($layout,$wait_for_child,$wait_for_exec,$name,$prompt,$ +configf,$quiet,$outf,$debug,$batchsize,$proto,$tacacs,$verbose,$heade +r,$mailref,$path); return \@args; }

      Then in various subs (Main, validate_command_line_args, populate_config_hash) you access its elements via array subscripts and by repeatedly unpacking it into a long list of scalars again.

      This seems like a really cumbersome way to deal with those values (making your script more difficult to maintain).
      A hash would serve them much better I think, especially since in populate_config_hash you end up creating the %CONFIG hash from them anyways.

      One possibility would be to use %CONFIG right from the start:

      sub Main { my %CONFIG; initialize_config_hash(\%CONFIG); get_command_line_args(\%CONFIG); validate_command_line_args(\%CONFIG); get_username_and_password_from_stdin(\%CONFIG) if $CONFIG{prompt}; ... } sub initialize_config_hash { my $CONFIG = shift; %$CONFIG = ( quiet => 0 , cfg => "$name.cfg" , verbose => 0 , outcsv => "$name.csv" , debug => 0 , proto => "none" , prompt => 1 , header => undef , layout => 0 , maildst => [] , wait_for_child => 120 , mail_to => "" , wait_for_exec => 0 , mail_from => "NMS-script@me.net" , batchsize => 0 , mail_sub => "" , tacacs => 0 , mail_cc => "" , tacuser => "user" , mail_data => "" , tacpass => "pass" , ); } sub get_command_line_args { my $CONFIG = shift; GetOptions ( 'layout|l' => \$CONFIG->{layout}, 'file-based-auth|f' => sub { \$CONFIG->{prompt} = 0; }, 'prompt-based-auth|p' => sub { \$CONFIG->{prompt} = 1; }, ... ) ... }

      calling 'next'/'last' to break out of a callback sub...

      ...is not a good idea.

      In process_device you do:

      $WARN = 0; #supress flow control warning in following block due to exi +ting anon sub LOOPCTRL: while ($lb < 10){ $exp->expect(... [ ..., sub {... $lb++; next LOOPCTRL; }], ... ); $exp->expect(... [ ..., sub {... last LOOPCTRL; }] ); } $WARN = 1; # reset to default

      The warning is there for a reason: The callback now never returns to the code that called it (in this case, Expect.pm), so if that code needs to do any cleanup etc. before passing control back to you, that will be skipped which might lead to hard-to-track bugs.

      I don't have hands-on experience with the Expect.pm module, but the documentation suggests that expect() returns a positive number on success and undef otherwise, so it seems to me that this loop could be re-written like so:

      while (...) { next if $exp->expect(... ... ); last if $exp->expect(... ... ); }

      Suppressing the warning becomes unnecessary, and so is the "LOOPCTRL" label btw.

      (Also make extra sure that those expect calls + loop control really result in the intended behavior... I can't help you there, because I have no understading of the external program you're controlling.)

      suppressing warnings

      In my experience, suppressing core Perl warnings is rarely the best solution - usually they are an indicator that what you're trying to do can be done in a better/safer way.
      But even when you do want to temporarily suppress Perl warnings, using a global variable together with a global signal handler is not the proper way to do it. Instead, simply disable the "warnings" pragma within an as-small-as-possible lexical scope:

      use strict; use warnings; # warnings coming from here will be printed { no warnings; # warnings coming from here will NOT be printed } # warnings coming from here will be printed

      Or, even better, only turn off specific warning categories instead of all at once - for example:

      # Don't warn about exiting subs via loop control: no warnings 'exiting'; # Don't warn about using undef in numeric or string operations: no warnings 'uninitialized';

      To suppress warnings emitted by modules (rather than Perl itself), first look if the module provides an option to turn them off. If not, overriding the warn signal handler is the way to go, but this too is better done locally instead of for the whole program:

      { local $SIG{__WARN__} = sub {}; # call the noisy module function here } # warnings coming from here will not be affected

      referencing + dereferencing

      I see some contructs like this in your code:

      \%{ $CONFIG } \%$CONFIG

      You can just write $CONFIG instead. The % dereferences the hash ref, but then the \ takes the reference again - i.e. they cancel each other out.
      Of course if you're doing it on purpose, to remind yourself that what is being passed along is a hash ref - then don't let me keep you from doing so... :)

      creating temporary files

      In populate_config_hash you manually generate a hopefully-unique temporary file name like this:

      my $range = '1000000'; my $rand = int(rand($range)); ##generate random temp-db filename to al +low for simultanous script execution ... tempdb => "$path/$rand.db",

      There is a module for safely creating temporary files: File::Temp (which is part of Perl since v5.6.1)

      unpacking a subroutine argument

      At the beginning of subroutines that only take one argument, you tend to write:

      my $foo = $_[0];

      There's nothing wrong with this technically, but I thought I'd point out that the following idioms are much more commonly used for that:

      my $foo = shift;
      my ($foo) = @_;

      Using shift for this may seem particularly strange to those new to Perl, but it has a lot of tradition and is also very fast.

      Edit: Fixed typo ("shift" not "unshift")

        First of all thank you very much for taking the time to read through and comment on the script.

        I was very unhappy with the locally disabling warnings thing to begin with but failed to come up with a better solution and the entire loop construct is required so the different device output cases are tested and responded accordingly, with respective timeouts and further actions.
        Using the return value of the expect method itsself hadn't occured to me at all, which is very sad considering how obvious it should have been (always is in hindsight when someone else did the thinking for you). Thank you very much for this hint. I will change that section and remove the ugly warnings thing.

        I like some of the "useless" \%{$} and a-like constructs (as long as they don't constitute mistakes) as well as captitalization of some vars because it helps me keep track of where what comes from and why, what it contains and who accesses it, purely by naming and how it is referred to. However I still haven't fixed all inconsistency mistakes in the system.

        The config-hash related changes you propose make a lot more sense than what I'm doing and I'll change the respective parts. Thank you very much for the pointers.
        Same goes for the tempfile part.

        regarding the unpacking a sub argument part
        I read the unshift and sub documentation again and I still don't understand your hint.
        As far as I understand the @_ is a list that contains all arguments the sub was called with and consequently $_[x] would contain the element of that array with index x. I would understand using any of the three below because they produce the identical result in regards to $bar_ref, (while I think shift only makes sense if something might or might not be present at a specific index after 0)

        foo(\%bar); sub bar { my $bar_ref = $_[0]; #I know what is at index 0 and that's what I +want my ($bar_ref) = @_; #same as above but I can not process anything +else from the list my $bar_ref = shift; # same as #1 but I want to continue processin +g @_ and am unsure about indexes and/or presence }
        But the unshift thing I don't understand at all.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (13)
As of 2014-07-31 11:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (248 votes), past polls