FS/bin/freeside-pingd

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use FS::Daemon ':all';
   5 use FS::Misc::Getopt;
   6 use FS::UID qw(dbh adminsuidsetup);
   7 use FS::Record qw( dbh qsearch qsearchs );
   8 use FS::addr_status;
   9 use Net::Ping;
  10
  11 my @TARGETS = (
  12   'tower_sector',
  13   'svc_broadband',
  14   # could add others here
  15 );
  16
  17 my $interval = 300; # seconds
  18 my $timeout  = 5.0; # seconds
  19
  20 # useful opts: scan interval, timeout, verbose, max forks
  21 # maybe useful opts: interface, protocol, packet size, no-fork
  22
  23 our %opt;
  24 getopts('vxi:');
  25
  26 if (!$opt{x}) {
  27   daemonize1('freeside-pingd');
  28   drop_root();
  29   daemonize2();
  30 }
  31
  32 if ($opt{i}) {
  33   $interval = $opt{i};
  34 }
  35
  36 adminsuidsetup($opt{user});
  37 $FS::UID::AutoCommit = 1;
  38
  39 while(1) {
  40   daemon_reconnect();
  41   my @addrs_to_scan;
  42   foreach my $table (@TARGETS) {
  43     # find addresses that need to be scanned (haven't been yet, or are
  44     # expired)
  45     my $expired = time - $interval;
  46     debug("checking addresses from $table");
  47
  48     my $statement = "SELECT ip_addr FROM $table
  49       LEFT JOIN addr_status USING (ip_addr)
  50       WHERE $table.ip_addr IS NOT NULL
  51         AND (addr_status.ip_addr IS NULL OR addr_status._date <= ?)
  52       ORDER BY COALESCE(addr_status._date, 0)";
  53     my $addrs = dbh->selectcol_arrayref($statement, {}, $expired);
  54     die dbh->errstr if !defined $addrs;
  55     debug("found ".scalar(@$addrs));
  56     push @addrs_to_scan, @$addrs;
  57   }
  58
  59   # fork to handle this since we're going to spend most of our time
  60   # waiting for remote machines to respond
  61   foreach my $addr (@addrs_to_scan) {
  62     daemon_fork( \&scan, $addr );
  63   }
  64
  65   debug("waiting for scan to complete");
  66   # wait until finished
  67   daemon_wait();
  68
  69   # sleep until there's more work to do:
  70   # the oldest record that still has an expire time in the future
  71   # (as opposed to records for dead addresses, which will not be rescanned)
  72   my $next_expire = FS::Record->scalar_sql(
  73     'SELECT MIN(_date) FROM addr_status WHERE _date + ? > ?',
  74     $interval, time
  75   ) || time;
  76   my $delay = $next_expire + $interval - time;
  77   # but at least scan every $interval seconds, to pick up new addresses
  78   $delay = $interval if $delay > $interval;
  79
  80   if ( $delay > 0 ) {
  81     debug("it is now ".time."; sleeping for $delay");
  82     sleep($delay);
  83   } else {
  84     debug("it is now ".time."; continuing");
  85   }
  86
  87 } # main loop
  88
  89 sub scan {
  90   # currently just sends a single ping; it might be more useful to send
  91   # several of them and estimate packet loss.
  92
  93   my $addr = shift;
  94   my $addr_status = qsearchs('addr_status', { 'ip_addr' => $addr })
  95                     || FS::addr_status->new({ 'ip_addr' => $addr });
  96
  97   $addr_status->select_for_update if $addr_status->addrnum;
  98   my $ping = Net::Ping->new;
  99   $ping->hires;
 100   debug "pinging $addr";
 101   my ($result, $latency) = $ping->ping($addr, $timeout);
 102   debug "status $result, delay $latency";
 103   $addr_status->set('up', $result ? 'Y' : '');
 104   $addr_status->set('delay', int($latency * 1000));
 105   $addr_status->set('_date', time);
 106   my $error = $addr_status->addrnum ?
 107                 $addr_status->replace :
 108                 $addr_status->insert;
 109   if ( $error ) {
 110     die "ERROR: could not update status for $addr\n$error\n";
 111   }
 112 }
 113