scanning daemon and network status map, goal 1C
authorMark Wells <mark@freeside.biz>
Mon, 26 Sep 2016 22:25:07 +0000 (15:25 -0700)
committerMark Wells <mark@freeside.biz>
Tue, 27 Sep 2016 17:18:19 +0000 (10:18 -0700)
FS/FS/Daemon.pm
FS/FS/Schema.pm
FS/FS/addr_status.pm [new file with mode: 0644]
FS/FS/svc_IP_Mixin.pm
FS/bin/freeside-pingd [new file with mode: 0644]
FS/t/addr_status.t [new file with mode: 0644]
Makefile
httemplate/search/elements/gmap.html
httemplate/search/svc_broadband-map.html
httemplate/view/svc_broadband-popup.html [new file with mode: 0644]

index b58cde4..a386208 100644 (file)
@@ -9,6 +9,7 @@ use IO::File;
 use File::Basename;
 use File::Slurp qw(slurp);
 use Date::Format;
+use FS::UID qw( forksuidsetup );
 
 #this is a simple refactoring of the stuff from freeside-queued, just to
 #avoid duplicate code.  eventually this should use something from CPAN.
@@ -16,6 +17,7 @@ use Date::Format;
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(
   daemonize1 drop_root daemonize2 myexit logfile sigint sigterm
+  daemon_fork daemon_wait daemon_reconnect
 );
 %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
 
@@ -24,6 +26,10 @@ $pid_dir = '/var/run';
 $NOSIG = 0;
 $PID_NEWSTYLE = 0;
 
+our $MAX_KIDS = 10; # for daemon_fork
+our $kids = 0;
+our %kids;
+
 sub daemonize1 {
   $me = shift;
 
@@ -57,6 +63,13 @@ sub daemonize1 {
     $SIG{INT}  = sub { warn "SIGINT received; shutting down\n"; $sigint++;  };
     $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; };
   }
+
+  # set the logfile sensibly
+  if (!$logfile) {
+    my $logname = $me;
+    $logname =~ s/^freeside-//;
+    logfile("%%%FREESIDE_LOG%%%/$logname-log.$FS::UID::datasrc");
+  }
 }
 
 sub drop_root {
@@ -117,4 +130,90 @@ sub _logmsg {
   close $log;
 }
 
+=item daemon_fork CODEREF[, ARGS ]
+
+Executes CODEREF in a child process, with its own $FS::UID::dbh handle.  If
+the number of child processes is >= $FS::Daemon::MAX_KIDS then this will
+block until some of the child processes are finished. ARGS will be passed
+to the coderef.
+
+If the fork fails, this will throw an exception containing $!. Otherwise
+it returns the PID of the child, like fork() does.
+
+=cut
+
+sub daemon_fork {
+  $FS::UID::dbh->{AutoInactiveDestroy} = 1;
+  # wait until there's a lane open
+  daemon_wait($MAX_KIDS - 1);
+
+  my ($code, @args) = @_;
+
+  my $user = $FS::CurrentUser::CurrentUser->username;
+
+  my $pid = fork;
+  if (!defined($pid)) {
+
+    warn "WARNING: can't fork: $!\n";
+    die "$!\n";
+
+  } elsif ( $pid > 0 ) {
+
+    $kids{ $pid } = 1;
+    $kids++;
+    return $pid;
+
+  } else { # kid
+    forksuidsetup( $user );
+    &{$code}(@args);
+    exit;
+
+  }
+}
+
+=item daemon_wait [ MAX ]
+
+Waits until there are at most MAX daemon_fork() child processes running,
+reaps the ones that are finished, and continues. MAX defaults to zero, i.e.
+wait for everything to finish.
+
+=cut
+
+sub daemon_wait {
+  my $max = shift || 0;
+  while ($kids > $max) {
+    foreach my $pid (keys %kids) {
+      my $kid = waitpid($pid, WNOHANG);
+      if ( $kid > 0 ) {
+        $kids--;
+        delete $kids{$kid};
+      }
+    }
+    sleep(1);
+  }
+}
+
+=item daemon_reconnect
+
+Checks whether the database connection is live, and reconnects if not.
+
+=cut
+
+sub daemon_reconnect {
+  my $dbh = $FS::UID::dbh;
+  unless ($dbh && $dbh->ping) {
+    warn "WARNING: connection to database lost, reconnecting...\n";
+
+    eval { $FS::UID::dbh = myconnect; };
+
+    unless ( !$@ && $FS::UID::dbh && $FS::UID::dbh->ping ) {
+      warn "WARNING: still no connection to database, sleeping for retry...\n";
+      sleep 10;
+      next;
+    } else {
+      warn "WARNING: reconnected to database\n";
+    }
+  }
+}
+
 1;
index f66cb36..ced3775 100644 (file)
@@ -203,6 +203,7 @@ sub dbdef_dist {
            && ! /^log(_context)?$/
            && ! /^(legacy_cust_history|cacti_page|template_image|access_user_log)$/
            && ( ! /^queue(_arg|_depend|_stat)?$/ || ! $opt->{'queue-no_history'} )
+           && ! /^addr_status$/
            && ! $tables_hashref_torrus->{$_}
          }
       $dbdef->tables
@@ -7509,6 +7510,20 @@ sub tables_hashref {
                          ],
     },
 
+    'addr_status' => {
+      'columns' => [
+        'addrnum',  'serial',      '', '', '', '',
+        'ip_addr',  'varchar', 'NULL', 40, '', '',
+        '_date',    @date_type,            '', '',
+        'up',       'char',    'NULL',  1, '', '',
+        'delay',    'int',     'NULL', '', '', '',
+      ],
+      'primary_key'   => 'addrnum',
+      'unique'        => [ [ 'ip_addr' ] ],
+      'index'         => [ [ '_date' ] ],
+      'foreign_keys'  => [],
+    },
+
     # name type nullability length default local
 
     #'new_table' => {
diff --git a/FS/FS/addr_status.pm b/FS/FS/addr_status.pm
new file mode 100644 (file)
index 0000000..7928d3a
--- /dev/null
@@ -0,0 +1,103 @@
+package FS::addr_status;
+use base qw( FS::Record );
+
+use strict;
+
+=head1 NAME
+
+FS::addr_status;
+
+=head1 SYNOPSIS
+
+  use FS::addr_status;
+
+  $record = new FS::addr_status \%hash;
+  $record = new FS::addr_status { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::addr_status object represents the last known status (up or down, and
+the latency) of an IP address monitored by freeside-pingd.  FS::addr_status
+inherits from FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item addrnum - primary key
+
+=item ip_addr - the IP address (unique)
+
+=item _date - the time the address was last scanned
+
+=item up - 'Y' if the address responded to a ping
+
+=item delay - the latency, in milliseconds
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new status record.  To add the record to the database, see
+L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'addr_status'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+=item replace OLD_RECORD
+
+=item check
+
+Checks all fields to make sure this is a valid status record.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('addrnum')
+    || $self->ut_ip('ip_addr')
+    || $self->ut_number('_date')
+    || $self->ut_flag('up')
+    || $self->ut_numbern('delay')
+  ;
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<FS::Record>
+
+=cut
+
+1;
+
index 8b2b5f1..c89245f 100644 (file)
@@ -222,4 +222,41 @@ sub replace_check {
   ref($err_or_ref) ? '' : $err_or_ref;
 }
 
+=item addr_status
+
+Returns the ping status record for this service's address, if there
+is one.
+
+=cut
+
+sub addr_status {
+  my $self = shift;
+  my $addr = $self->ip_addr or return;
+  qsearchs('addr_status', { 'ip_addr'  => $addr });
+}
+
+=item addr_status_color
+
+Returns the CSS color for the ping status of this service.
+
+=cut
+
+# subject to change; should also show high/low latency (yellow?) and
+# staleness of data (probably means the daemon is not running) and packet
+# loss (once we measure that)
+
+sub addr_status_color {
+  my $self = shift;
+  if ( my $addr_status = $self->addr_status ) {
+    if ( $addr_status->up ) {
+      return 'green';
+    } else {
+      return 'red';
+    }
+  } else {
+    return 'gray';
+  }
+}
+  
+
 1;
diff --git a/FS/bin/freeside-pingd b/FS/bin/freeside-pingd
new file mode 100644 (file)
index 0000000..9141e5f
--- /dev/null
@@ -0,0 +1,113 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::Daemon ':all';
+use FS::Misc::Getopt;
+use FS::UID qw(dbh adminsuidsetup);
+use FS::Record qw( dbh qsearch qsearchs );
+use FS::addr_status;
+use Net::Ping;
+
+my @TARGETS = (
+  'tower_sector',
+  'svc_broadband',
+  # could add others here
+);
+
+my $interval = 300; # seconds
+my $timeout  = 5.0; # seconds
+
+# useful opts: scan interval, timeout, verbose, max forks
+# maybe useful opts: interface, protocol, packet size, no-fork
+
+our %opt;
+getopts('vxi:');
+
+if (!$opt{x}) {
+  daemonize1('freeside-pingd');
+  drop_root();
+  daemonize2();
+}
+
+if ($opt{i}) {
+  $interval = $opt{i};
+}
+
+adminsuidsetup($opt{user});
+$FS::UID::AutoCommit = 1;
+
+while(1) {
+  daemon_reconnect();
+  my @addrs_to_scan;
+  foreach my $table (@TARGETS) {
+    # find addresses that need to be scanned (haven't been yet, or are
+    # expired)
+    my $expired = time - $interval;
+    debug("checking addresses from $table");
+
+    my $statement = "SELECT ip_addr FROM $table
+      LEFT JOIN addr_status USING (ip_addr)
+      WHERE $table.ip_addr IS NOT NULL
+        AND (addr_status.ip_addr IS NULL OR addr_status._date <= ?)
+      ORDER BY COALESCE(addr_status._date, 0)";
+    my $addrs = dbh->selectcol_arrayref($statement, {}, $expired);
+    die dbh->errstr if !defined $addrs;
+    debug("found ".scalar(@$addrs));
+    push @addrs_to_scan, @$addrs;
+  }
+
+  # fork to handle this since we're going to spend most of our time
+  # waiting for remote machines to respond
+  foreach my $addr (@addrs_to_scan) {
+    daemon_fork( \&scan, $addr );
+  }
+
+  debug("waiting for scan to complete");
+  # wait until finished
+  daemon_wait();
+
+  # sleep until there's more work to do:
+  # the oldest record that still has an expire time in the future
+  # (as opposed to records for dead addresses, which will not be rescanned)
+  my $next_expire = FS::Record->scalar_sql(
+    'SELECT MIN(_date) FROM addr_status WHERE _date + ? > ?',
+    $interval, time
+  ) || time;
+  my $delay = $next_expire + $interval - time;
+  # but at least scan every $interval seconds, to pick up new addresses
+  $delay = $interval if $delay > $interval;
+
+  if ( $delay > 0 ) {
+    debug("it is now ".time."; sleeping for $delay");
+    sleep($delay);
+  } else {
+    debug("it is now ".time."; continuing");
+  }
+
+} # main loop
+
+sub scan {
+  # currently just sends a single ping; it might be more useful to send
+  # several of them and estimate packet loss.
+
+  my $addr = shift;
+  my $addr_status = qsearchs('addr_status', { 'ip_addr' => $addr })
+                    || FS::addr_status->new({ 'ip_addr' => $addr });
+
+  $addr_status->select_for_update if $addr_status->addrnum;
+  my $ping = Net::Ping->new;
+  $ping->hires;
+  debug "pinging $addr";
+  my ($result, $latency) = $ping->ping($addr, $timeout);
+  debug "status $result, delay $latency";
+  $addr_status->set('up', $result ? 'Y' : '');
+  $addr_status->set('delay', int($latency * 1000));
+  $addr_status->set('_date', time);
+  my $error = $addr_status->addrnum ?
+                $addr_status->replace :
+                $addr_status->insert;
+  if ( $error ) {
+    die "ERROR: could not update status for $addr\n$error\n";
+  }
+}
+
diff --git a/FS/t/addr_status.t b/FS/t/addr_status.t
new file mode 100644 (file)
index 0000000..ece424b
--- /dev/null
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::addr_status;
+$loaded=1;
+print "ok 1\n";
index 8a24466..c6eef91 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -217,6 +217,7 @@ perl-modules:
        perl -p -i -e "\
          s|%%%FREESIDE_CONF%%%|${FREESIDE_CONF}|g;\
          s|%%%FREESIDE_CACHE%%%|${FREESIDE_CACHE}|g;\
+         s|%%%FREESIDE_LOG%%%|${FREESIDE_LOG}|g;\
          s'%%%FREESIDE_DOCUMENT_ROOT%%%'${FREESIDE_DOCUMENT_ROOT}'g; \
          s'%%%RT_ENABLED%%%'${RT_ENABLED}'g; \
          s'%%%RT_PATH%%%'${RT_PATH}'g; \
index b7d135d..422e6df 100644 (file)
@@ -117,8 +117,24 @@ function initMap() {
       // then pop up an info box with the feature content
       info.close();
       info.setPosition(feature.getGeometry().get());
-      info.setContent(feature.getProperty('content'));
-      info.open(map);
+
+      if ( feature.getProperty('content') ) {
+        info.setContent(feature.getProperty('content'));
+      } else {
+        info.setContent('');
+      }
+
+      if ( feature.getProperty('url') ) {
+        $.ajax({
+          url: feature.getProperty('url'),
+          success: function(data) {
+            info.setContent(data);
+          }
+        });
+        info.open(map);
+      } else {
+        info.open(map);
+      }
     }
 
     // snap to feature ROI if it has one
index fe3c095..41f4b8d 100755 (executable)
@@ -49,15 +49,24 @@ foreach my $svc_broadband (@rows) {
   push @coord, $svc_broadband->altitude + 0
     if length($svc_broadband->altitude); # it's optional
 
+  my $svcnum = $svc_broadband->svcnum;
+  my $color = $svc_broadband->addr_status_color;
+
   push @features,
   {
-    id        => 'svc_broadband/'.$svc_broadband->svcnum,
+    id        => 'svc_broadband/'.$svcnum,
     geometry  => {
       type        => 'Point',
       coordinates => \@coord,
     },
     properties => {
-      content => include('.svc_broadband', $svc_broadband),
+      #content => include('.svc_broadband', $svc_broadband),
+      url   => $fsurl . 'view/svc_broadband-popup.html?' . $svcnum,
+      style => {
+        icon => {
+          fillColor => $color,
+        },
+      },
     },
   };
   # look up tower location and draw connecting line
@@ -85,8 +94,8 @@ foreach my $svc_broadband (@rows) {
       },
       properties  => {
         style       => {
-          strokeColor  => ($tower->color || 'green'),
-          strokeWeight => 2,
+          strokeColor  => $color,
+          strokeWeight => 1,
         },
       },
     };
@@ -135,7 +144,7 @@ foreach my $tower (values(%towers)) {
       style     => {
         icon => {
           path        => undef,
-          url         => $fsurl.'images/jcartier-antenna-square-21x51.png',
+          url         => $fsurl.'images/antenna-square-21x51.png',
           anchor      => { x => 10, y => 4 }
         },
       },
@@ -159,22 +168,6 @@ foreach my $sector (values %sectors) {
 };
 
 </%init>
-<%def .svc_broadband>
-% my $svc = shift;
-% my @label = $svc->cust_svc->label;
-<H3>
-  <a target="_blank" href="<% $fsurl %>view/svc_broadband.cgi?<% $svc->svcnum %>">
-    <% $label[0] |h %> #<% $svc->svcnum %> | <% $label[1] %>
-  </a>
-</H3>
-% my $cust_main = $svc->cust_main;
-<a target="_blank" href="<% $fsurl %>view/cust_main.cgi?<% $cust_main->custnum %>">
-<& /elements/small_custview.html, {
-  cust_main => $svc->cust_main,
-  #url => $fsurl.'view/cust_main.cgi',
-} &>
-</a>
-</%def>
 <%def .tower>
 % my $tower = shift;
 % my $can_edit = $FS::CurrentUser::CurrentUser->access_right('Configuration');
diff --git a/httemplate/view/svc_broadband-popup.html b/httemplate/view/svc_broadband-popup.html
new file mode 100644 (file)
index 0000000..1c23474
--- /dev/null
@@ -0,0 +1,35 @@
+<%init>
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('View customer services');
+
+my ($svcnum) = $cgi->keywords;
+# cleans svcnum, checks agent access, etc.
+my $svc = qsearchs( FS::svc_broadband->search({ 'svcnum' => $svcnum }) );
+my $addr_status = $svc->addr_status;
+my @label = $svc->cust_svc->label;
+</%init>
+
+<H3>
+  <a target="_blank" href="<% $fsurl %>view/svc_broadband.cgi?<% $svc->svcnum %>">
+    <% $label[0] |h %> #<% $svc->svcnum %> | <% $label[1] %>
+  </a>
+</H3>
+% if ( $addr_status ) {
+<P>
+  <SPAN STYLE="font-weight: bold; color: <% $svc->addr_status_color %>">
+    <% emt( $addr_status->up ? 'UP' : 'DOWN' ) %>
+  </SPAN>
+%   if ( $addr_status->up ) {
+    (<% $addr_status->delay |h %> ms)
+%   }
+  <% emt('as of') . ' ' . time2str('%b %o %H:%M', $addr_status->_date) %>
+</P>
+% }
+% my $cust_main = $svc->cust_main;
+<a target="_blank" href="<% $fsurl %>view/cust_main.cgi?<% $cust_main->custnum %>">
+<& /elements/small_custview.html, {
+  cust_main => $svc->cust_main,
+  #url => $fsurl.'view/cust_main.cgi',
+} &>
+</a>
+