FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm

   1 package FS::NetworkMonitoringSystem::Torrus_Internal;
   2
   3 use strict;
   4 #use vars qw( $DEBUG $me );
   5 use Fcntl qw(:flock);
   6 use IO::File;
   7 use File::Slurp qw(slurp);
   8
   9 #$DEBUG = 0;
  10 #$me = '[FS::NetworkMonitoringSystem::Torrus_Internal]';
  11
  12 our $lock;
  13 our $lockfile = '/usr/local/etc/torrus/discovery/FSLOCK';
  14 our $ddxfile  = '/usr/local/etc/torrus/discovery/routers.ddx';
  15
  16 sub add_router {
  17   my($self, $ip) = @_;
  18
  19   my $newhost =
  20     qq(  <host>\n).
  21     qq(    <param name="snmp-host" value="$ip"/>\n).
  22     qq(  </host>\n);
  23
  24   my $ddx = $self->_torrus_loadddx;
  25
  26   $ddx =~ s{(</snmp-discovery>)}{$newhost$1};
  27
  28   $self->_torrus_newddx($ddx);
  29
  30 sub add_interface {
  31   my($self, $router_ip, $interface, $serviceid ) = @_;
  32
  33   $interface =~ s(\/)(_)g;
  34
  35   #should just use a proper XML parser huh
  36
  37   my $newline = "     $serviceid:$interface:Both:main,";
  38
  39   my @ddx = split(/\n/, $self->_torrus_loadddx);
  40   my $new = '';
  41
  42   my $added = 0;
  43
  44   while ( my $line = shift(@ddx) ) {
  45     $new .= "$line\n";
  46     next unless $line =~ /^\s*<param\s+name="snmp-host"\s+value="$router_ip"\/?>/i;
  47
  48     while ( my $hostline = shift(@ddx) ) {
  49       $new .= "$hostline\n";
  50       if ( $hostline =~ /^\s*<param name="RFC2863_IF_MIB::external-serviceid"\/?>/i ) {
  51
  52         while ( my $paramline = shift(@ddx) ) {
  53           if ( $paramline =~ /^\s*</param>/ ) {
  54             $new .= "$newline\n$paramline";
  55             last; #paramline
  56           } else {
  57             $new .= $paramline;
  58           }
  59         }
  60
  61         $added++;
  62
  63       } elsif ( $hostline =~ /^\s+<\/host>\s*/i ) {
  64         unless ( $added ) {
  65           $new .=
  66             qq(   <param name="RFC2863_IF_MIB::external-serviceid">\n).
  67             qq(     $newline\n").
  68             qq(   </param>\n).
  69         }
  70         $new .= $hostline;
  71         last; #hostline
  72       }
  73
  74     }
  75
  76   }
  77
  78   $self->_torrus_newddx($new);
  79
  80 }
  81
  82 sub _torrus_lock {
  83   $lock = new IO:::File ">>$lockfile" or die $!;
  84   flock($lock, LOCK_EX);
  85 }
  86
  87 sub _torrus_unlock {
  88   flock($lock, LOCK_UN);
  89   close $lock;
  90 }
  91
  92 sub _torrus_loadddx {
  93   my($self) = @_;
  94   $self->_torrus_lock;
  95   return slurp($ddxfile);
  96 }
  97
  98 sub _torrus_newddx {
  99   my($self, $ddx) = @_;
 100
 101   my $new = new IO::File ">$ddxfile.new"
 102     or die "can't write to $ddxfile.new: $!";
 103   print $new $ddx;
 104   close $new;
 105   rename("$ddxfile", $ddxfile.`date +%Y%m%d%H%M%S`) or die $!;
 106   rename("$ddxfile.new", $ddxfile) or die $!;
 107
 108   $self->_torrus_reload;
 109 }
 110
 111 sub _torrus_reload {
 112   my($self) = @_;
 113
 114   #i should have better error checking
 115
 116   system('torrus', 'devdiscover', "--in=$ddxfile");
 117
 118   system('torrus', 'compile', '--tree=main'); # , '--verbose'
 119
 120   $self->_torrus_unlock;
 121
 122 }
 123
 124 1;