2 # Copyright (C) 2002 Stanislav Sinyagin
4 # This program is free software; you can redistribute it and/or modify
5 # it under the terms of the GNU General Public License as published by
6 # the Free Software Foundation; either version 2 of the License, or
7 # (at your option) any later version.
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with this program; if not, write to the Free Software
16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
18 # $Id: devdiscover.in,v 1.1 2010-12-27 00:04:02 ivan Exp $
19 # Stanislav Sinyagin <ssinyagin@yahoo.com>
21 # Collect the router information and create the XML file
23 BEGIN { require '@devdiscover_config_pl@'; }
30 use Torrus::DevDiscover;
31 use Torrus::ConfigBuilder;
40 my $workerThreads = 0;
42 # Hidden parameter for debugging
47 my %formatsSupported = ( '1.0' => 1 );
50 my $creator = "Torrus version @VERSION@\n" .
51 "This file was generated by command:\n" .
53 foreach my $arg ( @ARGV )
57 $creator .= ' ' . $arg . ' ';
61 $creator .= "\'" . $arg . "\'\\\n";
64 $creator .= "\n On " . scalar(localtime(time));
68 'mkdir' => \$makedirs,
69 'limit=s' => \$limitre,
70 'forcebundle' => \$forcebundle,
71 'fallback=i' => \$fallback,
72 'threads=i' => \$workerThreads,
73 'snmpdebug' => \$snmpdebug,
74 'verbose' => \$verbose,
77 if( $ok and scalar( @ARGV ) > 0 )
79 push( @infiles, @ARGV );
82 if( not $ok or scalar(@infiles) == 0 or
83 ($workerThreads > 1 and not $Torrus::Global::threadsEnabled ) )
85 print STDERR "Usage: $0 --in=filename.ddx options... [ddx files]\n",
87 " --in=filename.ddx discovery instructions XML file(s)\n",
88 " --mkdir create data-dir directories\n",
89 " --limit=regexp limit the discovery by output files\n",
90 " --forcebundle always write the bundle file\n",
91 " --fallback=integer maximum age of XML file to fall back to\n",
92 " --threads=integer number of parallel discovery threads\n",
93 " --verbose print extra information\n",
94 " --debug print debugging information\n",
95 " --snmpdebug print SNMP protocol details\n",
97 if( not $Torrus::Global::threadsEnabled )
99 print STDERR "Multithreading is NOT SUPPORTED by current " .
100 "perl interpreter\n";
108 $Net::SNMP::Transport::UDP::DEBUG = 1;
109 $Net::SNMP::Message::DEBUG = 1;
110 $Net::SNMP::MessageProcessing::DEBUG = 1;
111 $Net::SNMP::Dispatcher::DEBUG = 1;
116 Torrus::Log::setLevel('debug');
120 Torrus::Log::setLevel('verbose');
123 my $everythingsOk = 1;
124 my $perOutfileHostParams = {};
127 foreach my $infile ( @infiles )
131 my $altfile = $Torrus::Global::discoveryDir . $infile;
132 if( not -r $altfile )
134 Error('Cannot find file ' . $infile .
135 ' neither in current directory nor in ' .
136 $Torrus::Global::discoveryDir);
145 Verbose('Processing ' . $infile);
147 my $parser = new XML::LibXML;
149 eval { $doc = $parser->parse_file( $infile ); };
152 Error("Failed to parse $infile: $@");
156 my $root = $doc->documentElement();
157 if( $root->nodeName() ne 'snmp-discovery' )
159 Error('XML root element is not "snmp-discovery" in ' . $infile);
164 (($root->getElementsByTagName('file-info'))[0]->
165 getElementsByTagName('format-version'))[0]->textContent();
167 $format_version =~ s/\s//g;
169 if( not $format_version or not $formatsSupported{$format_version} )
171 Error('Invalid format or format version not supported: ' . $infile);
175 my $globalParams = parseParams( $root );
178 # Parse the body of the XML
180 foreach my $hostNode ( $root->getChildrenByTagName('host') )
182 my $hostParams = parseParams( $hostNode, $globalParams );
183 normalizeParams( $hostParams );
185 my $outfile = $hostParams->{'output-file'};
186 if( not exists($perOutfileHostParams->{$outfile}) )
188 $perOutfileHostParams->{$outfile} = [];
190 push( @{$perOutfileHostParams->{$outfile}}, $hostParams );
192 my $outBundles = $hostParams->{'output-bundle'};
193 if( length( $outBundles ) > 0 )
195 foreach my $bundleName ( split( /\s*,\s*/, $outBundles ) )
197 $bundleName = absXmlFilename( $bundleName );
198 $outputBundles{$bundleName}{ relXmlFilename($outfile) } = 1;
207 my $bundleDeletionQueue;
208 my $confBuildSemaphore;
210 if( $workerThreads > 1 )
213 require threads::shared;
214 require Thread::Queue;
215 require Thread::Semaphore;
217 threads::shared::share( \$everythingsOk );
219 $jobQueue = new Thread::Queue;
220 $bundleDeletionQueue = new Thread::Queue;
221 $confBuildSemaphore = new Thread::Semaphore;
223 # Enqueue the output filenames
224 foreach my $outfile ( sort keys %{$perOutfileHostParams} )
226 if( not matchLimitRe( $outfile ) )
231 $jobQueue->enqueue( $outfile );
234 # Start the worker threads
236 foreach my $i ( 1..$workerThreads )
238 push( @workers, threads->create( \&discoveryThread ) );
241 # Wait for workers to finish the jobs
242 while( my $thr = shift( @workers ) )
244 my $tid = $thr->tid();
246 Debug('Cleaning up thread #' . $tid);
250 # Process the files to be excluded from bundles
252 if( not $everythingsOk )
255 while( defined( $outfile = $bundleDeletionQueue->dequeue_nb() ) )
257 removeFromBundle( $outfile );
263 # Single-thread operation
265 foreach my $outfile ( sort keys %{$perOutfileHostParams} )
267 if( not matchLimitRe( $outfile ) )
272 if( not doDiscover( $outfile ) )
274 removeFromBundle( $outfile );
279 # Discovery finished, do the bundles
281 if( scalar( keys %outputBundles ) > 0 )
283 if( defined( $limitre ) )
285 Warn('Cannot write bundles with --limit option specified. ' .
286 'Bundle files remain unchanged');
288 elsif( $everythingsOk )
290 foreach my $bundleName ( sort keys %outputBundles )
292 my $cb = new Torrus::ConfigBuilder;
294 $cb->addCreatorInfo( $creator );
296 foreach my $bundleMember
297 ( sort keys %{$outputBundles{$bundleName}} )
299 $cb->addFileInclusion( $bundleMember );
302 my $ok = $cb->toFile( $bundleName );
305 Verbose('Wrote bundle to ' . $bundleName);
309 Error('Cannot write bundle to ' . $bundleName . ': ' . $!);
316 Error('Skipping bundles generation because of errors');
321 exit($everythingsOk ? 0:1);
326 my $parentNode = shift;
327 my $paramhash = shift;
329 # Clone the parameters hash
333 while( my($key, $val) = each %{$paramhash} )
339 foreach my $paramNode ( $parentNode->getChildrenByTagName('param') )
341 my $param = $paramNode->getAttribute('name');
342 my $value = $paramNode->getAttribute('value');
346 Error("Parameter without name");
350 if( not defined( $value ) )
352 $value = $paramNode->textContent();
355 # Remove spaces in the head and tail.
359 $ret->{$param} = $value;
369 if( not defined( $params->{'output-file'} ) )
371 Warn('output-file parameter is not defined. Using routers.xml');
372 $params->{'output-file'} = 'routers.xml';
376 $params->{'output-file'} = absXmlFilename( $params->{'output-file'} );
379 if( defined( $params->{'host-subtree'} ) )
381 my $subtree = $params->{'host-subtree'};
383 if( $subtree !~ /^\/[0-9A-Za-z_\-\.\/]*$/ or
386 Error("Invalid format for subtree name: " . $subtree);
391 if( defined( $params->{'snmp-community'} ) )
393 # Remove any possible Unicode character treatment
394 $params->{'snmp-community'} =
395 pack( 'A*', $params->{'snmp-community'} );
400 # Replaces $XMLCONFIG with the XML root directory
403 my $filename = shift;
405 my $subst = '$XMLCONFIG';
406 my $offset = index( $filename, $subst );
409 my $len = length( $subst );
410 substr( $filename, $offset, $len ) = $Torrus::Global::siteXmlDir;
414 if( $filename !~ /^\// )
416 $filename = $Torrus::Global::siteXmlDir . '/' . $filename;
423 # Removes XML root directory from path
426 my $filename = shift;
428 my $subst = $Torrus::Global::siteXmlDir;
429 my $len = length( $subst );
431 if( $filename =~ /^\// )
433 my $offset = index( $filename, $subst );
436 $filename = substr( $filename, $len );
437 # we don't know if xmldir has a trailing slash
438 $filename =~ s/^\///;
447 my $filename = shift;
449 if( defined( $limitre ) )
451 $filename =~ s/^.*\///;
453 if( $filename !~ $limitre )
463 # Pick up next available outfile until the job queue is empty
467 Torrus::Log::setTID( threads->tid() );
468 Debug('Started thread #' . threads->tid());
470 while( defined( $outfile = $jobQueue->dequeue_nb() ))
472 if( not doDiscover( $outfile ) )
474 $bundleDeletionQueue->enqueue( $outfile );
477 Debug('Finished thread #' . threads->tid());
486 Verbose('Preparing to write ' . $outfile);
488 my $dd = new Torrus::DevDiscover;
491 foreach my $hostParams ( @{$perOutfileHostParams->{$outfile}} )
493 $ok = $dd->discover( $hostParams );
497 Error($outfile . ' was not written because of errors');
505 # LibXML2 is not thread-safe, so we create the XML files
507 if( $workerThreads > 1 )
509 $confBuildSemaphore->down();
512 my $cb = new Torrus::ConfigBuilder;
514 $cb->addCreatorInfo( $creator );
516 $dd->buildConfig( $cb );
517 $cb->addRequiredFiles();
518 $cb->addStatistics();
520 $ok = $cb->toFile( $outfile );
523 Verbose('Wrote ' . $outfile);
527 Error('Cannot write ' . $outfile . ': ' . $!);
531 if( $workerThreads > 1 )
533 $confBuildSemaphore->up();
541 # Not sure if these calls are reentrant
542 if( $workerThreads > 1 )
544 $confBuildSemaphore->down();
547 my ($login,$pass,$uid,$gid) = getpwnam('@torrus_user@')
548 or die "Cannot get user details for @torrus_user@";
550 foreach my $dir ( $dd->listDataDirs() )
554 Debug('Creating directory: ' . $dir);
556 Error('Cannot create directory: ' .
558 chown( $uid, $gid, $dir ) or
559 Error('Cannot change ownership for ' .
561 chmod( 02755, $dir ) or
562 Error('Cannot chmod 02755 for ' .
567 if( $workerThreads > 1 )
569 $confBuildSemaphore->up();
574 Error('Skipping mkdir because of errors');
586 my $relname = relXmlFilename($outfile);
588 my $removeFromBundle = 1;
592 if( defined( $fallback ) and
593 -e $outfile and -M $outfile <= $fallback )
595 Warn('Falling back to the old version of ' . $relname);
596 $removeFromBundle = 0;
601 if( $removeFromBundle )
603 foreach my $bundleName ( sort keys %outputBundles )
605 if( exists( $outputBundles{$bundleName}{$relname} ) )
607 delete $outputBundles{$bundleName}{$relname};
608 Warn('Bundle ' . $bundleName . ' will not have ' .
609 $relname . ' included because of errors');
617 # indent-tabs-mode: nil
618 # perl-indent-level: 4