1 package FS::NetworkMonitoringSystem::Torrus_Internal;
4 #use vars qw( $DEBUG $me );
7 use File::Slurp qw(slurp);
11 use FS::Record qw(qsearch);
12 use Torrus::ConfigTree;
15 #$me = '[FS::NetworkMonitoringSystem::Torrus_Internal]';
18 our $lockfile = '/usr/local/etc/torrus/discovery/FSLOCK';
19 our $ddxfile = '/usr/local/etc/torrus/discovery/routers.ddx';
30 my $ddx_xml = slurp($ddxfile);
31 my $xs = new XML::Simple(RootName=> undef, SuppressEmpty => '',
33 return $xs->XMLin($ddx_xml);
36 sub get_router_serviceids {
39 my $find_serviceid = shift;
40 my $found_serviceid = 0;
41 my $ddx_hash = $self->ddx2hash;
42 if($ddx_hash->{host}){
43 my @hosts = @{$ddx_hash->{host}};
44 foreach my $host ( @hosts ) {
45 my $param = $host->{param};
46 if($param && $param->{'snmp-host'}
47 && (!$router || $param->{'snmp-host'}->{'value'} eq $router)
48 && $param->{'RFC2863_IF_MIB::external-serviceid'}) {
49 my $serviceids = $param->{'RFC2863_IF_MIB::external-serviceid'}->{'content'};
52 my @serviceids = split(',',$serviceids);
53 foreach my $serviceid ( @serviceids ) {
54 $serviceid =~ s/^\s+|\s+$//g;
55 my @s = split(':',$serviceid);
56 next unless scalar(@s) == 4;
57 $hash{$s[1]} = $s[0] if $router;
58 if ($find_serviceid && $find_serviceid eq $s[0]) {
59 $hash{$param->{'snmp-host'}->{'value'}} = $s[1];
64 return \%hash if ($router || $found_serviceid);
71 sub port_graphs_link {
72 # hardcoded for 'main' tree for now
74 my $serviceid = shift;
75 my $hash = $self->get_router_serviceids(undef,$serviceid);
76 my @keys = keys %$hash; # yeah this is weird...
78 my $iface = $hash->{$keys[0]};
79 my $config_tree = new Torrus::ConfigTree( -TreeName => 'main' );
80 my $token = $config_tree->token("/Routers/$host/Interface_Counters/$iface/InOut_bps");
81 return $Torrus::Freeside::FSURL."/torrus/main?token=$token";
86 my $serviceid = shift;
87 return '' unless $serviceid =~ /^[0-9A-Za-z_\-.\\\/ ]+$/;
89 my @svc_port = qsearch('svc_port', { 'serviceid' => $serviceid });
90 return '' unless scalar(@svc_port);
92 # for now it's like this, later on just change to qsearchs
102 qq( <param name="snmp-host" value="$ip"/>\n).
105 my $ddx = $self->_torrus_loadddx;
107 $ddx =~ s{(</snmp-discovery>)}{$newhost$1};
109 $self->_torrus_newddx($ddx);
114 my($self, $router_ip, $interface, $serviceid ) = @_;
116 $interface =~ s(\/)(_)g;
118 #should just use a proper XML parser huh
120 my $newline = " $serviceid:$interface:Both:main,";
122 my @ddx = split(/\n/, $self->_torrus_loadddx);
127 while ( my $line = shift(@ddx) ) {
129 next unless $line =~ /^\s*<param\s+name="snmp-host"\s+value="$router_ip"\/?>/i;
131 while ( my $hostline = shift(@ddx) ) {
132 $new .= "$hostline\n" unless $hostline =~ /^\s+<\/host>\s*/i;
133 if ( $hostline =~ /^\s*<param name="RFC2863_IF_MIB::external-serviceid"\/?>/i ) {
135 while ( my $paramline = shift(@ddx) ) {
136 if ( $paramline =~ /^\s*<\/param>/ ) {
137 $new .= "$newline\n$paramline";
146 } elsif ( $hostline =~ /^\s+<\/host>\s*/i ) {
149 qq( <param name="RFC2863_IF_MIB::external-serviceid">\n).
161 $self->_torrus_newddx($new);
166 $lock = new IO::File ">>$lockfile" or die $!;
167 flock($lock, LOCK_EX);
171 flock($lock, LOCK_UN);
175 sub _torrus_loadddx {
178 return slurp($ddxfile);
182 my($self, $ddx) = @_;
184 my $new = new IO::File ">$ddxfile.new"
185 or die "can't write to $ddxfile.new: $!";
189 # `date ...` created file names with weird chars in them
190 my $tmpname = $ddxfile . Date::Format::time2str('%Y%m%d%H%M%S',time);
191 rename("$ddxfile", $tmpname) or die $!;
192 rename("$ddxfile.new", $ddxfile) or die $!;
194 $self->_torrus_reload;
200 #i should have better error checking
202 system('torrus', 'devdiscover', "--in=$ddxfile");
204 system('torrus', 'compile', '--tree=main'); # , '--verbose'
206 $self->_torrus_unlock;