1 package FS::NetworkMonitoringSystem::Torrus_Internal;
4 #use vars qw( $DEBUG $me );
7 use File::Slurp qw(slurp);
11 use FS::Record qw(qsearch dbh);
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) or return '';
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
100 my @ls = localtime(time);
101 my ($d,$m,$y) = ($ls[3], $ls[4]+1, $ls[5]+1900);
104 if ($m == 0) { $m=12; $y-- }
105 #i should have better error checking
106 system('torrus', 'report', '--report=MonthlyUsage', "--date=$y-$m-01");
107 system('torrus', 'report', '--genhtml', '--tree=main');
117 qq( <param name="snmp-host" value="$ip"/>\n).
120 my $ddx = $self->_torrus_loadddx;
122 $ddx =~ s{(</snmp-discovery>)}{$newhost$1};
124 $self->_torrus_newddx($ddx);
129 my($self, $router_ip, $interface, $serviceid ) = @_;
131 $interface =~ s(\/)(_)g;
133 #should just use a proper XML parser huh
135 my @ddx = split(/\n/, $self->_torrus_loadddx);
137 die "Torrus Service ID $serviceid in use\n"
138 if grep /^\s*$serviceid:/, @ddx;
140 my $newline = " $serviceid:$interface:Both:main,";
146 while ( my $line = shift(@ddx) ) {
148 next unless $line =~ /^\s*<param\s+name="snmp-host"\s+value="$router_ip"\/?>/i;
150 while ( my $hostline = shift(@ddx) ) {
151 $new .= "$hostline\n" unless $hostline =~ /^\s+<\/host>\s*/i;
152 if ( $hostline =~ /^\s*<param name="RFC2863_IF_MIB::external-serviceid"\/?>/i ) {
154 while ( my $paramline = shift(@ddx) ) {
155 if ( $paramline =~ /^\s*<\/param>/ ) {
156 $new .= "$newline\n$paramline\n";
159 $new .= "$paramline\n";
165 } elsif ( $hostline =~ /^\s+<\/host>\s*/i ) {
168 qq( <param name="RFC2863_IF_MIB::external-serviceid">\n).
172 $new .= "$hostline\n";
180 $self->_torrus_newddx($new);
185 $lock = new IO::File ">>$lockfile" or die $!;
186 flock($lock, LOCK_EX);
190 flock($lock, LOCK_UN);
194 sub _torrus_loadddx {
197 return slurp($ddxfile);
201 my($self, $ddx) = @_;
203 my $new = new IO::File ">$ddxfile.new"
204 or die "can't write to $ddxfile.new: $!";
208 my $tmpname = $ddxfile . Date::Format::time2str('%Y%m%d%H%M%S',time);
209 rename("$ddxfile", $tmpname) or die $!;
210 rename("$ddxfile.new", $ddxfile) or die $!;
212 $self->_torrus_reload;
218 #i should use IPC::Run and have better error checking (commands are silent
219 # for success, or output errors)
221 system('torrus', 'devdiscover', "--in=$ddxfile");
223 system('torrus', 'compile', '--tree=main'); # , '--verbose'
225 $self->_torrus_unlock;
229 sub torrus_serviceids {
232 #is this going to get too slow or will the index make it okay?
233 my $sth = dbh->prepare("SELECT DISTINCT(serviceid) FROM srvexport")
235 $sth->execute or die $sth->errstr;
237 while ( my $row = $sth->fetchrow_arrayref ) {
238 my $serviceid = $row->[0];
239 $serviceid =~ s/_(IN|OUT)$//;
240 $serviceid{$serviceid}=1;
242 my @serviceids = sort keys %serviceid;