in reply to RFC: beginner level script improvement
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.
#!/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 Data::Dumper; use Parallel::ForkManager; 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 $exit = 0; unless( ! @ARGV ){ $exit = Main(); }else{ print_help_and_exit($name); } exit($exit); 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 ( 'layout|l' => \$layout, '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, 'wait-for-childs|w=i' => \$wait_for_child, 'exec-time|e=i' => \$wait_for_exec, '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 = ($layout,$wait_for_child,$wait_for_exec,$name,$prompt,$ +configf,$quiet,$outf,$debug,$batchsize,$proto,$tacacs,$verbose,$heade +r,$mailref,$path); return \@args; } sub Main { #get user defined dynamic config settings and perform various sani +ty checks my $argref = process_command_line_args(); my $batchsize = validate_command_line_args($argref); $argref->[9] = $batchsize; #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); #set up global Output handling set_up_output_handle(\%CONFIG); #retrieve config settings from file my %DATA; get_config_from_file(\%DATA,\%CONFIG,\%STATIC); #print Dumper \%DATA; print Dumper \%CONFIG; print Dumper \%REPORT; warn("load configuration... done\nvalidate configuration... done\ +ninit all data structs... done\n"); #launch tacacs verification if it was requested my $result = 0; if ($CONFIG{tacacs} == 1){ warn("Commencing Tacacs verification process...\n"); $result = check_tacacs_functionality(\%CONFIG); unless($result == 0){ #username + password combination fail +ed, abort execution if ( $CONFIG{mail_to} ){ #mail report was requested, se +nd mail before aborting process_mail_request($result,\%CONFIG); } die("$0:ERROR tacacs functionality verification failed wit +h EC: $result. Aborting script execution.\n"); } }else{ warn("Skipping Tacacs verification process due to user selecti +on...\n"); } #prepare fork_manager operations warn("Configuring Fork manager...\n"); my $pm = configure_forkmanager_calls(\%CONFIG); #start processing devices warn("Distributing tasks to childs...\n"); for my $id (keys %DATA){ my $pid = $pm->start($id) and next; my $exitstate = process_device(\%CONFIG,\%DATA,\%STATIC,$id,$p +m); #decide on protocol, call actual processing subs #exitstate 0 = OK # 1 = NOK => IP unreachable # 2 = NOK => wrong device password # 3 = NOK => no shell received $pm->finish($exitstate); } $pm->wait_all_children; #print Dumper \%DATA; print Dumper \%CONFIG; print Dumper \%REPORT; warn("Forkmanager completed all tasks, all childs terminated\n"); warn("Creating report from temp db...\n"); create_report_from_tempdb(\%REPORT,\%CONFIG); warn("Constructing and sending mail...\n"); process_mail_request(0,\%CONFIG,\%REPORT); unlink $CONFIG{tempdb} or warn("$0:WARNING Unable to delete $CONFI +G{tempdb}. ERR:$?/$!\n"); warn("Main program completed.\nWill now close all open handles and + exit...\n"); close(STDOUT); close(STDERR); return $exit; #will have to be set depending on outcome of actual +script operations }
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 Digest::MD5; use Expect; use Data::Dumper; use Parallel::ForkManager; use MIME::Lite; use Fcntl qw(:DEFAULT :flock); use Data::Dumper; use Exporter; use eod_templates_V2 qw(:ALL); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $OUT); $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 set_up_o +utput_handle check_tacacs_functionality process_mail_request configur +e_forkmanager_calls process_device create_report_from_tempdb process_ +mail_request); %EXPORT_TAGS = ( ALL => [qw(&print_help_and_exit &populate_static_hashes &populate_ +config_hash &validate_command_line_args &get_config_from_file &set_up +_output_handle &check_tacacs_functionality &process_mail_request &con +figure_forkmanager_calls &process_device &create_report_from_tempdb & +process_mail_request)], ); our $WAITFORCHILDS; our %CHILDS; our $WARN = 1; ## Signal handling WARN for block-wide alarm supression if wanted + ################################################## $SIG{'__WARN__'} = sub { unless( $WARN == 0 ){ warn $_[0]; } }; ## 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 in + compliance with unix standard.\n mandatory arguments: --readfile|-r read device IP and commands from file and + perform them on all CPEs (default = $name.cfg. see section config fi +le for help) --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: --layout-cmd-based|-l sets layout of outputfile to command- +based structure. This will print every command-pattern instance into +a new row. (default is one row per device) --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) advanced customization arguments: --wait-for-childs|-w expects timeout in whole seconds (30-1 +80) childs will be allowed to run before being forcefully terminated. + (default = 120) --exec-time|-e expects time in whole seconds (2-60) chi +lds will wait for the devices to process EACH command before proceedi +ng. (default = 3) ATTENTION: big values GREATLY increase total runti +me!!! \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 for security reasons!!! 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 ($layout,$wait_for_child,$wait_for_exec,$name,$prompt,$configf, +$quiet,$outf,$debug,$batchsize,$proto,$tacacs,$verbose,$header,$mailr +ef,$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}; $proto = lc $proto; $WAITFORCHILDS = int($wait_for_child); %$CONFIG = ( layout => "$layout", wait_for_exec => int($wait_for_exec), debug => "$debug", 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 ($layout,$wait_for_child,$wait_for_exec,$name,$prompt,$configf, +$quiet,$outf,$debug,$batchsize,$proto,$tacacs,$verbose,$header,$maild +st,$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; } unless( 30 < $wait_for_child && $wait_for_child < 180 ){ die("-w $ +wait_for_child not permitted. value has to be 30-180 seconds\n"); } unless( 2 < $wait_for_exec && $wait_for_exec < 60 ){ die("- +e $wait_for_exec not permitted. value has to be 2-60 seconds\n"); } + return $batchsize; } ## 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 next unless lc $key eq "mode_cfg" and lc $value eq "yes"; #add +itonal security check is required for configuration access verify_user_authorization(); } } ### SUB verify_user_authorization ### DOES: prompt for pass and com +pare fingerprint of provided pass to secret ### sub verify_user_authorization { #pseudo security to deter i +ncompetent people with tacacs priv. levels they shouldn't have my $input; eval { local $SIG{ALRM} = sub { die("timeout waiting for user input. +Aborting script execution\n") }; alarm 10; print "Shouldn't you know better by now?\n"; $input = <STDIN>; alarm 0; chomp $input; }; if ($@){ die($@); } my $md5 = Digest::MD5->new; $md5->add("$input"); my $key = $md5->hexdigest; unless($key eq "a7ed07a4b4e8ad6c9a5e5a127daa92f1"){die ("You do no +t have permission to use the configure-feature\n"); } } ### 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 prior 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; } ### SUB set_up_output_handle ### DOES: choose output destination and + return filehandle for printing ################ sub set_up_output_handle { my $CONFIG = $_[0]; if ($CONFIG->{quiet} == 1){ #script running in quiet mode, print e +verything to logfile. no autoflush needed. open(STDOUT, ">>", "$CONFIG->{log}") or die("$0:ERROR Unable t +o open $CONFIG->{log} for writing. ERR: $?/$!\n"); open(STDERR, ">>", "$CONFIG->{log}") or die("$0:ERROR Unable t +o redirect STDERR $CONFIG->{log}. ERR: $?/$!\n"); }else{ #script is running in non quiet mode, print everything to shel +l open(STDERR, ">&", "STDOUT") or die("$0:ERROR Unable to redire +ct output to STDOUT. ERR: $?/$!\n"); #set up autoflush for easier debugging/monitoring select(STDERR); #should be unbuffered by default, but to be su +re $| = 1; select(STDOUT); $| = 1; } } ### SUB set_up_output_handle ### DOES: choose output destination and + return filehandle for printing ################ sub check_tacacs_functionality { my $CONFIG = $_[0]; my $shell = 1; my $exp = new Expect; configure_expect($exp,$CONFIG->{debug}); $exp->spawn("ssh", "-l$CONFIG->{username}", "$CONFIG->{password}") + || die("$0:ERROR can not spawn ssh to $CONFIG->{hubsite}. ERR/SYS: $ +! / $?"); select(undef, undef, undef, 0.10); $exp->expect(10, [ qr/\? /, sub { #not a known host $exp->send("yes\n"); select(undef, undef, undef, 0.25); + $exp->send("$CONFIG->{username}\n"); $shell = '0';}], [ qr/assword:/, sub { $exp->send("$CONFIG->{password}\n"); $shell = '0';}], ); unless ( $shell == 1 ) #we have a shell, proceed { $exp->expect(10, [ qr/>/, sub { #entry in unpriv mode, try to gain priv +. access $exp->send("en\n"); select(undef, undef, undef, 0.50); $exp->send("$CONFIG->{PASS}\n"); $shell = 3; }], [ qr/#/, sub { $exp->send("exit\n"); #entry in pri +v successful, no more actions needed unless( $exp->soft_close() ){ $exp->hard_close(); +} $shell = 0 }], [ qr/assword:/, sub { #inital authentication failed unless($exp->soft_close()){$exp->hard_close(); +} $shell = 2; }], ); if ($shell == 3){ $exp->expect(10, [ qr/>/, sub { $exp->send("exit\n"); ## priv access denied. $shell = 3; }], [ qr/#/, sub { $exp->send("exit\n"); ## priv access successful. $shell = 0;}], ); } } return $shell; ## ERRORCODES: # 0 = OK # 1 = NOK - HUBSITE unreachable # 2 = NOK - login to HUBSITE failed # 3 = NOK - changing privileges failed } ### SUB process_mail_request ### DOES: decide what type of mail to b +uild, who to send it to and trigger sending #### sub process_mail_request { my ($result,$CONFIG,$REPORT) = @_; #get mail subject $CONFIG->{mail_sub} = get_mail_subject($result,$CONFIG,$REPORT); #get mail body $CONFIG->{mail_data} =get_mail_body($result,$CONFIG,$REPORT); #construct mail my $mh = MIME::Lite->new( From => $CONFIG->{mail_from}, To => $CONFIG->{mail_to}, Cc => $CONFIG->{mail_cc}, Subject => $CONFIG->{mail_sub}, Type => 'multipart/mixed', ) or die("$0:ERROR creating new mail object: $!/$?\n"); $mh->attach ( Type => 'TEXT', Data => $CONFIG->{mail_data}, ) or die("$0:ERROR adding the text message part: $!/$?\n"); if ($result == 0){ $mh->attach ( Type => "text/csv", Path => $CONFIG->{outcsv}, Filename => $CONFIG->{outcsv}, Disposition => 'attachment', ) or die("$0:ERROR adding $CONFIG->{outcsv} to mail object: $! +/$?\n"); } #send mail $mh->send } ### SUB get_mail_subject ### DOES: returns Mail subject based on $re +sulti and $REPORT ############################### sub get_mail_subject { my ($result,$CONFIG,$REPORT)= @_; my $subject; if ($result == 0){ $subject = "processed $CONFIG->{devices_count} devices. $REPOR +T->{UNREACHABLE} unreachable."; }else{ $subject = "NMS-SCRIPT-REPORT: tacacs service/account verifica +tion failed. script execution aborted"; } return $subject; } ### SUB get_mail_body ### DOES: returns mail body depending on $resu +lt and $Report ################################## sub get_mail_body { my ($result,$CONFIG,$REPORT) = @_; my $body; my $time = gettime(); if ($result == 0){ $body .= " Overview - completed $time: Pattern matches successful: $REPORT->{OK} Pattern matches unsuccessful: $REPORT->{NOK} DEVICE UNREACHABLE: $REPORT->{UNREACHABLE} ERRORS: $REPORT->{ERROR} command success, but no output: $REPORT->{NOFEEDBAC +K} "; }elsif ($result == 1){ $body = "HUBSITE $CONFIG->{hubsite} is unreachable\n"; }elsif ($result == 2){ $body = "Provided Username/password combination failed device +Authentication\n"; }elsif ($result == 3){ $body = "provided tacacs profile doesn't have the required pri +vileges associated with it\n"; } return $body; } ### SUB gettime ### DOES: returns SQL compatible timestamp in UK ti +me ############################################## sub gettime { my ($sec,$min,$hr,$day,$mon,$yr,$dayOfWeek) = localtime(); $yr += 1900; my @weekDays = ("SUN", "TUE", "WED", "THU", "FRI", "SAT"); $mon++; return "$weekDays[$dayOfWeek] $mon/$day/$yr $hr:$min:$sec"; } ### SUB configure_forkmanager_calls ###DOES: prepare forkmanager sub +s and calls ###################################### sub configure_forkmanager_calls { my ($CONFIG) = @_; my $pm = new Parallel::ForkManager($CONFIG->{batchsize}); $pm->run_on_finish( sub { my ($pid, $exitcode) = @_; if ($CONFIG->{quiet} == 0){ if ($exitcode == 0){ print "child(PID = $pid) terminated with exit +state: $exitcode = OK. PID will be removed from IPC-inventory.\n"; }else{ print "child(PID = $pid) terminated with exit +state: $exitcode = NOK. PID will be removed from IPC-inventory.\n"; } } delete $CHILDS{$pid}; } ); $pm->run_on_wait(\&terminate_unresponsive_child, 0.1); $pm->run_on_start( sub { my ($pid,$ident) = @_; $CHILDS{$pid} = time(); print "forking child with pid = $pid at ts = $CHILDS{$pid} +...\n"; } ); return $pm; } ### SUB terminate_unresponsive_child ### DOES: send termination to u +nresponsive child ############################### sub terminate_unresponsive_child { while ( my ($pid, $start_ts) = each %CHILDS ){ next unless time() - $start_ts > $WAITFORCHILDS; kill TERM => $pid; warn("child(PID = $pid) timed out, forcefully terminating chil +d\n"); delete $CHILDS{$pid}; } } ### SUB process_device ###DOES: connect to device with and perform +various commands ############################### sub process_device { my ($CONFIG,$DATA,$STATIC,$id,$pm) = @_; my $alarm = $WAITFORCHILDS - 30; alarm $alarm; #set up static timeout to avoid dead forking slots warn("Connecting to device ip $id with timeout of $alarm s...\n"); + #could be made dynamic $SIG{TERM} = sub { #write_data_to_tempdb(\%{ $CONFIG }, 0, 0, $id, 3); #this woul +d be graceful shutdown but shouldn't be possible die("child($id) received SIGTERM from parent.\n"); }; $SIG{ALRM} = sub { write_data_to_tempdb(\%{ $CONFIG }, 0, 0, $id, 3); die("child($id) exceeded timeout. terminating child\n"); }; my $exp = new Expect; configure_expect($exp,$CONFIG->{debug}); my ($nl,$skip) = get_static_chars($STATIC->{CHAR_NL},$STATIC->{CMD +_SKIP}); #translate static chars fom config my $shell = 1; #set to 1 if ($CONFIG->{proto} eq "telnet"){ $exp->spawn($CONFIG->{proto}, $id) or die("$0:ERROR Unable to +spawn $CONFIG->{proto} session to $id. ERR: $! / $?"); #spawn telnet }else{ $exp->spawn($CONFIG->{proto}, "-l$CONFIG->{username}", $id) or + die("$0:ERROR Unable to spawn $CONFIG->{proto} session to $id. ERR: +$! / $?"); #spawn ssh } select(undef, undef, undef, 0.50); $shell = authenticate_with_device($exp,\%$CONFIG,\%$STATIC,$nl); # +authenticate with device. retval 0=OK,2=NOK=>auth failed, 3=NOK no pr +ompt received my %temp; my @results; if($shell == 0){ #this var is 0 for OK or 1-3 for errors. execute +device interaction only if prior tasks returned OK my $sbc = change_cli_mode($exp,\%$CONFIG,\%$STATIC,$nl); #swit +ch to desired cli mode, specified in config file $exp->clear_accum(); $exp->send("$nl"); my $router; $exp->expect(5, [ qr/$sbc/, sub { $router = $exp->before(); $router =~ s/\s//g; }] ); for (my $c=0; $c < @{ $DATA->{$id}->{commands} }; $c++){ + my $command = $DATA->{$id}->{commands}[$c]; my $matches_ref = $DATA->{$id}->{matches}[$c]; $exp->clear_accum(); $exp->send("$command$nl"); sleep $CONFIG->{wait_for_exec}; ##wait for router t +o execute command my $lb = 0; my $fb = ""; $WARN = 0; #supress flow control warning in following bloc +k due to exiting anon sub LOOPCTRL: while ($lb < 10){ $exp->expect(5, [ qr/\Q$STATIC->{CHAR_PAGE}/, sub { ##case 1: PAGE +D OUTPUT, send SKIP and next with COUNTER+1 $fb .= $exp->before(); $exp->send("$skip"); $lb++; next LOOPCTRL; }], [ qr/\Q$STATIC->{CHAR_CONFIRM}/, sub { ##case 2: C +ONFIRM, send COMMAND and next with counter +1 $fb .= $exp->before(); $exp->clear_accum(); $exp->send("$STATIC->{CMD_CONFIRM}$nl"); $lb++; next LOOPCTRL }], ); $exp->expect(1, ##this needs to be here because it +matches before above conditons do [ qr/$sbc/, sub { ##PAGED + CONFIRM done if they o +ccured, now one forced SBC match $fb .= $exp->before(); $fb .= $exp->after(); #################some de +vices echo commands, this needs to be fixed by dynamic pty settings + last LOOPCTRL; }], ##none of the aboce occ +ured, exit loop ); } $WARN = 1; # reset to default unless($fb eq ""){ #no regex-ops required if we didn't ge +t any output $fb =~ s/\Q$STATIC->{CMD_SET_NO_PAGE}//g; #clear_accum + doesn't clear the last expect call from buffer, remove this from fb +manually $fb =~ s/$router|$sbc//g; #remove device name and sbc +from fb $fb =~ s/\Q$command//g; #remove echoed command from fb + } unless( $fb =~ /[A-Z]|[a-z]|[0-9]/ ){ #contains meaningful + chars $fb = "noFB"; } my $string .= parse_device_output($matches_ref,$fb,\%{ $ST +ATIC }); if ($CONFIG->{verbose} == 1){ $fb =~ s/\n/ /g; push(@results,"$string||$fb"); }else{ push(@results,"$string"); } } }else{ warn("ERROR while trying to authenticate on device. EC: $shell +\n"); } $temp{$id}->{results} = \@results; unless($STATIC->{MODE_CFG} eq "no"){ $exp->send("$STATIC->{CMD_ROO +TDIR}$nl");} #KI ID = 1 unless($STATIC->{MODE_WR} eq "no" ){ $exp->send("$STATIC->{CMD_ +WR}$nl");} #KI ID = 1 $exp->send("$STATIC->{CMD_QUIT}$nl"); unless($exp->soft_close()){$exp->hard_close();} #print Dumper \%temp; write_data_to_tempdb(\%{ $CONFIG }, \%{ $DATA }, \%temp, $id, $she +ll); alarm 0; #cancel timeout warn("all tasks completed within timeout. Terminating child for $i +d...\n"); return $shell; } ### SUB write_data_to_tempdb ### DOES: write result data to tempdb # +################################################## sub write_data_to_tempdb { my ($CONFIG,$DATA,$temp,$id,$exit) = @_; my ($i,$chk,$fh)=(0); while ( $i<=50 ){ $i++; select(undef, undef, undef, 0.25); open($chk, ">", "$CONFIG->{lockfile}") or next; open($fh, ">>", "$CONFIG->{tempdb}") or die("$0:($id):ERROR Un +able to write to file $CONFIG->{tempdb}. ERR: $!/$?\n"); flock($fh, LOCK_EX) or die("$0:($id):ERROR LOCK_EX FAILED on $ +fh. ERR: $!/$?\n"); my $string; if ( $exit == 0 ) { while (my ($key,$value) = (each %{ $temp }) ){ $string .= "$key"; my @lines; 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"; if ($CONFIG->{layout} == 1){ #instead of appending + to string, push to array, to change layout in csv push(@lines, $string); $string = "$key"; #reset string to contain +just the device IP } } if(@lines > 0){ #layout is command per row, + so array was filled foreach(@lines){ my $t = gettime(); print $fh "$t||$_|||\n"; } }else{ #layout is device per row by def +ault my $t = gettime(); print $fh "$t||$string|||\n"; } } }elsif ($exit == 1){ my $t = gettime(); print $fh "$t;$id;h00kunreach\n"; }elsif ($exit == 2){ my $t =gettime(); print $fh "$t;$id;h00knoenable\n"; }elsif ($exit == 3){ #this should be changed to + be command-instance specific, so potentially successful commands are +n't lost my $t = gettime(); print $fh "$t;$id;h00ktimeout\n"; } close($fh); select(undef, undef, undef, 0.10); close($chk); last; } } ### SUB parse_device_output ### DOES: parse output from remote devic +e and generate result string #################### sub parse_device_output { my ($matches_ref,$fb,$STATIC) = @_, my ($method,$addpos,$addneg,$case,$res) = (0,"inclusive patterns: +* ","exclusive patterns: * ",1, "OK "); my ($negpatterns,$patterns); #print Dumper \$matches_ref; foreach (@{ $matches_ref }){ next unless defined($_); my $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 eq "noFB" ){ $case = 0; $res = "NO FEEDBACK"; $fb = "device didn't return any output"; last; }elsif ($match eq 'no-match-hook' && ! ( $fb =~ /$STATIC-> +{CHAR_INVALID}/i ) ){ $case = 2; last; }elsif ($match eq 'no-match-hook' && $fb =~ /$STATIC->{CHA +R_INVALID}/i){ $res = "ERROR"; $fb = "invalid command or syntax error"; $case = 0; last; } if ( $method == 0){ ##method pos. pattern if ( $fb =~ /$match/i ){ $addpos .= "$match*"; }else{ $res = "NOK "; } }elsif ($method == 1 && $case == 1){ ##method exclusive pa +ttern match if ( ! ($fb =~ /$match/i) ){ $addneg .= "$match*"; }else{ $res = "NOK "; } } }else{ $res = "ERROR"; $fb = "Device didn't react to command"; $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: $pa +tterns"; } if(defined($negpatterns)){$res .=$addneg; $tmp .= "exclusive: +$negpatterns";} $resref = "$res||$tmp"; } return $resref; } ### SUB configure_expect ### DOES: set up expect config static as w +ell as dynamic ################################## sub configure_expect { my ($exp,$debug) = @_; $exp->log_stdout($debug); #For debugging only $exp->exp_internal($debug); #For debugging only $exp->log_user($debug); #For Debugging only $exp->raw_pty(0); $exp->match_max(1000000) } ### SUB change_cli_mode ### DOES: switch to privileged or configure + mode if specified in config file ############### sub change_cli_mode { my ($exp,$CONFIG,$STATIC,$nl) = @_; my $sbc = $STATIC->{CHAR_DIS}; #default entry cli mode should be d +isabled if ($STATIC->{MODE_EN} eq "yes"){ #privileged mode was specified i +n configfile $exp->expect(5, [ qr/$sbc/, sub { $exp->send("$STATIC->{CMD_EN}$nl");}], #entry +was to unpriv., so change priv. now [ qr/$STATIC->{CHAR_EN}/, sub { $exp->send("$nl");}], #we entered with +priv., send NL ); $exp->expect(5, [ qr/assword:/, sub { $exp->send("$CONFIG->{PASS}$nl");}], #in some +cases changing priv. requires password/secret [ qr/$STATIC->{CHAR_EN}/, sub { $exp->send("$nl");}], #we didn't need a + password, send NL ); $sbc = $STATIC->{CHAR_EN}; } if ($STATIC->{CMD_SET_NO_PAGE} ne '?'){ $exp->send("$STATIC->{CMD_ +SET_NO_PAGE}$nl");} #this device supports terminal length settings, u +se it if ($STATIC->{MODE_CFG} eq "yes"){ #config mode was specifi +ed in config file $exp->expect(5, [ qr/$sbc/, sub { #we're not in config +ure mode $exp->send("$STATIC->{CMD_CFG}$nl");}], #OR cfg + and priv. chars are equal in which case we'll enter conf mode again/ +pr produce an irrelevant error [ 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(); return $sbc; } ### SUB authenticate_with_device ###DOES: perform authentication on +device and return var indicating state ########## sub authenticate_with_device { my ($exp,$CONFIG,$STATIC,$nl) = @_; my $shell = 3; $exp->expect(10, [qr/ogin:/, sub { $exp->send("$CONFIG->{username}$nl"); #teln +et some devices select(undef, undef, undef, 0.50); $shell = 2; }], [qr/sername:/, sub { $exp->send("$CONFIG->{username}$nl"); #teln +et some other devices select(undef, undef, undef, 0.50); $shell = 2 }], [qr/\? /, sub { #not a known hos +t - ssh $exp->send("yes$nl"); select(undef, undef, undef, 0.50); $shell = 2; }], [ qr/assword:/, sub { #known host - + ssh $exp->send("$CONFIG->{password}$nl"); $shell = 2; select(undef, undef, undef, 0.50); }], ); $exp->clear_accum(); unless($shell == 3){ $exp->expect(5, [ qr/assword:/, sub { $exp->send("$CONFIG->{password}$nl"); select(undef, undef, undef, 0.25);} ], [ qr/$STATIC->{CHAR_DIS}/, sub { $exp->send("$nl"); ##entry in unpriv. mode +=> proceed $shell = 0; }], [ qr/$STATIC->{CHAR_EN}/, sub { $exp->send("$nl"); ##entry in priv. mode => + proceed $shell = 0; }], ); $exp->expect(5, [ qr/assword:/, sub { unless($exp->soft_close()){$exp->hard_close(); +}}], ##authentication failed [ qr/$STATIC->{CHAR_DIS}/, sub { $exp->send("$nl"); ##entry in unpriv. mode +=> proceed $shell = '0';}], [ qr/$STATIC->{CHAR_EN}/, sub { $exp->send("$nl"); ##entry in priv. mode => + proceed $shell = '0';}], ); } return $shell; #0 = OK, 2= auth failed/wrong password 3= n +o prompt } ### SUB get_static_chars ### DOES: translate newline char from conf +igfile to character ############################# sub get_static_chars { my ($char_nl,$cmd_skip) = @_; my $nl; if ($char_nl eq "NL"){ $nl = "\n"; }elsif($char_nl eq "CR"){ $nl = "\r"; #}elsif($char_nl eq "HEXNL"){ ##still needs testing #$nl = "\0xa"; } my $skip; if ($cmd_skip eq "SPACE"){ $skip = "\032"; }elsif($cmd_skip eq "NL"){ $skip = $nl; }else{ $skip = "$cmd_skip$nl"; } return ($nl,$skip); } ### SUB create_report_from_tempdb ### DOES: read tempdb and create + report in file and populate %REPORT ############ sub create_report_from_tempdb { my ($REPORT,$CONFIG) = @_; open(my $csv, ">", "$CONFIG->{outcsv}") or die("$0:ERROR Unable to + open $CONFIG->{outcsv} for writing! ERR:$!/$?\n"); my $th = "DATE;IP"; open(my $db, "<", "$CONFIG->{tempdb}") or die("$0:ERROR Unable to +open $CONFIG->{tempdb}! ERR:$!/$?\n"); my @lines; my ($count,$countref)=(0,0); # init current element count and peak + element count for column count management while (<$db>){ $_ =~ s/\|\|\|//; #remove tempdb Set separator my @temp = split(/\|\|/, $_); $count = @temp; #save current element counter if ($count > $countref){$countref = $count;} # if current elem +ent counter is higher than peak, change peak to current if ($_ =~ /h00kunreachable/i ){ ##translate hooks i +nto report-text and increment REPORT-counters, next where apropriate $_ =~ s/h00kunreachable/IP is unreachable/; push(@lines, $_); $REPORT->{UNREACHABLE}++; next; }elsif ($_ =~ /h00knoenabl/i or $_ =~ /h00ktimeout/i){ $_ =~ s/h00knoenable/Changing into privileged mode failed/ +; $_ =~ s/h00ktimeout/child process timed out/; push(@lines, $_); $REPORT->{ERROR}++; next; }elsif ($_ =~ /noFB/i ){ #don't know if all commands fa +iled, so this line needs further processing $_ =~ s/noFB/Command did not return any output/; #replace +the hook with a comprehensive output and continue with main loop $REPORT->{NOFEEDBACK}++; } my $string = ""; foreach(@temp){ #create row and store as string next unless defined($_) and $_ ne ""; $string .= "$_;"; } $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"; my $c = 1; while ( $c < $countref - 1 ){ #create table header with peak co +lumn width $th .= ";COMMAND;RESULT;DETAILS"; if($CONFIG->{verbose} == 1){$th .= ";VERBOSE FEEDBACK"; $c +=1 +;} $c += 3; } unshift(@lines,$th); # put header in front of table-data foreach (@lines){ # print report to file print $csv "$_\n"; } close($db); close($csv); } 1;
|
---|
Replies are listed 'Best First'. | |
---|---|
Re^2: RFC: beginner level script improvement (various comments)
by smls (Friar) on Oct 30, 2013 at 10:26 UTC | |
by georgecarlin (Acolyte) on Oct 30, 2013 at 14:56 UTC | |
by smls (Friar) on Oct 31, 2013 at 03:20 UTC | |
by georgecarlin (Acolyte) on Nov 04, 2013 at 13:25 UTC | |
by smls (Friar) on Nov 05, 2013 at 07:32 UTC |
In Section
Meditations