stretch-happy Releases files
[freeside.git] / torrus / bin / devdiscover.in
1 #!@PERL@
2 #  Copyright (C) 2002  Stanislav Sinyagin
3 #
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.
8 #
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.
13 #
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.
17
18 # $Id: devdiscover.in,v 1.1 2010-12-27 00:04:02 ivan Exp $
19 # Stanislav Sinyagin <ssinyagin@yahoo.com>
20
21 # Collect the router information and create the XML file
22
23 BEGIN { require '@devdiscover_config_pl@'; }
24
25 use strict;
26 use Getopt::Long;
27 use XML::LibXML;
28
29 use Torrus::Log;
30 use Torrus::DevDiscover;
31 use Torrus::ConfigBuilder;
32
33 $| = 1;
34
35 my @infiles;
36 my $makedirs;
37 my $limitre;
38 my $forcebundle;
39 my $fallback;
40 my $workerThreads = 0;
41
42 # Hidden parameter for debugging
43 my $snmpdebug = 0;
44 my $debug = 0;
45 my $verbose = 0;
46
47 my %formatsSupported = ( '1.0' => 1 );
48
49
50 my $creator = "Torrus version @VERSION@\n" .
51     "This file was generated by command:\n" .
52     $0 . " \\\n";
53 foreach my $arg ( @ARGV )
54 {
55     if( $arg =~ /^--/ )
56     {
57         $creator .= ' ' . $arg . ' ';
58     }
59     else
60     {
61         $creator .= "\'" . $arg . "\'\\\n";
62     }
63 }
64 $creator .= "\n On " . scalar(localtime(time));
65
66 my $ok = GetOptions(
67                     'in=s'        => \@infiles,
68                     'mkdir'       => \$makedirs,
69                     'limit=s'     => \$limitre,
70                     'forcebundle' => \$forcebundle,
71                     'fallback=i'  => \$fallback,
72                     'threads=i'   => \$workerThreads,
73                     'snmpdebug'   => \$snmpdebug,
74                     'verbose'     => \$verbose,
75                     'debug'       => \$debug
76                     );
77 if( $ok and scalar( @ARGV ) > 0 )
78 {
79     push( @infiles, @ARGV );
80 }
81
82 if( not $ok or scalar(@infiles) == 0 or
83     ($workerThreads > 1 and not $Torrus::Global::threadsEnabled ) )
84 {
85     print STDERR "Usage: $0 --in=filename.ddx options... [ddx files]\n",
86     "Options:\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",
96     "\n";
97     if( not $Torrus::Global::threadsEnabled )
98     {
99         print STDERR "Multithreading is NOT SUPPORTED by current " .
100             "perl interpreter\n";
101     }
102
103     exit 1;
104 }
105
106 if( $snmpdebug )
107 {
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;
112 }
113
114 if( $debug )
115 {
116     Torrus::Log::setLevel('debug');
117 }
118 elsif( $verbose )
119 {
120     Torrus::Log::setLevel('verbose');
121 }
122
123 my $everythingsOk = 1;
124 my $perOutfileHostParams = {};
125 my %outputBundles;
126
127 foreach my $infile ( @infiles )
128 {
129     if( not -r $infile )
130     {
131         my $altfile = $Torrus::Global::discoveryDir . $infile;
132         if( not -r $altfile )
133         {
134             Error('Cannot find file ' . $infile .
135                   ' neither in current directory nor in ' .
136                   $Torrus::Global::discoveryDir);
137             exit 1;
138         }
139         else
140         {
141             $infile = $altfile;
142         }
143     }
144
145     Verbose('Processing ' . $infile);
146
147     my $parser = new XML::LibXML;
148     my $doc;
149     eval { $doc = $parser->parse_file( $infile );  };
150     if( $@ )
151     {
152         Error("Failed to parse $infile: $@");
153         exit 1;
154     }
155
156     my $root = $doc->documentElement();
157     if( $root->nodeName() ne 'snmp-discovery' )
158     {
159         Error('XML root element is not "snmp-discovery" in ' . $infile);
160         exit 1;
161     }
162         
163     my $format_version =
164         (($root->getElementsByTagName('file-info'))[0]->
165          getElementsByTagName('format-version'))[0]->textContent();
166     
167     $format_version =~ s/\s//g;
168     
169     if( not $format_version or not $formatsSupported{$format_version} )
170     {
171         Error('Invalid format or format version not supported: ' . $infile);
172         exit 1;
173     }
174
175     my $globalParams = parseParams( $root );
176
177
178     # Parse the body of the XML
179
180     foreach my $hostNode ( $root->getChildrenByTagName('host') )
181     {
182         my $hostParams = parseParams( $hostNode, $globalParams );
183         normalizeParams( $hostParams );
184
185         my $outfile = $hostParams->{'output-file'};
186         if( not exists($perOutfileHostParams->{$outfile}) )
187         {
188             $perOutfileHostParams->{$outfile} = [];
189         }
190         push( @{$perOutfileHostParams->{$outfile}}, $hostParams );
191
192         my $outBundles = $hostParams->{'output-bundle'};
193         if( length( $outBundles ) > 0 )
194         {
195             foreach my $bundleName ( split( /\s*,\s*/, $outBundles ) )
196             {
197                 $bundleName = absXmlFilename( $bundleName );
198                 $outputBundles{$bundleName}{ relXmlFilename($outfile) } = 1;
199             }
200         }
201     }
202 }
203
204
205 # Start discovery
206 my $jobQueue;
207 my $bundleDeletionQueue;
208 my $confBuildSemaphore;
209
210 if( $workerThreads > 1 )
211 {
212     require threads;
213     require threads::shared;
214     require Thread::Queue;
215     require Thread::Semaphore;
216
217     threads::shared::share( \$everythingsOk );
218
219     $jobQueue = new Thread::Queue;
220     $bundleDeletionQueue = new Thread::Queue;
221     $confBuildSemaphore = new Thread::Semaphore;
222
223     # Enqueue the output filenames    
224     foreach my $outfile ( sort keys %{$perOutfileHostParams} )
225     {
226         if( not matchLimitRe( $outfile ) )
227         {
228             next;
229         }
230
231         $jobQueue->enqueue( $outfile );
232     }
233
234     # Start the worker threads
235     my @workers;
236     foreach my $i ( 1..$workerThreads )
237     {
238         push( @workers, threads->create( \&discoveryThread ) );
239     }
240
241     # Wait for workers to finish the jobs
242     while( my $thr = shift( @workers ) )
243     {
244         my $tid = $thr->tid();
245         $thr->join();
246         Debug('Cleaning up thread #' . $tid);
247         undef $thr;
248     }
249
250     # Process the files to be excluded from bundles
251
252     if( not $everythingsOk )
253     {
254         my $outfile;
255         while( defined( $outfile = $bundleDeletionQueue->dequeue_nb() ) )
256         {
257             removeFromBundle( $outfile );
258         }
259     }
260 }
261 else
262 {
263     # Single-thread operation
264        
265     foreach my $outfile ( sort keys %{$perOutfileHostParams} )
266     {
267         if( not matchLimitRe( $outfile ) )
268         {
269             next;
270         }
271         
272         if( not doDiscover( $outfile ) )
273         {
274             removeFromBundle( $outfile );
275         }
276     }
277 }
278
279 # Discovery finished, do the bundles
280
281 if( scalar( keys %outputBundles ) > 0 )
282 {
283     if( defined( $limitre ) )
284     {
285         Warn('Cannot write bundles with --limit option specified. ' .
286              'Bundle files remain unchanged');
287     }
288     elsif( $everythingsOk )
289     {
290         foreach my $bundleName ( sort keys %outputBundles )
291         {
292             my $cb = new Torrus::ConfigBuilder;
293
294             $cb->addCreatorInfo( $creator );
295             
296             foreach my $bundleMember
297                 ( sort keys %{$outputBundles{$bundleName}} )
298             {
299                 $cb->addFileInclusion( $bundleMember );
300             }
301
302             my $ok = $cb->toFile( $bundleName );
303             if( $ok )
304             {
305                 Verbose('Wrote bundle to ' . $bundleName);
306             }
307             else
308             {
309                 Error('Cannot write bundle to ' . $bundleName . ': ' . $!);
310                 $everythingsOk = 0;
311             }
312         }
313     }
314     else
315     {
316         Error('Skipping bundles generation because of errors');
317     }
318 }
319
320
321 exit($everythingsOk ? 0:1);
322
323
324 sub parseParams
325 {
326     my $parentNode = shift;
327     my $paramhash = shift;
328
329     # Clone the parameters hash
330     my $ret = {};
331     if( $paramhash )
332     {
333         while( my($key, $val) = each %{$paramhash} )
334         {
335             $ret->{$key} = $val;
336         }
337     }
338
339     foreach my $paramNode ( $parentNode->getChildrenByTagName('param') )
340     {
341         my $param = $paramNode->getAttribute('name');
342         my $value = $paramNode->getAttribute('value');
343
344         if( not $param )
345         {
346             Error("Parameter without name");
347             exit 1;
348         }
349
350         if( not defined( $value ) )
351         {
352             $value = $paramNode->textContent();
353         }
354
355         # Remove spaces in the head and tail.
356         $value =~ s/^\s+//;
357         $value =~ s/\s+$//;
358
359         $ret->{$param} = $value;
360     }
361     return $ret;
362 }
363
364
365 sub normalizeParams
366 {
367     my $params = shift;
368
369     if( not defined( $params->{'output-file'} ) )
370     {
371         Warn('output-file parameter is not defined. Using routers.xml');
372         $params->{'output-file'} = 'routers.xml';
373     }
374     else
375     {
376         $params->{'output-file'} = absXmlFilename( $params->{'output-file'} );
377     }
378
379     if( defined( $params->{'host-subtree'} ) )
380     {
381         my $subtree = $params->{'host-subtree'};
382
383         if( $subtree !~ /^\/[0-9A-Za-z_\-\.\/]*$/ or
384             $subtree =~ /\.\./ )
385         {
386             Error("Invalid format for subtree name: " . $subtree);
387             exit 1;
388         }
389     }
390
391     if( defined( $params->{'snmp-community'} ) )
392     {
393         # Remove any possible Unicode character treatment
394         $params->{'snmp-community'} =
395             pack( 'A*', $params->{'snmp-community'} );
396     }
397 }
398
399
400 # Replaces $XMLCONFIG with the XML root directory
401 sub absXmlFilename
402 {
403     my $filename = shift;
404
405     my $subst = '$XMLCONFIG';
406     my $offset = index( $filename, $subst );
407     if( $offset >= 0 )
408     {
409         my $len = length( $subst );
410         substr( $filename, $offset, $len ) = $Torrus::Global::siteXmlDir;
411     }
412     else
413     {
414         if( $filename !~ /^\// )
415         {
416             $filename = $Torrus::Global::siteXmlDir . '/' . $filename;
417         }
418     }
419     return $filename;
420 }
421
422
423 # Removes XML root directory from path
424 sub relXmlFilename
425 {
426     my $filename = shift;
427
428     my $subst = $Torrus::Global::siteXmlDir;
429     my $len = length( $subst );
430
431     if( $filename =~ /^\// )
432     {
433         my $offset = index( $filename, $subst );
434         if( $offset == 0 )
435         {
436             $filename = substr( $filename, $len );
437             # we don't know if xmldir has a trailing slash
438             $filename =~ s/^\///;
439         }
440     }
441     return $filename;
442 }
443
444
445 sub matchLimitRe
446 {
447     my $filename = shift;
448
449     if( defined( $limitre ) )
450     {
451         $filename =~ s/^.*\///;
452
453         if( $filename !~ $limitre )
454         {
455             return 0;
456         }
457     }
458
459     return 1;
460 }
461
462
463 # Pick up next available outfile until the job queue is empty
464
465 sub discoveryThread
466 {
467     Torrus::Log::setTID( threads->tid() );
468     Debug('Started thread #' . threads->tid());
469     my $outfile;
470     while( defined( $outfile = $jobQueue->dequeue_nb() ))
471     {
472         if( not doDiscover( $outfile ) )
473         {
474             $bundleDeletionQueue->enqueue( $outfile );
475         }
476     }
477     Debug('Finished thread #' . threads->tid());
478 }
479
480
481
482 sub doDiscover
483 {
484     my $outfile = shift;
485     
486     Verbose('Preparing to write ' . $outfile);
487
488     my $dd = new Torrus::DevDiscover;
489     my $ok = 1;
490
491     foreach my $hostParams ( @{$perOutfileHostParams->{$outfile}} )
492     {
493         $ok = $dd->discover( $hostParams );
494
495         if( not $ok )
496         {
497             Error($outfile . ' was not written because of errors');
498             $everythingsOk = 0;
499             last;
500         }
501     }
502
503     if( $ok )
504     {
505         # LibXML2 is not thread-safe, so we create the XML files
506         # one at a time
507         if( $workerThreads > 1 )
508         {
509             $confBuildSemaphore->down();
510         }
511         
512         my $cb = new Torrus::ConfigBuilder;
513
514         $cb->addCreatorInfo( $creator );
515
516         $dd->buildConfig( $cb );
517         $cb->addRequiredFiles();
518         $cb->addStatistics();
519
520         $ok = $cb->toFile( $outfile );
521         if( $ok )
522         {
523             Verbose('Wrote ' . $outfile);
524         }
525         else
526         {
527             Error('Cannot write ' . $outfile . ': ' . $!);
528             $everythingsOk = 0;
529         }
530
531         if( $workerThreads > 1 )
532         {
533             $confBuildSemaphore->up();
534         }
535     }
536
537     if( $makedirs )
538     {
539         if( $everythingsOk )
540         {
541             # Not sure if these calls are reentrant
542             if( $workerThreads > 1 )
543             {
544                 $confBuildSemaphore->down();
545             }
546             
547             my ($login,$pass,$uid,$gid) = getpwnam('@torrus_user@')
548                 or die "Cannot get user details for @torrus_user@";
549             
550             foreach my $dir ( $dd->listDataDirs() )
551             {
552                 if( not -d $dir )
553                 {
554                     Debug('Creating directory: ' . $dir);
555                     mkdir( $dir ) or
556                         Error('Cannot create directory: ' .
557                               $dir . ': ' . $!);
558                     chown( $uid, $gid, $dir ) or
559                         Error('Cannot change ownership for ' .
560                               $dir . ': ' . $!);
561                     chmod( 02755, $dir ) or
562                         Error('Cannot chmod 02755 for ' .
563                               $dir . ': ' . $!);
564                 }
565             }
566
567             if( $workerThreads > 1 )
568             {
569                 $confBuildSemaphore->up();
570             }            
571         }
572         else
573         {
574             Error('Skipping mkdir because of errors');
575         }
576     }
577     
578     return $ok;
579 }
580
581
582 sub removeFromBundle
583 {
584     my $outfile = shift;
585     
586     my $relname  = relXmlFilename($outfile);
587     
588     my $removeFromBundle = 1;
589         
590     if( $forcebundle )
591     {
592         if( defined( $fallback ) and
593             -e $outfile and -M $outfile <= $fallback )
594         {               
595             Warn('Falling back to the old version of ' . $relname);
596             $removeFromBundle = 0;
597         }
598         $everythingsOk = 1;
599     }
600
601     if( $removeFromBundle )
602     {
603         foreach my $bundleName ( sort keys %outputBundles )
604         {
605             if( exists( $outputBundles{$bundleName}{$relname} ) )
606             {
607                 delete $outputBundles{$bundleName}{$relname};
608                 Warn('Bundle ' . $bundleName . ' will not have ' .
609                      $relname . ' included because of errors');
610             }
611         }
612     }
613 }
614
615 # Local Variables:
616 # mode: perl
617 # indent-tabs-mode: nil
618 # perl-indent-level: 4
619 # End: