--- /dev/null
+#!@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: