#!/usr/bin/perl

package aconfig;
use strict;
use warnings;

use IO::File;
use Getopt::Std;
use Net::Telnet::Cisco;
use vars qw($opt_c $opt_e $opt_l $opt_t $opt_V $opt_v);

use constant PREAMBLE => qq{ no strict; no warnings; package main; };

$|++;

getopts('c:el:t:Vv');
$opt_t ||= 60;			# Default timeout for commands
$opt_l ||= 20;			# Default login timeout

$opt_t += time if $opt_t =~ /^\+\d+/;

# Setup our die() and warn() handlers to provide localized information
our $ip;
sub warn_handler {
    warn scalar(localtime(time)) 
	. " [" . ($main::ADDR || $ip || 'no ip') . "]: ", @_;
}

sub die_handler {
    die scalar(localtime(time)) 
	. " [" . ($main::ADDR || $ip || 'no ip') . "]: ", @_;
}

$SIG{__WARN__}	= \&warn_handler;
$SIG{__DIE__}	= \&die_handler;

# Compose the command scripts we will be using
sub _read_commands ($) {
    my @c = ();

    for my $f (split(/,+/, shift))
    {
	my $fh = new IO::File $f
	    or die "Cannot open script file $f: $!\n";

	push @c, $fh->getlines;

	$fh->close;
    }
				# Strip comments away
    return map { $_ =~ s/%#.*$//g; $_ } @c;
}

our @commands = _read_commands $opt_c;

for (my $line = 0; $line <= $#commands; $line ++)
{

    if ($commands[$line] =~ m!%INCLUDE ([^%]+)%!) {
	die "Failed to include '$1' as referenced: $!\n"
	    unless -f $1;

	splice(@commands, $line, 1, _read_commands $1);
    }

}

while (<>) 
{
    my ($us, $ex, $en);
    ($main::ADDR, $us, $ex, $en) = split(/\s+/, $_);
    $us ||= 'dummy';

    warn "begin\n" if $opt_v;

    $main::TELNET = Net::Telnet::Cisco->new
	( 
	  Host           	=> $main::ADDR,
	  Timeout        	=> $opt_t,
	  Errmode        	=> "return",
	);

    if (! $main::TELNET) {
	warn "Cannot telnet\n";
	next;
    }

    $main::TELNET->ignore_warnings(1);

    if ($us and $ex)
    {
	my $r;

	eval 
	{
	    $r = $main::TELNET->login
		(Name => $us, 
		 Password => $ex, 
		 Timeout => $opt_l || $opt_t,
		);
	};

	if (!$r and !$@)
	{
	    warn "Cannot login: $@\n";
	    next;
	}
    }

    # Initialize the state of our interpreter
    $main::LAST = '';
    my $perlc = '';
    my $failed = 0;
    my @Commands = split(/\n/, join('', @commands));
    my %Labels = ();

    for (my $i = 0; $i < @Commands; $i++) 
    {
	my $c = $Commands[$i];

	while ($c =~ s/%LABEL\s+([^%]+)%//) 
	{
	    $Labels{$1} = $i;
	}

	if ($c =~ /%GOTO\s+([^%]+)%/) 
	{
	    $i = $Labels{$1} if exists $Labels{$1};
	    next;
	}

	if ($c =~ /%SGOTO\s+([^%]+)%/) 
	{
	    no strict "refs";
	    $i = $Labels{$1} if exists $Labels{$1} and ${'main::' . $1};
	    next;
	}

	if ($c =~ /%RGOTO\s+([^%]+)%/) 
	{ 
	    $i = $Labels{${'main::' . $1}} if exists $Labels{${'main::' . $1}};
	    next;
	}

	if ($c =~ /%ENABLE%/) 
	{
	    warn "Cannot enable\n" unless $main::TELNET->enable($en);
	    next;
	}

	if ($c =~ /%EXEC%/) 
	{
	    warn "Cannot disable\n" unless $main::TELNET->disable();
	    next;
	}

	# A Perl one-liner...
	while ($c =~ /%{(.*?)}%/ms) 
	{
	    my @ret = eval PREAMBLE . $1;
	    my $out = join("\n", grep { defined $_ } @ret);
		warn "Perl code output: $@\n" if $@;
	    $c =~ s/%{.*?}%/$out/s;
	}

	# Starting perl-brace...
	if ($c =~ /%\{(.*?)$/ms) 
	{
	    $perlc = $1 . "\n";
	    $c =~ s/%\{(.*?)$//;
	}

	# Ending perl-brace...
	if ($c =~ /^(.*?)\}%/ms) 
	{
	    $perlc .= $1;
	    $c =~ s/^.*?\}%//;
	    my @ret = eval PREAMBLE . $perlc;
	    $perlc = '';
	    warn "Perl code output: $@\n" if $@;
	    substr($c, 0, 0) = join("\n", grep { defined $_ } @ret);
	}
	
	# Whithin the perl-braces...
	if ($perlc) 
	{
	    $perlc .= $c . "\n";
	    next;
	}
	
	# Now $c might be a few lines long, so...
	for my $nc (split(/\n/, $c)) 
	{
	    next if $nc =~ /^\s*$/;
	    
	    while ($nc =~ m/%\[(.+)\]%/) 
	    {
		my $sub = eval PREAMBLE . '"' . $1. '"';
		$nc =~ s/%\[(.+)\]%/$sub/g;
	    }
	    
	    print STDERR "$nc\n" if $opt_V;
	    eval
	    {
		my @o = $main::TELNET->cmd(String => $nc,
					   Timeout => $opt_t,
					  );
		if (!@o and $main::TELNET->errmsg) 
		{
		    warn "command $nc failed(", $main::TELNET->errmsg, 
		    ")\n";
		    $failed = 1;
		    last if $opt_e;
		}
		$main::LAST = join('', @o);
	    };

	    if ($@)
	    {
		warn "Problem with Telnet object: $@\n";
		last;
	    }
	}
    }
    warn "done\n" if (!$failed and $opt_v);
}
