import torrus 1.0.9
[freeside.git] / torrus / bin / devdiscover.in
diff --git a/torrus/bin/devdiscover.in b/torrus/bin/devdiscover.in
new file mode 100644 (file)
index 0000000..f113723
--- /dev/null
@@ -0,0 +1,619 @@
+#!@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: