Net::Autoconfig - Perl extension for provisioning or reconfiguring network devices.

  use Net::Autoconfig;

  $autoconfig  = Net::Autoconfig->new();
  $devices     = load_devices('path/to/device.cfg');
  $template    = load_template('path/to/template.cfg');

  $autoconifg->autoconfig($devices, $template);

  Look at the YAML documentation on cpan.org for more information
  regarding the configuration files.

package Net::Autoconfig;

use 5.008008;
use strict;
use warnings;

use Log::Log4perl qw(:levels :easy);
use Net::Autoconfig::Device;
use Net::Autoconfig::Template;
use Data::Dumper;
use POSIX ":sys_wait_h";
use Cwd;

our $VERSION = '1.11';

################################################################################
# Constants and Global Variables
################################################################################

use constant TRUE	=>	1;
use constant FALSE	=>	0;

use constant MAXIMUM_MAX_CHILDREN => 256; # Absolute Maximum # of child processes (if using bulk mode)
use constant DEFAULT_MAX_CHILDREN => 64;  # Default max # of child processes (if using bulk mode)
use constant MINIMUM_MAX_CHILDREN => 1;   # Absolute Minimum # of child processes (if using bulk mode)

use constant DEFAULT_LOGFILE      => 'logging.conf';

use constant MAXIMUM_LOG_LEVEL    => 5;   # Absolute Maximum log level
use constant DEFAULT_LOG_LEVEL    => 3;   # Set the default log level to info
use constant MINIMUM_LOG_LEVEL    => 0;   # Absolute Minimum log level

use constant DEFAULT_BULK_MODE    => TRUE; # Enable parallel processing by default

# A hash ref to store child processes.
# Contains active processes, and return values
our $CHILD_PROCESSES = {};
$CHILD_PROCESSES->{'active'}   = {};
$CHILD_PROCESSES->{'finished'} = {};
$CHILD_PROCESSES->{'info'}     = {};

# Zombies are dead child processes that need to
# be reaped.
our $ZOMBIES;

# Setup signal handling for reaping our own zombies.
# Zombie handling is done by _reaper, which is in the
# private methods section.
$SIG{'CHLD'} = sub { $ZOMBIES++ };

################################################################################
# Methods
################################################################################

############################################################
# Public Methods
############################################################

########################################
# new
# public method
#
# Create a new Net::Autoconfig object.
#
# Log levels (not implemented yet):
# 0 = Fatal => Least verbose
# 1 = Error
# 2 = Warn
# 3 = Info
# 4 = Debug
# 5 = Trace => Most verbose
#
########################################
sub new {
	my $invocant  = shift; # calling class	
	my $class     = ref($invocant) || $invocant;
	my $log       = Log::Log4perl->get_logger("Net::Autoconfig");
    my %user_data = @_;

	my $self = {
				bulk_mode		=>	DEFAULT_BULK_MODE,
				log_level		=>	DEFAULT_LOG_LEVEL,
				max_children	=>	DEFAULT_MAX_CHILDREN,
                logfile         =>  DEFAULT_LOGFILE,
				};

    $self = bless $self, $class;

    $self->logfile(      $user_data{'logfile'} );
    $self->init_logging();

    $self->bulk_mode(    $user_data{'bulk_mode'} );
    $self->log_level(    $user_data{'log_level'} );
    $self->max_children( $user_data{'max_children'} );

	$log->info("########################################");
	$log->info("#       Net::Autoconfig Started        #");
	$log->info("########################################");
	return $self;
}

########################################
# init_logging
# public method
#
# Initialize logging for Net::Autoconfig.
# If multiple Net::Autoconfig objects
# are created, calling this will affect
# all of them; it changes their logging
# definitions.
#
# Returns undef
########################################
sub init_logging {
    my $self = shift;

    # XXX - Setup a saner, \$log_string
    # config so it's not just to stdout/stderr

    if ( -e $self->logfile )
    {
		eval {
			Log::Log4perl::init( $self->logfile );
		};
		if ($@) {
			print STDERR "Failed to initialize '" . $self->logfile
                          . "' even though it exists.\n";
			print STDERR "Logging to STDERR.";
			Log::Log4perl->easy_init($WARN);
		}
    }
    else
    {
		print STDERR "logging.conf does not exist!";
		print STDERR "Logging to STDERR.";
		Log::Log4perl->easy_init($INFO);
    }
    return;
}

########################################
# bulk_mode
# public method
#
# Accessor/Mutator method
# If passed a parameter, set the
# bulk_mode value to TRUE or FAlSE
#
# If passed undef, return the
# bulk_mode value (TRUE or FALSE);
########################################
sub bulk_mode {
    my $self = shift;
    my $mode = shift;
    my $log  = Log::Log4perl->get_logger("Net::Autoconfig");

    if (defined $mode)
    {
        $log->debug("Setting bulk_mode to " . ($mode ? TRUE : FALSE));
        $self->{'bulk_mode'} = $mode ? TRUE : FALSE;
    }
    return defined $mode ? undef : $self->{'bulk_mode'};
}

########################################
# log_level
# public method
#
# Accessor/Mutator method
# If passed a parameter, set the
# log_level to the passed value (or within 0-5)
#
# If passed undef, return the
# log_level value.
########################################
sub log_level {
    my $self  = shift;
    my $level = shift;
    my $log   = Log::Log4perl->get_logger("Net::Autoconfig");
    
    if (defined $level)
    {
        $level = int($level);
        if ($level > MAXIMUM_LOG_LEVEL)
        {
            $level = MAXIMUM_LOG_LEVEL;
            $log->warn("Log level set too high.  Setting to " . MAXIMUM_LOG_LEVEL);
        }
        elsif ($level < MINIMUM_LOG_LEVEL)
        {
            $level = MINIMUM_LOG_LEVEL;
            $log->warn("Log level set too low.  Setting to " . MINIMUM_LOG_LEVEL);
        }
        $log->debug("Setting log_level to $level");
        $self->{'log_level'} = $level;
    }
    return defined $level ? undef : $self->{'log_level'};
}

########################################
# max_children
# public method
#
# Accessor/Mutator method
# If passed a parameter, set the
# maximum number of child processes.
# Only used when "bulk_mode" is enabled.
#
# If passed undef, return the
# max number of children.
########################################
sub max_children {
    my $self         = shift;
    my $max_children = shift;
    my $log          = Log::Log4perl->get_logger("Net::Autoconfig");

    if (defined $max_children)
    {
        if ($max_children > MAXIMUM_MAX_CHILDREN)
        {
            $max_children = MAXIMUM_MAX_CHILDREN;
            $log->warn("Log max_children set too high.  Setting to '256'.");
        }
        elsif ($max_children < MINIMUM_MAX_CHILDREN)
        {
            $max_children = MINIMUM_MAX_CHILDREN;
            $log->warn("Log max_children set too low.  Setting to '1'.");
        }
        $log->debug("Setting max_children to $max_children");
        $self->{'max_children'} = $max_children;
    }
    return defined $max_children ? undef : $self->{'max_children'};
}

########################################
# get_report
# public method
#
# Return info about the finished processes.
# Returns a hash ref with:
# 'succeded'=> { list of hostnames }
# 'failed'  => {list of hostnames  }
########################################
sub get_report {
    my $self = shift;
    my $report = {};
    my @succeded;     # devices that exited successfully
    my @failed;       # devices that exited unsuccessfully

    foreach my $device_pid (keys %{ $CHILD_PROCESSES->{'info'} })
    {
        if ($CHILD_PROCESSES->{'finished'}->{$device_pid})
        {
            # it failed
            push(@failed, $CHILD_PROCESSES->{'info'}->{$device_pid});
        }
        else
        {
            # it succeded
            push(@succeded, $CHILD_PROCESSES->{'info'}->{$device_pid});
        }
    }
    $report->{'succeded'} = \@succeded;
    $report->{'failed'}   = \@failed;
    return wantarray ? %$report : $report;
}

########################################
# logfile
# public method
#
# Accessor/Mutator
# 
####################
# Mutator
#
# Sets the logfile if it exists
# (assumes current working directory if
# the filename is not specified absolutely.)
#
# Else, it sets the logfile to the default.
#
# Returns:
#   Success =>  undef
#   Failure =>  error message
####################
# Accessor
#
# Returns
#   the logfile's absolute path
########################################
sub logfile {
    my $self          = shift;
    my $logfile       = shift;
    my $return_value;

    if ( defined $logfile )
    {
        # Check for abs path
        if ( $logfile !~ /^\// )
        {
            $logfile = join('/', getcwd(), $logfile);
        }

        if (-e $logfile)
        {
            $self->{'logfile'} = $logfile;
        }
        else
        {
            $self->{'logfile'} = DEFAULT_LOGFILE;
            print STDERR "\n'$logfile' either does not exist or is unreadable\n";
            print STDERR "\nUsing default logfile " . DEFAULT_LOGFILE . "\n";
        }
        undef $return_value;
    }
    else
    {
        $return_value = $self->{'logfile'};
    }
    return $return_value;
}

########################################
# load_devices
# public method
#
# This method looks at a device config
# file and returns
# a hash ref of Net::Autoconfig::Device's.
# Where the key = hostname
# E.g. { hostname => Net::Autoconfig::Device }
#
# Returns:
# array context     =>  a hash of Devices
# scalar context    =>  a hash ref of Devices
# undef             =>  failure
########################################
sub load_devices {
    my $self = shift;
    my $filename = shift;
    my $log      = Log::Log4perl->get_logger("Net::Autoconfig");
    my $devices  = {};    # an array ref of Net::Autoconfig::Devices, key = hostname
    my $file_format;      # indicates if the file is a hash of arrays, or as hash of hashes of arrays
    my $file_hash_depth;  # an integer of the number of levels of hashes in the device file
    my $current_device;   # the name of the current device to add parameters too
    $filename or $filename = "";

    # Check for abs path
    if ( $filename !~ /\// )
    {
        $filename = join("/", getcwd(), $filename);
    }

    (&_file_not_usable($filename, "device config")) and return;

    eval
    {
        open(DEVICES, $filename) || die print "Could not open '$filename' for reading: $!";
    };
    if ($@)
    {
        $log->warn("Unable to open '$filename': $@");
        return;
    }

    # Create this here in case someone decides not to use the default
    # device.
    $devices->{default} = Net::Autoconfig::Device->new();
    while (my $line = <DEVICES>)
    {
        chomp $line;
        next if $line =~ /^#/;
        next if $line =~ /^\s*$/;

        if ($line =~ /^:/)
        {
            # some type of host declaration (host or default)
            $line =~ s/^://;
            $line =~ s/:$//;
            $current_device = $line;
            if ($current_device =~ /default/)
            {
                # Allow redefinition of the default device.
                $devices->{default} = Net::Autoconfig::Device->new();
                $devices->{default}->set("auto_discover", TRUE);
            }
            elsif ($line =~ /^end$/)
            {
                undef $current_device;
            }
            else
            {
                if (not $current_device)
                {
                    $log->warn("No device configured!");
                    next;
                }
                $devices->{$current_device} = Net::Autoconfig::Device->new(
                                                %{ $devices->{default}->get() },
                                                'hostname' => $current_device,
                                                );
            }
        }
        elsif ($line =~ /\s*(\w+)\s*=\s*(.*?)\s*$/)
        {
            my $key = $1;
            my $value = $2;
            if (not $current_device)
            {
                $log->warn("No device is currently configured!  Line = '$line'.");
                next;
            }
            if ($log->is_trace())
            {
                $log->trace("line = '$line'");
                $log->trace("key = '$key'");
                $log->trace("value = '$value'");
            }

            $devices->{$current_device}->set($key => $value);
        }
        else
        {
            $log->warn("Invalid key = value line. Line = '$line'.");
        }
    }

    delete $devices->{default};

    close(DEVICES);
    return wantarray ? %$devices : $devices;
}

########################################
# load_template
# public method
#
# Load a configuration template from disk.
# These files use the colon-operator format.
# See documentation for more details.
#
# Returns:
#   array context   =>  a hash of the different hosts/devices types
#   scalar context  =>  a hash ref of the different hosts/devices types
#   failure         => undef
########################################
sub load_template {
    my $self = shift;
    my $filename = shift;
    my $log = Log::Log4perl->get_logger('Net::Autoconfig');
    my $template;
    $filename or $filename = "";
    $filename = join("/", getcwd(), $filename);

    (&_file_not_usable($filename, "template file")) and return;

    $template = Net::Autoconfig::Template->new($filename);

    return wantarray ? %{ $template } : $template;
}

########################################
# autoconfig
# public method
#
# Takes a hash ref of device files and
# a template file, and executes the commands on all of the devices.
#
# There are two ways a template can be applied to a device.
# If the device model matches a template entry, then that is
# applied first.  If the device name matches a template entry,
# then that is applied to the device second.
#
# This allows for a device to receive a "generic" configuration
# destined for all devices first, and a more "specific" configuration
# later.
#
# Takes:
#   $devices_hash_ref, Net::Autoconfig::Template
#
# Returns:
#   success = undef
#   failure = An array or array ref (contextual) of the failed devices
########################################
sub autoconfig {
    my $self = shift;
    my $devices = shift;
    my $template = shift;
    my $failed_ping_test;   # results from doing the ping test on the device
    my $log = Log::Log4perl->get_logger("Net::Autoconfig");

    if (ref($self) !~ /Net::Autoconfig/)
    {
        $log->warn("Autoconfig not called as a method.");
        return "Autoconfig not called as a method.";
    }

    if (not $devices)
    {
        $log->warn("No devices passed to autoconfig.");
        return "No devices passed to autoconfig.";
    }
    
    if (not ref ($devices) eq "HASH")
    {
        $log->warn("Devices were not passed as a hash ref.");
        return "Devices were not passed as a hash ref.";
    }

    if (not $template)
    {
        $log->warn("No template passed to autoconfig.");
        return "No template passed to autoconfig.";
    }

    foreach my $device_key (keys %$devices)
    {
        my $device       = $devices->{$device_key};
        my $child_pid;   # PID of the child process (if used)

        if ($log->is_trace)
        {
            $log->trace("Device about to be configured: " . Dumper($device));
        }

        while (keys %{ $CHILD_PROCESSES->{'active'} } > $self->max_children)
        {
            $log->debug("Reached max # of child processes (" . $self->max_children
                            . ") Waiting for some processes to clear up...");
            &_reaper() if $ZOMBIES;
            sleep(1);
        }

        if ($self->bulk_mode)
        {
            $log->trace("Forking process");
            $child_pid = fork();
            #$log->trace("Fork created for Parent $$ - Child $child_pid. Device " . $device->hostname);
            if ($child_pid == -1)
            {
                # Failed to fork!
                $log->warn("Failed to create child process for device " . $device->hostname);
                next;
            }
            elsif ($child_pid)
            {
                # I'm the parent
                $log->debug("Parent $$ - Child $child_pid - Current Device : " . $device->hostname);
                $log->debug("Child $child_pid bulk_mode = " . $self->bulk_mode());
                $CHILD_PROCESSES->{'active'}->{$child_pid} = $device->hostname;
                $CHILD_PROCESSES->{'info'}->{$child_pid}   = $device->hostname;
                next;
            }
            else
            {
                # This is the child
                $log->debug("Child process started for " . $device->hostname);
            }
        }

        if ($device->provision)
        {
            $device->hostname =~ /\A(.*)\@(.*)$/;
            if ($1 and $2)
            {
                # Well formed provisioning hostname
                $failed_ping_test = &_failed_ping_test($2);
            }
            else
            {
                # Poorly formed or normal hostname
                $log->warn("Provisioning hostname " . $device->hostname . " poorly formed.");
                $failed_ping_test = TRUE;
            }
        }
        else
        {
            $failed_ping_test = &_failed_ping_test($device->hostname);
        }

        if ($failed_ping_test)
        {
            my $hostname = $device->hostname || $device_key;
            $log->warn("$hostname was not reachable via ping.  Aborting configuration attempt.");
            if ($self->bulk_mode)
            {
                exit;
            }
            else
            {
                next;
            }
        }

        # Establish a connection to the device first
        $device->provision and $device->console_connect();
        $device->connect();
        $device->get_admin_rights();
        $device->disable_paging();

        # Do the generic, device model/type template first
        # device->model returns an array ref, a device can match more
        # than one device type.  Take the first one that exists in the template.
        MODEL_CONFIG:
        foreach my $model ( @{ $device->model } )
        {
            if ($template->{ $model } )
            {
                $log->info("Starting generic, model based using template"
                            . " '$model' to configure " . $device->hostname);
                $device->configure($template->{ $model });
                last MODEL_CONFIG;
            }
            else
            {
                $log->info("No generic, model based template called '$model'" .
                            " for host " . $device->hostname);
                next MODEL_CONFIG;
            }
        }

        if ($template->{$device->hostname})
        {
            # Do the host specific template second.
            $log->info("Starting specific, hostname based configuration");
            $device->configure($template->{ $device->hostname });
        }
        else
        {
            $log->info("No specific, hostnamed based template defined for host " . $device->hostname);
        }
        $device->end_session();

        if ($self->bulk_mode)
        {
            if ($child_pid == 0)
            {
                $log->trace("Terminating child process $$ for host " . $device->hostname);
                exit;
            }
        }
    }

    while (keys %{ $CHILD_PROCESSES->{'active'}})
    {
        $log->debug("Waiting for child processes to terminate. Sleeping for 5 seconds.");
        &_reaper() if $ZOMBIES;
        sleep(5);
    }

    $log->info("Autoconfig Finished.");

    return;
}

############################################################
# Private Methods
############################################################

########################################
# _file_not_usable
# private method
#
# Check to see if a file exists, is readable,
# etc.
#
# Takes a filename and a description about the file
# E.g. "device configs" or "firmware tempalte"
#
# Return FALSE if it's okay.
# Return TRUE if it's not
########################################
sub _file_not_usable {
    my $filename = shift;
    my $file_descrip = shift;
    my $working_dir  = getcwd();
    my $log = Log::Log4perl->get_logger("Net::Autoconfig");
    $file_descrip = $file_descrip || "";

    if (! $filename)
    {
        $log->warn("$file_descrip: filename not defined.");
        return TRUE;
    }

    if (-d $filename)
    {
        $log->warn("$file_descrip: filename, '$filename' is a directory.");
        return TRUE;
    }

    if (not -e $filename)
    {
        $log->warn("$file_descrip: '$filename', does not exist.");
        return TRUE;
    }

    if (not -r $filename)
    {
        $log->warn("$file_descrip: '$filename', is not readable.  Check file permissions.");
        return TRUE;
    }

    # Ergo, it must be okay!
    return FALSE;
}


sub _failed_ping_test {
    my $hostname = shift;
    return;
}

##############################
# _reaper
# private method
#
# Takes care of waiting for child processes to finish
# so they don't become zombies.  Also does some
# book keeping so we know which processes succeded
# and which ones failed; which ones/how many are active
##############################
sub _reaper {
    my $zombie;
    my $log = Log::Log4perl->get_logger("Net::Autoconfig");

    $log->trace("Start reaping zombies.");
    $log->trace("Number of zombies        : $ZOMBIES");
    $log->trace("Number of active children: " . int(keys %{ $CHILD_PROCESSES->{active} }));

    $ZOMBIES = 0;

    # This is a little tricky.
    # waitpid returns the process id of a zombie that needs to
    # be reaped.  It returns 0 for active procsses.  It returns
    # -1 when there are no child processes left.
    # You'll see code that has <blah> != -1, We want to
    # keep going when child processes are active and
    # only reap the dead processes.
    while (($zombie = waitpid(-1, WNOHANG)) > 0)
    {
        $CHILD_PROCESSES->{'finished'}->{$zombie} = $? >> 8;
        delete $CHILD_PROCESSES->{'active'}->{$zombie};
    }

    $log->trace("Done reaping zombies.");
    return;
}

# Module must return true.
TRUE;

__END__

################################################################################
# Documentation
################################################################################