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 use Date::Format;
   9 use XML::Simple;
  10 use FS::svc_port;
  11 use FS::Record qw(qsearch);
  12
  13 #$DEBUG = 0;
  14 #$me = '[FS::NetworkMonitoringSystem::Torrus_Internal]';
  15
  16 our $lock;
  17 our $lockfile = '/usr/local/etc/torrus/discovery/FSLOCK';
  18 our $ddxfile  = '/usr/local/etc/torrus/discovery/routers.ddx';
  19
  20 sub new {
  21     my $class = shift;
  22     my $self = {};
  23     bless $self, $class;
  24     return $self;
  25 }
  26
  27 sub get_router_serviceids {
  28     my $self = shift;
  29     my $router = shift;
  30
  31     my $ddx_xml = slurp($ddxfile);
  32     my $xs = new XML::Simple(RootName=> undef, SuppressEmpty => '',
  33                                 ForceArray => 1, );
  34     my $ddx_hash = $xs->XMLin($ddx_xml);
  35     if($ddx_hash->{host}){
  36         my @hosts = @{$ddx_hash->{host}};
  37         foreach my $host ( @hosts ) {
  38             my $param = $host->{param};
  39             if($param && $param->{'snmp-host'}
  40                       && $param->{'snmp-host'}->{'value'} eq $router
  41                       && $param->{'RFC2863_IF_MIB::external-serviceid'}) {
  42                 my $serviceids = $param->{'RFC2863_IF_MIB::external-serviceid'}->{'content'};
  43                 my %hash = ();
  44                 if($serviceids) {
  45                     my @serviceids = split(',',$serviceids);
  46                     foreach my $serviceid ( @serviceids ) {
  47                         $serviceid =~ s/^\s+|\s+$//g;
  48                         my @s = split(':',$serviceid);
  49                         next unless scalar(@s) == 4;
  50                         $hash{$s[1]} = $s[0];
  51                     }
  52                 }
  53                 return \%hash;
  54             }
  55         }
  56     }
  57     '';
  58 }
  59
  60 sub find_svc {
  61     my $self = shift;
  62     my $serviceid = shift;
  63     return '' unless $serviceid =~ /^[0-9A-Za-z_\-.\\\/ ]+$/;
  64
  65     my @svc_port = qsearch('svc_port', { 'serviceid' => $serviceid });
  66     return '' unless scalar(@svc_port);
  67
  68     # for now it's like this, later on just change to qsearchs
  69
  70     return $svc_port[0];
  71 }
  72
  73 sub add_router {
  74   my($self, $ip) = @_;
  75
  76   my $newhost =
  77     qq(  <host>\n).
  78     qq(    <param name="snmp-host" value="$ip"/>\n).
  79     qq(  </host>\n);
  80
  81   my $ddx = $self->_torrus_loadddx;
  82
  83   $ddx =~ s{(</snmp-discovery>)}{$newhost$1};
  84
  85   $self->_torrus_newddx($ddx);
  86
  87 }
  88
  89 sub add_interface {
  90   my($self, $router_ip, $interface, $serviceid ) = @_;
  91
  92   $interface =~ s(\/)(_)g;
  93
  94   #should just use a proper XML parser huh
  95
  96   my $newline = "     $serviceid:$interface:Both:main,";
  97
  98   my @ddx = split(/\n/, $self->_torrus_loadddx);
  99   my $new = '';
 100
 101   my $added = 0;
 102
 103   while ( my $line = shift(@ddx) ) {
 104     $new .= "$line\n";
 105     next unless $line =~ /^\s*<param\s+name="snmp-host"\s+value="$router_ip"\/?>/i;
 106
 107     while ( my $hostline = shift(@ddx) ) {
 108       $new .= "$hostline\n" unless $hostline =~ /^\s+<\/host>\s*/i;
 109       if ( $hostline =~ /^\s*<param name="RFC2863_IF_MIB::external-serviceid"\/?>/i ) {
 110
 111         while ( my $paramline = shift(@ddx) ) {
 112           if ( $paramline =~ /^\s*<\/param>/ ) {
 113             $new .= "$newline\n$paramline";
 114             last; #paramline
 115           } else {
 116             $new .= $paramline;
 117           }
 118         }
 119
 120         $added++;
 121
 122       } elsif ( $hostline =~ /^\s+<\/host>\s*/i ) {
 123         unless ( $added ) {
 124           $new .=
 125             qq(   <param name="RFC2863_IF_MIB::external-serviceid">\n).
 126             qq(     $newline\n").
 127             qq(   </param>\n);
 128         }
 129         $new .= $hostline;
 130         last; #hostline
 131       }
 132
 133     }
 134
 135   }
 136
 137   $self->_torrus_newddx($new);
 138
 139 }
 140
 141 sub _torrus_lock {
 142   $lock = new IO::File ">>$lockfile" or die $!;
 143   flock($lock, LOCK_EX);
 144 }
 145
 146 sub _torrus_unlock {
 147   flock($lock, LOCK_UN);
 148   close $lock;
 149 }
 150
 151 sub _torrus_loadddx {
 152   my($self) = @_;
 153   $self->_torrus_lock;
 154   return slurp($ddxfile);
 155 }
 156
 157 sub _torrus_newddx {
 158   my($self, $ddx) = @_;
 159
 160   my $new = new IO::File ">$ddxfile.new"
 161     or die "can't write to $ddxfile.new: $!";
 162   print $new $ddx;
 163   close $new;
 164
 165   # `date ...` created file names with weird chars in them
 166   my $tmpname = $ddxfile . Date::Format::time2str('%Y%m%d%H%M%S',time);
 167   rename("$ddxfile", $tmpname) or die $!;
 168   rename("$ddxfile.new", $ddxfile) or die $!;
 169
 170   $self->_torrus_reload;
 171 }
 172
 173 sub _torrus_reload {
 174   my($self) = @_;
 175
 176   #i should have better error checking
 177
 178   system('torrus', 'devdiscover', "--in=$ddxfile");
 179
 180   system('torrus', 'compile', '--tree=main'); # , '--verbose'
 181
 182   $self->_torrus_unlock;
 183
 184 }
 185
 186 1;