X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FNetworkMonitoringSystem%2FTorrus_Internal.pm;h=28bc8a7611732eac6ea6c8cf2a874fc38432fe43;hb=HEAD;hp=63a93268c4f0b931037844e7484ea23b6b747624;hpb=acdcfc79977617610989a3a5eee39c63e373a546;p=freeside.git diff --git a/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm b/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm index 63a93268c..28bc8a761 100644 --- a/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm +++ b/FS/FS/NetworkMonitoringSystem/Torrus_Internal.pm @@ -5,6 +5,7 @@ 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); @@ -154,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; @@ -173,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 @@ -212,7 +225,7 @@ sub add_interface { unless ( $added ) { $new .= qq( \n). - qq( $newline\n"). + qq( $newline\n). qq( \n); } $new .= "$hostline\n"; @@ -252,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) - - system('torrus', 'devdiscover', "--in=$ddxfile"); + my $stderr = ''; + run( ['torrus', 'devdiscover', "--in=$ddxfile"], '2>'=>\$stderr ); + return $stderr if $stderr; - system('torrus', 'compile', '--tree=main'); # , '--verbose' + run( ['torrus', 'compile', '--tree=main'] ); # , '--verbose' + #typically the errors happen at the discover stage... - $self->_torrus_unlock; + ''; }