#!@PERL@
#  Copyright (C) 2002  Stanislav Sinyagin
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.

# $Id: devdiscover.in,v 1.1 2010-12-27 00:04:02 ivan Exp $
# Stanislav Sinyagin <ssinyagin@yahoo.com>

# Collect the router information and create the XML file

BEGIN { require '@devdiscover_config_pl@'; }

use strict;
use Getopt::Long;
use XML::LibXML;

use Torrus::Log;
use Torrus::DevDiscover;
use Torrus::ConfigBuilder;

$| = 1;

my @infiles;
my $makedirs;
my $limitre;
my $forcebundle;
my $fallback;
my $workerThreads = 0;

# Hidden parameter for debugging
my $snmpdebug = 0;
my $debug = 0;
my $verbose = 0;

my %formatsSupported = ( '1.0' => 1 );


my $creator = "Torrus version @VERSION@\n" .
    "This file was generated by command:\n" .
    $0 . " \\\n";
foreach my $arg ( @ARGV )
{
    if( $arg =~ /^--/ )
    {
        $creator .= ' ' . $arg . ' ';
    }
    else
    {
        $creator .= "\'" . $arg . "\'\\\n";
    }
}
$creator .= "\n On " . scalar(localtime(time));

my $ok = GetOptions(
                    'in=s'        => \@infiles,
                    'mkdir'       => \$makedirs,
                    'limit=s'     => \$limitre,
                    'forcebundle' => \$forcebundle,
                    'fallback=i'  => \$fallback,
                    'threads=i'   => \$workerThreads,
                    'snmpdebug'   => \$snmpdebug,
                    'verbose'     => \$verbose,
                    'debug'       => \$debug
                    );
if( $ok and scalar( @ARGV ) > 0 )
{
    push( @infiles, @ARGV );
}

if( not $ok or scalar(@infiles) == 0 or
    ($workerThreads > 1 and not $Torrus::Global::threadsEnabled ) )
{
    print STDERR "Usage: $0 --in=filename.ddx options... [ddx files]\n",
    "Options:\n",
    " --in=filename.ddx       discovery instructions XML file(s)\n",
    " --mkdir                 create data-dir directories\n",
    " --limit=regexp          limit the discovery by output files\n",
    " --forcebundle           always write the bundle file\n",
    " --fallback=integer      maximum age of XML file to fall back to\n",
    " --threads=integer       number of parallel discovery threads\n",
    " --verbose               print extra information\n",
    " --debug                 print debugging information\n",
    " --snmpdebug             print SNMP protocol details\n",
    "\n";
    if( not $Torrus::Global::threadsEnabled )
    {
        print STDERR "Multithreading is NOT SUPPORTED by current " .
            "perl interpreter\n";
    }

    exit 1;
}

if( $snmpdebug )
{
    $Net::SNMP::Transport::UDP::DEBUG = 1;
    $Net::SNMP::Message::DEBUG = 1;
    $Net::SNMP::MessageProcessing::DEBUG = 1;
    $Net::SNMP::Dispatcher::DEBUG = 1;
}

if( $debug )
{
    Torrus::Log::setLevel('debug');
}
elsif( $verbose )
{
    Torrus::Log::setLevel('verbose');
}

my $everythingsOk = 1;
my $perOutfileHostParams = {};
my %outputBundles;

foreach my $infile ( @infiles )
{
    if( not -r $infile )
    {
        my $altfile = $Torrus::Global::discoveryDir . $infile;
        if( not -r $altfile )
        {
            Error('Cannot find file ' . $infile .
                  ' neither in current directory nor in ' .
                  $Torrus::Global::discoveryDir);
            exit 1;
        }
        else
        {
            $infile = $altfile;
        }
    }

    Verbose('Processing ' . $infile);

    my $parser = new XML::LibXML;
    my $doc;
    eval { $doc = $parser->parse_file( $infile );  };
    if( $@ )
    {
        Error("Failed to parse $infile: $@");
        exit 1;
    }

    my $root = $doc->documentElement();
    if( $root->nodeName() ne 'snmp-discovery' )
    {
        Error('XML root element is not "snmp-discovery" in ' . $infile);
        exit 1;
    }
        
    my $format_version =
        (($root->getElementsByTagName('file-info'))[0]->
         getElementsByTagName('format-version'))[0]->textContent();
    
    $format_version =~ s/\s//g;
    
    if( not $format_version or not $formatsSupported{$format_version} )
    {
        Error('Invalid format or format version not supported: ' . $infile);
        exit 1;
    }

    my $globalParams = parseParams( $root );


    # Parse the body of the XML

    foreach my $hostNode ( $root->getChildrenByTagName('host') )
    {
        my $hostParams = parseParams( $hostNode, $globalParams );
        normalizeParams( $hostParams );

        my $outfile = $hostParams->{'output-file'};
        if( not exists($perOutfileHostParams->{$outfile}) )
        {
            $perOutfileHostParams->{$outfile} = [];
        }
        push( @{$perOutfileHostParams->{$outfile}}, $hostParams );

        my $outBundles = $hostParams->{'output-bundle'};
        if( length( $outBundles ) > 0 )
        {
            foreach my $bundleName ( split( /\s*,\s*/, $outBundles ) )
            {
                $bundleName = absXmlFilename( $bundleName );
                $outputBundles{$bundleName}{ relXmlFilename($outfile) } = 1;
            }
        }
    }
}


# Start discovery
my $jobQueue;
my $bundleDeletionQueue;
my $confBuildSemaphore;

if( $workerThreads > 1 )
{
    require threads;
    require threads::shared;
    require Thread::Queue;
    require Thread::Semaphore;

    threads::shared::share( \$everythingsOk );

    $jobQueue = new Thread::Queue;
    $bundleDeletionQueue = new Thread::Queue;
    $confBuildSemaphore = new Thread::Semaphore;

    # Enqueue the output filenames    
    foreach my $outfile ( sort keys %{$perOutfileHostParams} )
    {
        if( not matchLimitRe( $outfile ) )
        {
            next;
        }

        $jobQueue->enqueue( $outfile );
    }

    # Start the worker threads
    my @workers;
    foreach my $i ( 1..$workerThreads )
    {
        push( @workers, threads->create( \&discoveryThread ) );
    }

    # Wait for workers to finish the jobs
    while( my $thr = shift( @workers ) )
    {
        my $tid = $thr->tid();
        $thr->join();
        Debug('Cleaning up thread #' . $tid);
        undef $thr;
    }

    # Process the files to be excluded from bundles

    if( not $everythingsOk )
    {
        my $outfile;
        while( defined( $outfile = $bundleDeletionQueue->dequeue_nb() ) )
        {
            removeFromBundle( $outfile );
        }
    }
}
else
{
    # Single-thread operation
       
    foreach my $outfile ( sort keys %{$perOutfileHostParams} )
    {
        if( not matchLimitRe( $outfile ) )
        {
            next;
        }
        
        if( not doDiscover( $outfile ) )
        {
            removeFromBundle( $outfile );
        }
    }
}

# Discovery finished, do the bundles

if( scalar( keys %outputBundles ) > 0 )
{
    if( defined( $limitre ) )
    {
        Warn('Cannot write bundles with --limit option specified. ' .
             'Bundle files remain unchanged');
    }
    elsif( $everythingsOk )
    {
        foreach my $bundleName ( sort keys %outputBundles )
        {
            my $cb = new Torrus::ConfigBuilder;

            $cb->addCreatorInfo( $creator );
            
            foreach my $bundleMember
                ( sort keys %{$outputBundles{$bundleName}} )
            {
                $cb->addFileInclusion( $bundleMember );
            }

            my $ok = $cb->toFile( $bundleName );
            if( $ok )
            {
                Verbose('Wrote bundle to ' . $bundleName);
            }
            else
            {
                Error('Cannot write bundle to ' . $bundleName . ': ' . $!);
                $everythingsOk = 0;
            }
        }
    }
    else
    {
        Error('Skipping bundles generation because of errors');
    }
}


exit($everythingsOk ? 0:1);


sub parseParams
{
    my $parentNode = shift;
    my $paramhash = shift;

    # Clone the parameters hash
    my $ret = {};
    if( $paramhash )
    {
        while( my($key, $val) = each %{$paramhash} )
        {
            $ret->{$key} = $val;
        }
    }

    foreach my $paramNode ( $parentNode->getChildrenByTagName('param') )
    {
        my $param = $paramNode->getAttribute('name');
        my $value = $paramNode->getAttribute('value');

        if( not $param )
        {
            Error("Parameter without name");
            exit 1;
        }

        if( not defined( $value ) )
        {
            $value = $paramNode->textContent();
        }

        # Remove spaces in the head and tail.
        $value =~ s/^\s+//;
        $value =~ s/\s+$//;

        $ret->{$param} = $value;
    }
    return $ret;
}


sub normalizeParams
{
    my $params = shift;

    if( not defined( $params->{'output-file'} ) )
    {
        Warn('output-file parameter is not defined. Using routers.xml');
        $params->{'output-file'} = 'routers.xml';
    }
    else
    {
        $params->{'output-file'} = absXmlFilename( $params->{'output-file'} );
    }

    if( defined( $params->{'host-subtree'} ) )
    {
        my $subtree = $params->{'host-subtree'};

        if( $subtree !~ /^\/[0-9A-Za-z_\-\.\/]*$/ or
            $subtree =~ /\.\./ )
        {
            Error("Invalid format for subtree name: " . $subtree);
            exit 1;
        }
    }

    if( defined( $params->{'snmp-community'} ) )
    {
        # Remove any possible Unicode character treatment
        $params->{'snmp-community'} =
            pack( 'A*', $params->{'snmp-community'} );
    }
}


# Replaces $XMLCONFIG with the XML root directory
sub absXmlFilename
{
    my $filename = shift;

    my $subst = '$XMLCONFIG';
    my $offset = index( $filename, $subst );
    if( $offset >= 0 )
    {
        my $len = length( $subst );
        substr( $filename, $offset, $len ) = $Torrus::Global::siteXmlDir;
    }
    else
    {
        if( $filename !~ /^\// )
        {
            $filename = $Torrus::Global::siteXmlDir . '/' . $filename;
        }
    }
    return $filename;
}


# Removes XML root directory from path
sub relXmlFilename
{
    my $filename = shift;

    my $subst = $Torrus::Global::siteXmlDir;
    my $len = length( $subst );

    if( $filename =~ /^\// )
    {
        my $offset = index( $filename, $subst );
        if( $offset == 0 )
        {
            $filename = substr( $filename, $len );
            # we don't know if xmldir has a trailing slash
            $filename =~ s/^\///;
        }
    }
    return $filename;
}


sub matchLimitRe
{
    my $filename = shift;

    if( defined( $limitre ) )
    {
        $filename =~ s/^.*\///;

        if( $filename !~ $limitre )
        {
            return 0;
        }
    }

    return 1;
}


# Pick up next available outfile until the job queue is empty

sub discoveryThread
{
    Torrus::Log::setTID( threads->tid() );
    Debug('Started thread #' . threads->tid());
    my $outfile;
    while( defined( $outfile = $jobQueue->dequeue_nb() ))
    {
        if( not doDiscover( $outfile ) )
        {
            $bundleDeletionQueue->enqueue( $outfile );
        }
    }
    Debug('Finished thread #' . threads->tid());
}



sub doDiscover
{
    my $outfile = shift;
    
    Verbose('Preparing to write ' . $outfile);

    my $dd = new Torrus::DevDiscover;
    my $ok = 1;

    foreach my $hostParams ( @{$perOutfileHostParams->{$outfile}} )
    {
        $ok = $dd->discover( $hostParams );

        if( not $ok )
        {
            Error($outfile . ' was not written because of errors');
            $everythingsOk = 0;
            last;
        }
    }

    if( $ok )
    {
        # LibXML2 is not thread-safe, so we create the XML files
        # one at a time
        if( $workerThreads > 1 )
        {
            $confBuildSemaphore->down();
        }
        
        my $cb = new Torrus::ConfigBuilder;

        $cb->addCreatorInfo( $creator );

        $dd->buildConfig( $cb );
        $cb->addRequiredFiles();
        $cb->addStatistics();

        $ok = $cb->toFile( $outfile );
        if( $ok )
        {
            Verbose('Wrote ' . $outfile);
        }
        else
        {
            Error('Cannot write ' . $outfile . ': ' . $!);
            $everythingsOk = 0;
        }

        if( $workerThreads > 1 )
        {
            $confBuildSemaphore->up();
        }
    }

    if( $makedirs )
    {
        if( $everythingsOk )
        {
            # Not sure if these calls are reentrant
            if( $workerThreads > 1 )
            {
                $confBuildSemaphore->down();
            }
            
            my ($login,$pass,$uid,$gid) = getpwnam('@torrus_user@')
                or die "Cannot get user details for @torrus_user@";
            
            foreach my $dir ( $dd->listDataDirs() )
            {
                if( not -d $dir )
                {
                    Debug('Creating directory: ' . $dir);
                    mkdir( $dir ) or
                        Error('Cannot create directory: ' .
                              $dir . ': ' . $!);
                    chown( $uid, $gid, $dir ) or
                        Error('Cannot change ownership for ' .
                              $dir . ': ' . $!);
                    chmod( 02755, $dir ) or
                        Error('Cannot chmod 02755 for ' .
                              $dir . ': ' . $!);
                }
            }

            if( $workerThreads > 1 )
            {
                $confBuildSemaphore->up();
            }            
        }
        else
        {
            Error('Skipping mkdir because of errors');
        }
    }
    
    return $ok;
}


sub removeFromBundle
{
    my $outfile = shift;
    
    my $relname  = relXmlFilename($outfile);
    
    my $removeFromBundle = 1;
        
    if( $forcebundle )
    {
        if( defined( $fallback ) and
            -e $outfile and -M $outfile <= $fallback )
        {               
            Warn('Falling back to the old version of ' . $relname);
            $removeFromBundle = 0;
        }
        $everythingsOk = 1;
    }

    if( $removeFromBundle )
    {
        foreach my $bundleName ( sort keys %outputBundles )
        {
            if( exists( $outputBundles{$bundleName}{$relname} ) )
            {
                delete $outputBundles{$bundleName}{$relname};
                Warn('Bundle ' . $bundleName . ' will not have ' .
                     $relname . ' included because of errors');
            }
        }
    }
}

# Local Variables:
# mode: perl
# indent-tabs-mode: nil
# perl-indent-level: 4
# End:
