13 files changed, 664 insertions, 12 deletions

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index ef2a938..f4f7d26 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -3073,6 +3073,23 @@ and customer address. Include units.',
   },
 
   {
+    'key'         => 'pingd-interval',
+    'section'     => 'network_monitoring',
+    'description' => 'Run ping scans of broadband services at this interval.',
+    'type'        => 'select',
+    'select_hash' => [ ''     => '',
+                       60     => '1 min',
+                       300    => '5 min',
+                       600    => '10 min',
+                       1800   => '30 min',
+                       3600   => '1 hour',
+                       14400  => '4 hours',
+                       28800  => '8 hours',
+                       86400  => '1 day',
+                     ],
+  },
+
+  {
     'key'         => 'ticket_system-default_queueid',
     'section'     => 'ticketing',
     'description' => 'Default queue used when creating new customer tickets.',
diff --git a/FS/FS/Daemon.pm b/FS/FS/Daemon.pm
index b58cde4..4ecd80e 100644
--- a/FS/FS/Daemon.pm
+++ b/FS/FS/Daemon.pm
@@ -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;
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index ee87b2d..041b76c 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -416,6 +416,7 @@ if ( -e $addl_handler_use_file ) {
   use FS::commission_schedule;
   use FS::commission_rate;
   use FS::saved_search;
+  use FS::sector_coverage;
   # Sammath Naur
 
   if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index f66cb36..66b9a51 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -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
@@ -4885,7 +4886,8 @@ sub tables_hashref {
         'sector_range', 'decimal', 'NULL',      '', '', '',  #?
         'downtilt',     'decimal', 'NULL',      '', '', '',
         'v_width',          'int', 'NULL',      '', '', '',
-        'margin',       'decimal', 'NULL',     '', '', '',
+        'db_high',          'int', 'NULL',     '', '', '',
+        'db_low',           'int', 'NULL',     '', '', '',
         'image',           'blob', 'NULL',     '', '', '',
         'west',         'decimal', 'NULL', '10,7', '', '',
         'east',         'decimal', 'NULL', '10,7', '', '',
@@ -4902,6 +4904,23 @@ sub tables_hashref {
                         ],
     },
 
+    'sector_coverage' => {
+      'columns' => [
+        'coveragenum', 'serial', '', '', '', '',
+        'sectornum',     'int', '', '', '', '',
+        'db_loss',       'int', '', '', '', '',
+        'geometry',     'text', 'NULL', '', '', '',
+      ],
+      'primary_key' => 'coveragenum',
+      'unique' => [],
+      'index'  => [],
+      'foreign_keys' => [
+                          { columns => [ 'sectornum' ],
+                            table   => 'tower_sector'
+                          },
+                        ],
+    },
+
     'part_virtual_field' => {
       'columns' => [
         'vfieldpart', 'serial', '', '', '', '', 
@@ -7509,6 +7528,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
index 0000000..7928d3a
--- /dev/null
+++ b/FS/FS/addr_status.pm
@@ -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;
+
diff --git a/FS/FS/sector_coverage.pm b/FS/FS/sector_coverage.pm
new file mode 100644
index 0000000..fa6a9e1
--- /dev/null
+++ b/FS/FS/sector_coverage.pm
@@ -0,0 +1,133 @@
+package FS::sector_coverage;
+use base qw( FS::Record );
+
+use strict;
+use FS::Record qw( qsearch qsearchs );
+use Cpanel::JSON::XS;
+
+=head1 NAME
+
+FS::sector_coverage - Object methods for sector_coverage records
+
+=head1 SYNOPSIS
+
+  use FS::sector_coverage;
+
+  $record = new FS::sector_coverage \%hash;
+  $record = new FS::sector_coverage { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::sector_coverage object represents a coverage map for a sector at
+a specific signal strength level.  FS::sector_coverage inherits from
+FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item coveragenum
+
+primary key
+
+=item sectornum
+
+L<FS::tower_sector> foreign key
+
+=item db_loss
+
+The maximum path loss shown on this map, in dB.
+
+=item geometry
+
+A GeoJSON Geometry object for the area covered at this level.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new map.  To add the example 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 { 'sector_coverage'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database.
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('coveragenum')
+    || $self->ut_number('sectornum')
+    || $self->ut_number('db_loss')
+  ;
+  return $error if $error;
+
+  if ( length($self->geometry) ) {
+    # make sure it parses at least
+    local $@;
+    my $data = eval { decode_json($self->geometry) };
+    if ( $@ ) {
+      # limit the length, in case it decides to return a large chunk of data
+      return "Error parsing coverage geometry: ".substr($@, 0, 100);
+    }
+  }
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>
+
+=cut
+
+1;
+
diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm
index 8b2b5f1..c89245f 100644
--- a/FS/FS/svc_IP_Mixin.pm
+++ b/FS/FS/svc_IP_Mixin.pm
@@ -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/FS/tower.pm b/FS/FS/tower.pm
index f371ec9..18b43fe 100644
--- a/FS/FS/tower.pm
+++ b/FS/FS/tower.pm
@@ -75,6 +75,27 @@ Delete this record from the database.
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
+=cut
+
+sub replace {
+  my $self = shift;
+  my $old = shift || $self->replace_old;
+  # editing the tower location needs to regenerate coverage on its sectors
+  my $regen_coverage = 0;
+  foreach (qw(latitude longitude height)) {
+    $regen_coverage = 1 if $self->get($_) != $old->get($_);
+  }
+
+  my $error = $self->SUPER::replace($old);
+  return $error if $error;
+
+  if ($regen_coverage) {
+    foreach my $sector ($self->tower_sector) {
+      $sector->queue_generate_coverage;
+    }
+  }
+}
+
 =item check
 
 Checks all fields to make sure this is a valid tower.  If there is
@@ -143,7 +164,7 @@ default sector.
 sub process_o2m {
   my $self = shift;
   my %opt = @_;
-  my $params = $opt{params};
+  my $params = +{ %{$opt{params}} };
 
   # Adjust to make sure our default sector is in the list.
   my $default_sector = $self->default_sector
diff --git a/FS/FS/tower_sector.pm b/FS/FS/tower_sector.pm
index 3fadc86..08e8cc0 100644
--- a/FS/FS/tower_sector.pm
+++ b/FS/FS/tower_sector.pm
@@ -4,6 +4,7 @@ use base qw( FS::Record );
 use Class::Load qw(load_class);
 use File::Path qw(make_path);
 use Data::Dumper;
+use Cpanel::JSON::XS;
 
 use strict;
 
@@ -75,10 +76,13 @@ The antenna beam elevation in degrees below horizontal.
 
 The -3dB vertical beamwidth in degrees.
 
-=item margin
+=item db_high
 
-The signal loss margin allowed on the sector, in dB. This is normally
-transmitter EIRP minus receiver sensitivity.
+The signal loss margin to treat as "high quality".
+
+=item db_low
+
+The signal loss margin to treat as "low quality".
 
 =item image 
 
@@ -110,6 +114,38 @@ sub table { 'tower_sector'; }
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
+=cut
+
+sub insert {
+  my $self = shift;
+  my $error = $self->SUPER::insert;
+  return $error if $error;
+
+  if (scalar($self->need_fields_for_coverage) == 0) {
+    $self->queue_generate_coverage;
+  }
+}
+
+sub replace {
+  my $self = shift;
+  my $old = shift || $self->replace_old;
+  my $regen_coverage = 0;
+  if ( !$self->get('no_regen') ) {
+    foreach (qw(height freq_mhz direction width downtilt
+                v_width db_high db_low))
+    {
+      $regen_coverage = 1 if ($self->get($_) ne $old->get($_));
+    }
+  }
+
+  my $error = $self->SUPER::replace($old);
+  return $error if $error;
+
+  if ($regen_coverage) {
+    $self->queue_generate_coverage;
+  }
+}
+
 =item delete
 
 Delete this record from the database.
@@ -149,7 +185,8 @@ sub check {
     || $self->ut_numbern('v_width')
     || $self->ut_numbern('downtilt')
     || $self->ut_floatn('sector_range')
-    || $self->ut_numbern('margin')
+    || $self->ut_numbern('db_high')
+    || $self->ut_numbern('db_low')
     || $self->ut_anything('image')
     || $self->ut_sfloatn('west')
     || $self->ut_sfloatn('east')
@@ -201,7 +238,7 @@ sub need_fields_for_coverage {
     downtilt  => 'Downtilt',
     width     => 'Horiz. width',
     v_width   => 'Vert. width',
-    margin    => 'Signal margin',
+    db_high   => 'High quality',
     latitude  => 'Latitude',
     longitude => 'Longitude',
   );
@@ -222,6 +259,9 @@ Starts a job to recalculate the coverage map.
 
 sub queue_generate_coverage {
   my $self = shift;
+  my $need_fields = join(',', $self->need_fields_for_coverage);
+  return "Sector needs fields $need_fields" if $need_fields;
+  $self->set('no_regen', 1); # avoid recursion
   if ( length($self->image) > 0 ) {
     foreach (qw(image west south east north)) {
       $self->set($_, '');
@@ -258,9 +298,11 @@ sub process_generate_coverage {
   my $sectornum = $param->{sectornum};
   my $sector = FS::tower_sector->by_key($sectornum)
     or die "sector $sectornum does not exist";
+  $sector->set('no_regen', 1); # avoid recursion
   my $tower = $sector->tower;
 
   load_class('Map::Splat');
+
   # since this is still experimental, put it somewhere we can find later
   my $workdir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/" .
                 "generate_coverage/sector$sectornum-". time;
@@ -274,9 +316,9 @@ sub process_generate_coverage {
     h_width     => $sector->width,
     tilt        => $sector->downtilt,
     v_width     => $sector->v_width,
-    max_loss    => $sector->margin,
-    min_loss    => $sector->margin - 80,
+    db_levels   => [ $sector->db_low, $sector->db_high ],
     dir         => $workdir,
+    #simplify    => 0.0004, # remove stairstepping in SRTM3 data?
   );
   $splat->calculate;
 
@@ -284,11 +326,30 @@ sub process_generate_coverage {
   foreach (qw(west east south north)) {
     $sector->set($_, $box->{$_});
   }
-  $sector->set('image', $splat->mask);
-  # mask returns a PNG where everything below max_loss is solid colored,
-  # and everything above it is transparent. More useful for our purposes.
+  $sector->set('image', $splat->png);
   my $error = $sector->replace;
   die $error if $error;
+
+  foreach ($sector->sector_coverage) {
+    $error = $_->delete;
+    die $error if $error;
+  }
+  # XXX undecided whether Map::Splat should even do this operation
+  # or how to store it
+  # or anything else
+  $DB::single = 1;
+  my $data = decode_json( $splat->polygonize_json );
+  for my $feature (@{ $data->{features} }) {
+    my $db = $feature->{properties}{level};
+    my $coverage = FS::sector_coverage->new({
+      sectornum => $sectornum,
+      db_loss   => $db,
+      geometry  => encode_json($feature->{geometry})
+    });
+    $error = $coverage->insert;
+  }
+
+  die $error if $error;
 }
 
 =head1 BUGS
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 73a740f..10dda59 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -876,3 +876,5 @@ FS/commission_rate.pm
 t/commission_rate.t
 FS/saved_search.pm
 t/saved_search.t
+FS/sector_coverage.pm
+t/sector_coverage.t
diff --git a/FS/bin/freeside-pingd b/FS/bin/freeside-pingd
new file mode 100644
index 0000000..fc9f8a3
--- /dev/null
+++ b/FS/bin/freeside-pingd
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::Daemon ':all';
+use FS::UID qw(dbh adminsuidsetup);
+use FS::Record qw( dbh qsearch qsearchs );
+use FS::addr_status;
+use FS::Conf;
+use Getopt::Std;
+use Net::Ping;
+
+my @TARGETS = (
+  'tower_sector',
+  'svc_broadband',
+  # could add others here
+);
+
+my $timeout  = 5.0; # seconds
+
+# useful opts: scan interval, timeout, verbose, max forks
+# maybe useful opts: interface, protocol, packet size, no-fork
+
+my $interval;
+
+our %opt;
+getopts('vxi:', \%opt);
+my $user = shift or die usage();
+
+if (!$opt{x}) {
+  daemonize1('freeside-pingd');
+  drop_root();
+  daemonize2();
+}
+
+if ($opt{i}) {
+  $interval = $opt{i};
+}
+
+sub debug {
+  warn(@_, "\n") if $opt{v};
+}
+
+adminsuidsetup($user);
+$FS::UID::AutoCommit = 1;
+
+if ( !$interval ) {
+  my $conf = FS::Conf->new;
+  $interval = $conf->config('pingd-interval');
+  if ( !$interval ) {
+    debug("no pingd-interval configured; exiting");
+    exit(0);
+  }
+}
+
+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";
+  }
+}
+
+sub usage {
+  "Usage:
+  freeside-pingd [ -i INTERVAL ] [ -v ] [ -x ] <username>
+";
+}
+
diff --git a/FS/t/addr_status.t b/FS/t/addr_status.t
new file mode 100644
index 0000000..ece424b
--- /dev/null
+++ b/FS/t/addr_status.t
@@ -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";
diff --git a/FS/t/sector_coverage.t b/FS/t/sector_coverage.t
new file mode 100644
index 0000000..b304158
--- /dev/null
+++ b/FS/t/sector_coverage.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::sector_coverage;
+$loaded=1;
+print "ok 1\n";