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