X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FNetworkMonitoringSystem%2FTorrus_Internal.pm;h=28bc8a7611732eac6ea6c8cf2a874fc38432fe43;hb=425b5f85e183064be4cc3e1a8ce444f11fe011df;hp=f436e3bb90e0d930b29b174c9262d6b3fc1704bd;hpb=09c2892518ff1ad120af230b7a695ef1b7637ac8;p=freeside.git diff --git a/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm b/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm index f436e3bb9..28bc8a761 100644 --- a/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm +++ b/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm @@ -5,13 +5,14 @@ use strict; use Fcntl qw(:flock); use IO::File; use File::Slurp qw(slurp); +use IPC::Run qw(run); 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; +#use Torrus::ConfigTree; #$DEBUG = 0; #$me = '[FS::NetworkMonitoringSystem::Torrus_Internal]'; @@ -108,6 +109,11 @@ sub port_graphs_link { 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"; @@ -149,12 +155,22 @@ sub report { } +sub queued_add_router { + my $self = shift; + my $error = $self->add_router(@_); + die $error if $error; +} + sub add_router { - my($self, $ip) = @_; + my($self, $ip, $community) = @_; + + $community = (defined($community) && length($community) > 1) + ? qq!\n ! + : ''; my $newhost = qq( \n). - qq( \n). + qq( \n).$community. qq( \n); my $ddx = $self->_torrus_loadddx; @@ -168,8 +184,10 @@ sub add_router { sub add_interface { my($self, $router_ip, $interface, $serviceid ) = @_; + #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 @@ -207,7 +225,7 @@ sub add_interface { unless ( $added ) { $new .= qq( \n). - qq( $newline\n"). + qq( $newline\n). qq( \n); } $new .= "$hostline\n"; @@ -247,23 +265,31 @@ sub _torrus_newddx { close $new; my $tmpname = $ddxfile . Date::Format::time2str('%Y%m%d%H%M%S',time); - rename("$ddxfile", $tmpname) or die $!; + rename($ddxfile, $tmpname) or die $!; rename("$ddxfile.new", $ddxfile) or die $!; - $self->_torrus_reload; + my $error = $self->_torrus_reload; + if ( $error ) { #revert routers.ddx + rename($ddxfile, "$tmpname.FAILED") or die $!; + rename($tmpname, $ddxfile) or die $!; + } + + $self->_torrus_unlock; + + return $error; } sub _torrus_reload { my($self) = @_; - #i should use IPC::Run and have better error checking (commands are silent - # for success, or output errors) + my $stderr = ''; + run( ['torrus', 'devdiscover', "--in=$ddxfile"], '2>'=>\$stderr ); + return $stderr if $stderr; - system('torrus', 'devdiscover', "--in=$ddxfile"); + run( ['torrus', 'compile', '--tree=main'] ); # , '--verbose' + #typically the errors happen at the discover stage... - system('torrus', 'compile', '--tree=main'); # , '--verbose' - - $self->_torrus_unlock; + ''; }