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 IPC::Run qw(run);
   9 use Date::Format;
  10 use XML::Simple;
  11 use FS::Record qw(qsearch qsearchs dbh);
  12 use FS::svc_port;
  13 use FS::torrus_srvderive;
  14 use FS::torrus_srvderive_component;
  15 #use Torrus::ConfigTree;
  16
  17 #$DEBUG = 0;
  18 #$me = '[FS::NetworkMonitoringSystem::Torrus_Internal]';
  19
  20 our $lock;
  21 our $lockfile = '/usr/local/etc/torrus/discovery/FSLOCK';
  22 our $ddxfile  = '/usr/local/etc/torrus/discovery/routers.ddx';
  23
  24 sub new {
  25     my $class = shift;
  26     my $self = {};
  27     bless $self, $class;
  28     return $self;
  29 }
  30
  31 sub ddx2hash {
  32     my $self = shift;
  33     my $ddx_xml = slurp($ddxfile);
  34     my $xs = new XML::Simple(RootName=> undef, SuppressEmpty => '',
  35                                 ForceArray => 1, );
  36     return $xs->XMLin($ddx_xml);
  37 }
  38
  39 sub get_router_serviceids {
  40   my $self = shift;
  41   my $router = shift;
  42   my $find_serviceid = shift;
  43   my $found_serviceid = 0;
  44   my $ddx_hash = $self->ddx2hash;
  45   return '' unless $ddx_hash->{'host'};
  46
  47   my @hosts = @{$ddx_hash->{host}};
  48   foreach my $host ( @hosts ) {
  49     my $param = $host->{param};
  50     if($param && $param->{'snmp-host'}
  51               && (!$router || $param->{'snmp-host'}->{'value'} eq $router)
  52               && $param->{'RFC2863_IF_MIB::external-serviceid'}) {
  53       my $serviceids =
  54         $param->{'RFC2863_IF_MIB::external-serviceid'}->{'content'};
  55       my %hash = ();
  56       if ($serviceids) {
  57         my @serviceids = split(',',$serviceids);
  58         foreach my $serviceid ( @serviceids ) {
  59           $serviceid =~ s/^\s+|\s+$//g;
  60           my @s = split(':',$serviceid);
  61           next unless scalar(@s) == 4;
  62           $hash{$s[1]} = $s[0] if $router;
  63           if ($find_serviceid && $find_serviceid eq $s[0]) {
  64             $hash{$param->{'snmp-host'}->{'value'}} = $s[1];
  65             $found_serviceid = 1;
  66           }
  67         }
  68       }
  69       return \%hash if ($router || $found_serviceid);
  70     }
  71   }
  72   '';
  73 }
  74
  75 #false laziness and probably should be merged w/above, but didn't want to mess
  76 # that up
  77 sub all_router_serviceids {
  78   my $self = shift;
  79   my $ddx_hash = $self->ddx2hash;
  80   return () unless $ddx_hash->{'host'};
  81
  82   my %hash = ();
  83   my @hosts = @{$ddx_hash->{host}};
  84   foreach my $host ( @hosts ) {
  85     my $param = $host->{param};
  86     if($param && $param->{'snmp-host'}
  87               && $param->{'RFC2863_IF_MIB::external-serviceid'}) {
  88       my $serviceids =
  89         $param->{'RFC2863_IF_MIB::external-serviceid'}->{'content'};
  90       if ($serviceids) {
  91         my @serviceids = split(',',$serviceids);
  92         foreach my $serviceid ( @serviceids ) {
  93           $serviceid =~ s/^\s+|\s+$//g;
  94           my @s = split(':',$serviceid);
  95           next unless scalar(@s) == 4;
  96           $hash{$s[0]}=1;
  97         }
  98       }
  99     }
 100   }
 101   return sort keys %hash;
 102 }
 103
 104 sub port_graphs_link {
 105     # hardcoded for 'main' tree for now
 106     my $self = shift;
 107     my $serviceid = shift;
 108     my $hash = $self->get_router_serviceids(undef,$serviceid) or return '';
 109     my @keys = keys %$hash; # yeah this is weird...
 110     my $host = $keys[0];
 111     my $iface = $hash->{$keys[0]};
 112
 113     #Torrus::ConfigTree is only available when running under the web UI
 114     eval 'use Torrus::ConfigTree;';
 115     die $@ if $@;
 116
 117     my $config_tree = new Torrus::ConfigTree( -TreeName => 'main' );
 118     my $token = $config_tree->token("/Routers/$host/Interface_Counters/$iface/InOut_bps");
 119     return $Torrus::Freeside::FSURL."/torrus/main?token=$token";
 120 }
 121
 122 sub find_svc {
 123     my $self = shift;
 124     my $serviceid = shift;
 125     return '' unless $serviceid =~ /^[0-9A-Za-z_\-.\\\/ ]+$/;
 126
 127     my @svc_port = qsearch('svc_port', { 'serviceid' => $serviceid });
 128     return '' unless scalar(@svc_port);
 129
 130     # for now it's like this, later on just change to qsearchs
 131
 132     return $svc_port[0];
 133 }
 134
 135 sub find_torrus_srvderive_component {
 136     my $self = shift;
 137     my $serviceid = shift;
 138     return '' unless $serviceid =~ /^[0-9A-Za-z_\-.\\\/ ]+$/;
 139
 140     qsearchs('torrus_srvderive_component', { 'serviceid' => $serviceid });
 141 }
 142
 143 sub report {
 144   my $self = shift;
 145
 146   my @ls = localtime(time);
 147   my ($d,$m,$y) = ($ls[3], $ls[4]+1, $ls[5]+1900);
 148   if ( $ls[3] == 1 ) {
 149     $m--;
 150     if ($m == 0) { $m=12; $y-- }
 151     #i should have better error checking
 152     system('torrus', 'report', '--report=MonthlyUsage', "--date=$y-$m-01");
 153     system('torrus', 'report', '--genhtml', '--all2tree=main');
 154   }
 155
 156 }
 157
 158 sub queued_add_router {
 159   my $self = shift;
 160   my $error = $self->add_router(@_);
 161   die $error if $error;
 162 }
 163
 164 sub add_router {
 165   my($self, $ip, $community) = @_;
 166
 167   $community = (defined($community) && length($community) > 1)
 168                  ? qq!<param name="snmp-community" value="$community"/>\n !
 169                  : '';
 170
 171   my $newhost =
 172     qq(  <host>\n).
 173     qq(    <param name="snmp-host" value="$ip"/>\n).$community.
 174     qq(  </host>\n);
 175
 176   my $ddx = $self->_torrus_loadddx;
 177
 178   $ddx =~ s{(</snmp-discovery>)}{$newhost$1};
 179
 180   $self->_torrus_newddx($ddx);
 181
 182 }
 183
 184 sub add_interface {
 185   my($self, $router_ip, $interface, $serviceid ) = @_;
 186
 187   #false laziness w/torrus/perllib/Torrus/Renderer.pm iface_underscore, update both
 188   $interface =~ s(\/)(_)g; #slashes become underscores
 189   $interface =~ s(\.)(_)g; #periods too, huh
 190   $interface =~ s(\-)(_)g; #yup, and dashes
 191
 192   #should just use a proper XML parser huh
 193
 194   my @ddx = split(/\n/, $self->_torrus_loadddx);
 195
 196   die "Torrus Service ID $serviceid in use\n"
 197     if grep /^\s*$serviceid:/, @ddx;
 198
 199   my $newline = "     $serviceid:$interface:Both:main,";
 200
 201   my $new = '';
 202
 203   my $added = 0;
 204
 205   while ( my $line = shift(@ddx) ) {
 206     $new .= "$line\n";
 207     next unless $line =~ /^\s*<param\s+name="snmp-host"\s+value="$router_ip"\/?>/i;
 208
 209     while ( my $hostline = shift(@ddx) ) {
 210       $new .= "$hostline\n" unless $hostline =~ /^\s+<\/host>\s*/i;
 211       if ( $hostline =~ /^\s*<param name="RFC2863_IF_MIB::external-serviceid"\/?>/i ) {
 212
 213         while ( my $paramline = shift(@ddx) ) {
 214           if ( $paramline =~ /^\s*<\/param>/ ) {
 215             $new .= "$newline\n$paramline\n";
 216             last; #paramline
 217           } else {
 218             $new .= "$paramline\n";
 219           }
 220         }
 221
 222         $added++;
 223
 224       } elsif ( $hostline =~ /^\s+<\/host>\s*/i ) {
 225         unless ( $added ) {
 226           $new .=
 227             qq(   <param name="RFC2863_IF_MIB::external-serviceid">\n).
 228             qq(     $newline\n).
 229             qq(   </param>\n);
 230         }
 231         $new .= "$hostline\n";
 232         last; #hostline
 233       }
 234
 235     }
 236
 237   }
 238
 239   $self->_torrus_newddx($new);
 240
 241 }
 242
 243 sub _torrus_lock {
 244   $lock = new IO::File ">>$lockfile" or die $!;
 245   flock($lock, LOCK_EX);
 246 }
 247
 248 sub _torrus_unlock {
 249   flock($lock, LOCK_UN);
 250   close $lock;
 251 }
 252
 253 sub _torrus_loadddx {
 254   my($self) = @_;
 255   $self->_torrus_lock;
 256   return slurp($ddxfile);
 257 }
 258
 259 sub _torrus_newddx {
 260   my($self, $ddx) = @_;
 261
 262   my $new = new IO::File ">$ddxfile.new"
 263     or die "can't write to $ddxfile.new: $!";
 264   print $new $ddx;
 265   close $new;
 266
 267   my $tmpname = $ddxfile . Date::Format::time2str('%Y%m%d%H%M%S',time);
 268   rename($ddxfile, $tmpname) or die $!;
 269   rename("$ddxfile.new", $ddxfile) or die $!;
 270
 271   my $error = $self->_torrus_reload;
 272   if ( $error ) { #revert routers.ddx
 273     rename($ddxfile, "$tmpname.FAILED") or die $!;
 274     rename($tmpname, $ddxfile) or die $!;
 275   }
 276
 277   $self->_torrus_unlock;
 278
 279   return $error;
 280 }
 281
 282 sub _torrus_reload {
 283   my($self) = @_;
 284
 285   my $stderr = '';
 286   run( ['torrus', 'devdiscover', "--in=$ddxfile"], '2>'=>\$stderr );
 287   return $stderr if $stderr;
 288
 289   run( ['torrus', 'compile', '--tree=main'] ); # , '--verbose'
 290   #typically the errors happen at the discover stage...
 291
 292   '';
 293
 294 }
 295
 296 #sub torrus_serviceids {
 297 #  my $self = shift;
 298 #
 299 #  #is this going to get too slow or will the index make it okay?
 300 #  my $sth = dbh->prepare("SELECT DISTINCT(serviceid) FROM srvexport")
 301 #    or die dbh->errstr;
 302 #  $sth->execute or die $sth->errstr;
 303 #  my %serviceid = ();
 304 #  while ( my $row = $sth->fetchrow_arrayref ) {
 305 #    my $serviceid = $row->[0];
 306 #    $serviceid =~ s/_(IN|OUT)$//;
 307 #    $serviceid{$serviceid}=1;
 308 #  }
 309 #  my @serviceids = sort keys %serviceid;
 310 #
 311 #  @serviceids;
 312 #
 313 #}
 314
 315 sub torrus_serviceids {
 316   my $self = shift;
 317   my @serviceids = $self->all_router_serviceids;
 318   push @serviceids, map $_->serviceid, qsearch('torrus_srvderive', {});
 319   return sort @serviceids;
 320 }
 321
 322 1;