#!/usr/bin/perl
# Nagios config parser
# Walks from the current directory for Nagios cfg files and emits a Data::Dumper dump of the config blocks
# primarly indexed by file name:line number of where that config block starts.
# This parsed form should make further processing of the data easy.
# Please note NO COMMENTS are taken into the config.
# Used in cojunction with other tools to actualy process
# the config in interesting ways.
# Written by Martin Houston June 2012

use strict;
use warnings;
use File::Find;
use Data::Dumper;

our %config;

sub wanted {
    # we are interested only in .cfg files
    my $cur_label = '';
    # do not descend into backup dir
    if(-d $_ && $_ eq 'backup') {
	$File::Find::prune = 1;
	return;
    }
    if(-f $_ && /\.cfg$/) {
	if(open(my $fd,'<',$_)) {
	    while(<$fd>) {
		chomp;
		next if /^\s*#/; # ignore comments
		s/\s+/ /g; # colapse intermediate space;
		s/^\s+//; # clean leading whitespace;
		s/\s+$//; # and trailing
                # lastly everything between # or ; and end of line is a comment
                # we look for the last # or ; that is not followed by any characters in the set #;"
                s/(#|;)([^#;"]+)$//;
		if(/^}/) {
		    $cur_label = '';
		    next;
		}
		elsif(/^define (\w+)\s*{/) {
		    $cur_label = $File::Find::name .  ':' . $.;
		    $config{$cur_label} = {TYPE => $1};
		}
		elsif(/^(\w+)\s*=?\s*(.+)$/) {
		    next unless $cur_label ne '';
		    my($k,$v) = ($1,$2);
                    # another go at trailing whitespace
                    $v =~ s/\s+$//;
		    # do we already have on of these, if so make it an array.
                    # tricky case as may already have a single value
		    if(defined $config{$cur_label}->{$k} || $v =~ /,/) {
                        if(defined $config{$cur_label}->{$k}) {
			    $config{$cur_label}->{$k} = [$config{$cur_label}->{$k}] unless ref($config{$cur_label}->{$k}) =~ /^ARRAY/;
                        }
                        else {
			    $config{$cur_label}->{$k} = [];
                        }
                        
			map { push @{$config{$cur_label}->{$k}}, $_ } split(/,/,$v);
		    }
		    else {
			# common case, just one, so save it
			$config{$cur_label}->{$k} = $v;
		    }
		}
	    }
	}
    }
}

if(@ARGV) {
    find(\&wanted,@ARGV);
}
else {
    find(\&wanted,'/usr/local/nagios/etc');
}

=head1 get_ident

Nagios does not have a universal identifier that is globally unique across all object types.

This code is object type specific and makes up our best guess at what is going to be a suitable identifier
both for our referring to the object on the graph, and for fornding relationships between objects.

The identifier is prefixed with the object type as otherwise we would have big namespace collision issues.

There may be some of the minior object types still missing. Need to be added as required.

=cut

sub get_ident {
    my $obj = shift;
    return "Unknown - no TYPE" unless defined $obj->{TYPE};
    if($obj->{TYPE} eq 'host') {
        return "host:" . ($obj->{name} || $obj->{host_name} || $obj->{address} || "UNKNOWN host");
    }
    elsif($obj->{TYPE} eq 'hostgroup') {
        return "hostgroup:" . ($obj->{name} || $obj->{hostgroup_name} || $obj->{alias} || "UNKNOWN hostgroup");
    }
    elsif($obj->{TYPE} eq 'service') {
        return "service:" . ($obj->{name} || $obj->{service_description} || $obj->{alias} || "UNKNOWN service");
    }
    elsif($obj->{TYPE} eq 'servicegroup') {
        return "servicegroup:" . ($obj->{name} || $obj->{servicegroup_name} || $obj->{alias} || "UNKNOWN servicegroup");
    }
    elsif($obj->{TYPE} eq 'timeperiod') {
        return "timeperiod:" . ($obj->{timeperiod_name} || $obj->{alias} || "UNKNOWN timeperiod");
    }
    elsif($obj->{TYPE} eq 'command') {
        return "command:" . ($obj->{name} || $obj->{command_name} || "UNKNOWN command");
    }
    elsif($obj->{TYPE} eq 'contact') {
        return "contact:" . ($obj->{name} || $obj->{contact_name} || $obj->{alias} || "UNKNOWN contact");
    }
    elsif($obj->{TYPE} eq 'contactgroup') {
        return "contactgroup:" . ($obj->{name} || $obj->{contactgroup_name} || $obj->{alias} || "UNKNOWN contactgroup");
    }
    else {
        # dont know how to deal with the rest yet - easy enough
	return $obj->{TYPE} . ":UNKNOWN!";
    }
}
    
=head1 useexpansion 

This takes a config and populates all fields as if data was actually present.

However in order to differntiate derived form literal data a ref to a scalar is used instead of an actual scalar.
This is then tested for at graph drawing line so that a different line style can be used.

=cut

sub useexpansion {
    my $config = shift;
    my $newconfig = {};
    my %objectmap = ();
    my $useexpansion;
    $useexpansion = sub {
	my $idx = shift; # this is a closure so can see config and newconfig;
	my $destidx = shift; # this is a closure so can see config and newconfig;
        # does this have a use - it has to be the same object type as we are so make an index and recurse
        if(defined $config->{$idx}->{use} && defined $objectmap{$config->{$idx}->{TYPE} .':'. $config->{$idx}->{use}}) {
            # warn "Recurse from $idx to " . $config->{$idx}->{TYPE} .':'. $config->{$idx}->{use} if $config->{$idx}->{TYPE} eq 'service';
            &{$useexpansion}($objectmap{$config->{$idx}->{TYPE} .':'. $config->{$idx}->{use}},$destidx);
        }
        # now copy all the fields from srcidx to destidx - overwriting anything earler in the chain
	$newconfig->{$destidx} = {} unless defined $config->{$destidx};
        for(keys %{$config->{$idx}}) {
	    # if we are coming from a different place make this a hash key of which is where it came from
            # as we do not use hashes elsewhere in this data this is a good clear marker,
            # as the hash will only ever have one element we can get past it using values %{}
            if($idx eq $destidx) {
                $newconfig->{$destidx}->{$_} = $config->{$idx}->{$_};
            }
            else {
                $newconfig->{$destidx}->{$_} = {$idx => $config->{$idx}->{$_}};
            }
        }
    };
    # first we build a map of objects back to their primary indexes using get_ident;
    for(keys %{$config}) {
        my $obj = $config->{$_};
        $objectmap{get_ident($obj)} = $_;
    }
    # print Data::Dumper->Dump([\%objectmap],['objectmap']);
    # now we recursivley follow any use chains 
    for(keys %{$config}) {
        &{$useexpansion}($_,$_);
    }
    return $newconfig;
}

# pass data on to next stage in pipeline.
# complete with expanded use
print Data::Dumper->Dump([useexpansion(\%config)],['config']);