#!/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    
}
[download]

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;
[download]