X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FNetworkMonitoringSystem%2FTorrus_Internal.pm;h=04a6b295457872c50ca03175a023c968cf73aa51;hb=bdb7b4bf619b14291bdd44919a1a8121ce06df33;hp=68356e72d83feccd42d320a31b4f411a7caa1b2b;hpb=40d1e71653e1a0021021d9d3f7f7705cf9df4d61;p=freeside.git diff --git a/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm b/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm index 68356e72d..04a6b2954 100644 --- a/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm +++ b/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm @@ -5,6 +5,13 @@ use strict; use Fcntl qw(:flock); use IO::File; use File::Slurp qw(slurp); +use Date::Format; +use XML::Simple; +use FS::Record qw(qsearch qsearchs dbh); +use FS::svc_port; +use FS::torrus_srvderive; +use FS::torrus_srvderive_component; +#use Torrus::ConfigTree; #$DEBUG = 0; #$me = '[FS::NetworkMonitoringSystem::Torrus_Internal]'; @@ -13,12 +20,149 @@ our $lock; our $lockfile = '/usr/local/etc/torrus/discovery/FSLOCK'; our $ddxfile = '/usr/local/etc/torrus/discovery/routers.ddx'; +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +} + +sub ddx2hash { + my $self = shift; + my $ddx_xml = slurp($ddxfile); + my $xs = new XML::Simple(RootName=> undef, SuppressEmpty => '', + ForceArray => 1, ); + return $xs->XMLin($ddx_xml); +} + +sub get_router_serviceids { + my $self = shift; + my $router = shift; + my $find_serviceid = shift; + my $found_serviceid = 0; + my $ddx_hash = $self->ddx2hash; + return '' unless $ddx_hash->{'host'}; + + my @hosts = @{$ddx_hash->{host}}; + foreach my $host ( @hosts ) { + my $param = $host->{param}; + if($param && $param->{'snmp-host'} + && (!$router || $param->{'snmp-host'}->{'value'} eq $router) + && $param->{'RFC2863_IF_MIB::external-serviceid'}) { + my $serviceids = + $param->{'RFC2863_IF_MIB::external-serviceid'}->{'content'}; + my %hash = (); + if ($serviceids) { + my @serviceids = split(',',$serviceids); + foreach my $serviceid ( @serviceids ) { + $serviceid =~ s/^\s+|\s+$//g; + my @s = split(':',$serviceid); + next unless scalar(@s) == 4; + $hash{$s[1]} = $s[0] if $router; + if ($find_serviceid && $find_serviceid eq $s[0]) { + $hash{$param->{'snmp-host'}->{'value'}} = $s[1]; + $found_serviceid = 1; + } + } + } + return \%hash if ($router || $found_serviceid); + } + } + ''; +} + +#false laziness and probably should be merged w/above, but didn't want to mess +# that up +sub all_router_serviceids { + my $self = shift; + my $ddx_hash = $self->ddx2hash; + return () unless $ddx_hash->{'host'}; + + my %hash = (); + my @hosts = @{$ddx_hash->{host}}; + foreach my $host ( @hosts ) { + my $param = $host->{param}; + if($param && $param->{'snmp-host'} + && $param->{'RFC2863_IF_MIB::external-serviceid'}) { + my $serviceids = + $param->{'RFC2863_IF_MIB::external-serviceid'}->{'content'}; + if ($serviceids) { + my @serviceids = split(',',$serviceids); + foreach my $serviceid ( @serviceids ) { + $serviceid =~ s/^\s+|\s+$//g; + my @s = split(':',$serviceid); + next unless scalar(@s) == 4; + $hash{$s[0]}=1; + } + } + } + } + return sort keys %hash; +} + +sub port_graphs_link { + # hardcoded for 'main' tree for now + my $self = shift; + my $serviceid = shift; + my $hash = $self->get_router_serviceids(undef,$serviceid) or return ''; + my @keys = keys %$hash; # yeah this is weird... + my $host = $keys[0]; + my $iface = $hash->{$keys[0]}; + + #Torrus::ConfigTree is only available when running under the web UI + eval 'use Torrus::ConfigTree;'; + die $@ if $@; + + my $config_tree = new Torrus::ConfigTree( -TreeName => 'main' ); + my $token = $config_tree->token("/Routers/$host/Interface_Counters/$iface/InOut_bps"); + return $Torrus::Freeside::FSURL."/torrus/main?token=$token"; +} + +sub find_svc { + my $self = shift; + my $serviceid = shift; + return '' unless $serviceid =~ /^[0-9A-Za-z_\-.\\\/ ]+$/; + + my @svc_port = qsearch('svc_port', { 'serviceid' => $serviceid }); + return '' unless scalar(@svc_port); + + # for now it's like this, later on just change to qsearchs + + return $svc_port[0]; +} + +sub find_torrus_srvderive_component { + my $self = shift; + my $serviceid = shift; + return '' unless $serviceid =~ /^[0-9A-Za-z_\-.\\\/ ]+$/; + + qsearchs('torrus_srvderive_component', { 'serviceid' => $serviceid }); +} + +sub report { + my $self = shift; + + my @ls = localtime(time); + my ($d,$m,$y) = ($ls[3], $ls[4]+1, $ls[5]+1900); + if ( $ls[3] == 1 ) { + $m--; + if ($m == 0) { $m=12; $y-- } + #i should have better error checking + system('torrus', 'report', '--report=MonthlyUsage', "--date=$y-$m-01"); + system('torrus', 'report', '--genhtml', '--all2tree=main'); + } + +} + sub add_router { - my($self, $ip) = @_; + my($self, $ip, $community) = @_; + + $community = qq!\n ! + if length($community) > 1; my $newhost = qq( \n). - qq( \n). + qq( \n).$community. qq( \n); my $ddx = $self->_torrus_loadddx; @@ -27,16 +171,25 @@ sub add_router { $self->_torrus_newddx($ddx); +} + sub add_interface { my($self, $router_ip, $interface, $serviceid ) = @_; - $interface =~ s(\/)(_)g; + #false laziness w/torrus/perllib/Torrus/Renderer.pm iface_underscore, update both + $interface =~ s(\/)(_)g; #slashes become underscores + $interface =~ s(\.)(_)g; #periods too, huh + $interface =~ s(\-)(_)g; #yup, and dashes #should just use a proper XML parser huh + my @ddx = split(/\n/, $self->_torrus_loadddx); + + die "Torrus Service ID $serviceid in use\n" + if grep /^\s*$serviceid:/, @ddx; + my $newline = " $serviceid:$interface:Both:main,"; - my @ddx = split(/\n/, $self->_torrus_loadddx); my $new = ''; my $added = 0; @@ -46,15 +199,15 @@ sub add_interface { next unless $line =~ /^\s*/i; while ( my $hostline = shift(@ddx) ) { - $new .= "$hostline\n"; + $new .= "$hostline\n" unless $hostline =~ /^\s+<\/host>\s*/i; if ( $hostline =~ /^\s*/i ) { while ( my $paramline = shift(@ddx) ) { - if ( $paramline =~ /^\s*/ ) { - $new .= "$newline\n$paramline"; + if ( $paramline =~ /^\s*<\/param>/ ) { + $new .= "$newline\n$paramline\n"; last; #paramline } else { - $new .= $paramline; + $new .= "$paramline\n"; } } @@ -64,10 +217,10 @@ sub add_interface { unless ( $added ) { $new .= qq( \n). - qq( $newline\n"). - qq( \n). + qq( $newline\n). + qq( \n); } - $new .= $hostline; + $new .= "$hostline\n"; last; #hostline } @@ -80,7 +233,7 @@ sub add_interface { } sub _torrus_lock { - $lock = new IO:::File ">>$lockfile" or die $!; + $lock = new IO::File ">>$lockfile" or die $!; flock($lock, LOCK_EX); } @@ -102,7 +255,9 @@ sub _torrus_newddx { or die "can't write to $ddxfile.new: $!"; print $new $ddx; close $new; - rename("$ddxfile", $ddxfile.`date +%Y%m%d%H%M%S`) or die $!; + + my $tmpname = $ddxfile . Date::Format::time2str('%Y%m%d%H%M%S',time); + rename("$ddxfile", $tmpname) or die $!; rename("$ddxfile.new", $ddxfile) or die $!; $self->_torrus_reload; @@ -111,7 +266,8 @@ sub _torrus_newddx { sub _torrus_reload { my($self) = @_; - #i should have better error checking + #i should use IPC::Run and have better error checking (commands are silent + # for success, or output errors) system('torrus', 'devdiscover', "--in=$ddxfile"); @@ -121,4 +277,30 @@ sub _torrus_reload { } +#sub torrus_serviceids { +# my $self = shift; +# +# #is this going to get too slow or will the index make it okay? +# my $sth = dbh->prepare("SELECT DISTINCT(serviceid) FROM srvexport") +# or die dbh->errstr; +# $sth->execute or die $sth->errstr; +# my %serviceid = (); +# while ( my $row = $sth->fetchrow_arrayref ) { +# my $serviceid = $row->[0]; +# $serviceid =~ s/_(IN|OUT)$//; +# $serviceid{$serviceid}=1; +# } +# my @serviceids = sort keys %serviceid; +# +# @serviceids; +# +#} + +sub torrus_serviceids { + my $self = shift; + my @serviceids = $self->all_router_serviceids; + push @serviceids, map $_->serviceid, qsearch('torrus_srvderive', {}); + return sort @serviceids; +} + 1;