#!/usr/bin/perl -w

use strict;
use File::Find;
use Cwd 'abs_path';
BEGIN { ##Discover and use required modules automatically at compile time
	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 with 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,$header,$mailref,$path);
	return \@args;	
}


sub Main {
	#get user defined dynamic config settings and perform various sanity 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 failed, abort execution
			if ( $CONFIG{mail_to} ){	#mail report was requested, send mail before aborting
				process_mail_request($result,\%CONFIG); 
			}
			die("$0:ERROR tacacs functionality verification failed with EC: $result. Aborting script execution.\n");
		}
	}else{
		warn("Skipping Tacacs verification process due to user selection...\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,$pm); #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 $CONFIG{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	
}	


##</code><code>##

package eod_functions_V2;

use strict;
use warnings;
use Cwd 'abs_path';
use File::Find;
BEGIN { ##Discover and use required modules automatically at compile time
	my $ABS_PATH = abs_path($0);
	find(\&wanted, $ABS_PATH);
	sub wanted {
		if ( $_ eq "eod_templates_V2.pm"){unshift(@INC,$File::Find::dir);}
	}	
}
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_output_handle check_tacacs_functionality process_mail_request configure_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 &configure_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 yourself 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 file 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 device access when asked. (default = enabled)
					WARNING: Supercedes LOGIN details in config file you 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 output to.  (default = $name.csv)
		--no-quiet|-n		log to STDOUT instead of logfile (mandatory 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 outputfile. Depending on the executed commands this can be several hundred characters!!! (default = disabled)	
		--Version|-V		display extenensive version information and 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 addresses to send generated report to as argument (default = disabled)
					alternatively it can be invoked multiple times with different addresses. (First occurence will always be TO, all others CC)

		--max-connections|-m	run script in forked mode (massively enhances performance) with the specified ammount of max child processes (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-180) childs will be allowed to run before being forcefully terminated. (default = 120)
		--exec-time|-e		expects time in whole seconds (2-60) childs will wait for the devices to process EACH command before proceeding. (default = 3)
					ATTENTION: big values GREATLY increase total runtime!!! 					
	
		\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 it 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,$mailref,$path) = @{ $arrayref };
	my $range = '1000000';
	my $rand = int(rand($range)); ##generate random temp-db filename to 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 selected, get username and password now otherwise when parsing config-file
	}
}	


###  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 username 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,$maildst,$path) = @{ $_[0] };
	if ( $header ){ 
		print get_tmpl('version'); 
		exit 0; 
	}
	unless($proto =~ /ssh|telnet/i){ 
		die("$0:ERROR: Connection protocol must be specified.\n");
	}
	unless( -e $configf){ die("$0:ERROR: $configf not found in $path. typo or missing path?\n");}       	
	if ($debug == 1 && $quiet == 1){ die("$0:ERROR: log-level=debug can 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 valid 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 option and will be ignored!\n"); #key is not supported and will be ignored
	}

}

##  SUB get_config_from_file ### DOES: process config file and set populate 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 which
				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 definitions
			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 valid ipv4 IP addr, this is a device-commands set
			my (@metachars,@translations);
			populate_static_arrays(\@metachars,\@translations);
			$_ = substitute_escaped_metachars($_,\@metachars,\@translations); #substitute escaped metachars to prevent config parser from interpreting them
			my @temp = split(/,/, $_); #split line from config-file into 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 first 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 patterns
					$temp2[0] = substitute_placeholders($temp2[0],\@metachars,\@translations); #all splitting is done on this string, revert it back to its original form
					$commands[$i] = $temp2[0]; #this is the command
					
					for (my $c=1; $c < @temp2; $c++){ #these are all the 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],\@metachars,\@translations); ##undo prior substitutions
					$commands[$i] = $temp[$i];
					$arr[$i] = "no-match-hook"; ##set flag for easy identification 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 contain 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 definition missing in $CONFIG->{cfg}.Aborting Execution.\n");} #missing key definition, this can not be tolerated
		next unless lc $key eq "mode_cfg" and lc $value eq "yes"; #additonal security check is required for configuration access
		verify_user_authorization();
	}
}


###  SUB verify_user_authorization  ###  DOES: prompt for pass and compare fingerprint of provided pass to secret  ###
sub verify_user_authorization {			#pseudo security to deter incompetent 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 not have permission to use the configure-feature\n"); }

}

###  SUB populate_static_arrays  ### DOES: populate static arrays metachars and translations  ########################
sub populate_static_arrays {
	my ($meta_ref,$trans_ref) = @_;
	@{ $meta_ref } = (':','=','!',','); #declare config metachars
	@{ $trans_ref }  = ('#00','#01','#02','#03') #declare bi-directional 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;   ## hardcoded ESCSEQ => #
	}	
	return $line;
}	


###  SUB substitute_placeholders  ### DOES: revert string to its original 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 everything to logfile. no autoflush needed.
		open(STDOUT, ">>", "$CONFIG->{log}") or die("$0:ERROR Unable to open $CONFIG->{log} for writing. ERR: $?/$!\n");
		open(STDERR, ">>", "$CONFIG->{log}") or die("$0:ERROR Unable to redirect STDERR $CONFIG->{log}. ERR: $?/$!\n");
	}else{
		#script is running in non quiet mode, print everything to shell
		open(STDERR, ">&", "STDOUT") or die("$0:ERROR Unable to redirect output to STDOUT. ERR: $?/$!\n");
		#set up autoflush for easier debugging/monitoring
		select(STDERR); #should be unbuffered by default, but to be sure
		$| = 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 priv 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 build, 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 $resulti and $REPORT  ###############################
sub get_mail_subject {
	my ($result,$CONFIG,$REPORT)= @_;
	my $subject;
	if ($result == 0){
		$subject = "processed $CONFIG->{devices_count} devices. $REPORT->{UNREACHABLE} unreachable.";
	}else{
		$subject = "NMS-SCRIPT-REPORT: tacacs service/account verification failed. script execution aborted";

	}
	return $subject;
}


###  SUB get_mail_body  ### DOES: returns mail body depending on $result 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->{NOFEEDBACK}
			";
	}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 privileges associated with it\n";
	}
	return $body;	
}


###  SUB gettime  ###  DOES: returns SQL compatible timestamp in UK time  ##############################################
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 subs 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 unresponsive 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 child\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 would 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 prompt 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); #switch 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 to execute command
	       		my $lb = 0;
			my $fb = "";	
			
			$WARN = 0; #supress flow control warning in following block due to exiting anon sub
			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 { ##case 2: CONFIRM, 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 occured, now one forced SBC match 
						$fb .= $exp->before();
						$fb .= $exp->after(); #################some devices echo commands, this needs to be fixed by dynamic pty settings	
						last LOOPCTRL; 	}], ##none of the aboce occured, exit loop	 
	                        );
			}
			$WARN = 1; # reset to default
			
			unless($fb eq ""){  #no regex-ops required if we didn't get 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,\%{ $STATIC });
			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_ROOTDIR}$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, $shell);
	alarm 0; #cancel timeout
	warn("all tasks completed within timeout. Terminating child for $id...\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 Unable 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 default	
					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 aren'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 device 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->{CHAR_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 pattern 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: $patterns"; } 
		if(defined($negpatterns)){$res .=$addneg; $tmp .= "exclusive: $negpatterns";} 
		$resref = "$res||$tmp";
	}
	return $resref;
}

###  SUB configure_expect  ###  DOES: set up expect config static as well 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 disabled
	if ($STATIC->{MODE_EN} eq "yes"){ #privileged mode was specified in 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, use it
	
	if ($STATIC->{MODE_CFG} eq "yes"){		#config mode was specified in config file
		$exp->expect(5,
			[ qr/$sbc/, sub { 					#we're not in configure 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");		#telnet some devices
					select(undef, undef, undef, 0.50);
					$shell = 2;				}],
		
		[qr/sername:/,	sub {
					$exp->send("$CONFIG->{username}$nl");		#telnet some other devices
					select(undef, undef, undef, 0.50);
					$shell = 2 				}],

		[qr/\? /,	sub {							#not a known host - 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= no prompt
}

###  SUB get_static_chars  ###  DOES: translate newline char from configfile 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 element counter is higher than peak, change peak to current 
		
		if ($_ =~ /h00kunreachable/i ){			##translate hooks into 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 failed, 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 column 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;