5 use FS::UID qw(dbh adminsuidsetup);
6 use FS::Record qw( dbh qsearch qsearchs );
15 # could add others here
18 my $timeout = 5.0; # seconds
20 # useful opts: scan interval, timeout, verbose, max forks
21 # maybe useful opts: interface, protocol, packet size, no-fork
26 getopts('vxi:', \%opt);
27 my $user = shift or die usage();
30 daemonize1('freeside-pingd');
40 warn(@_, "\n") if $opt{v};
43 adminsuidsetup($user);
44 $FS::UID::AutoCommit = 1;
47 my $conf = FS::Conf->new;
48 $interval = $conf->config('pingd-interval');
50 debug("no pingd-interval configured; exiting");
58 foreach my $table (@TARGETS) {
59 # find addresses that need to be scanned (haven't been yet, or are
61 my $expired = time - $interval;
62 debug("checking addresses from $table");
64 my $statement = "SELECT ip_addr FROM $table
65 LEFT JOIN addr_status USING (ip_addr)
66 WHERE $table.ip_addr IS NOT NULL
67 AND (addr_status.ip_addr IS NULL OR addr_status._date <= ?)
68 ORDER BY COALESCE(addr_status._date, 0)";
69 my $addrs = dbh->selectcol_arrayref($statement, {}, $expired);
70 die dbh->errstr if !defined $addrs;
71 debug("found ".scalar(@$addrs));
72 push @addrs_to_scan, @$addrs;
75 # fork to handle this since we're going to spend most of our time
76 # waiting for remote machines to respond
77 foreach my $addr (@addrs_to_scan) {
78 daemon_fork( \&scan, $addr );
81 debug("waiting for scan to complete");
85 # sleep until there's more work to do:
86 # the oldest record that still has an expire time in the future
87 # (as opposed to records for dead addresses, which will not be rescanned)
88 my $next_expire = FS::Record->scalar_sql(
89 'SELECT MIN(_date) FROM addr_status WHERE _date + ? > ?',
92 my $delay = $next_expire + $interval - time;
93 # but at least scan every $interval seconds, to pick up new addresses
94 $delay = $interval if $delay > $interval;
97 debug("it is now ".time."; sleeping for $delay");
100 debug("it is now ".time."; continuing");
106 # currently just sends a single ping; it might be more useful to send
107 # several of them and estimate packet loss.
110 my $addr_status = qsearchs('addr_status', { 'ip_addr' => $addr })
111 || FS::addr_status->new({ 'ip_addr' => $addr });
113 $addr_status->select_for_update if $addr_status->addrnum;
114 my $ping = Net::Ping->new;
116 debug "pinging $addr";
117 my ($result, $latency) = $ping->ping($addr, $timeout);
118 debug "status $result, delay $latency";
119 $addr_status->set('up', $result ? 'Y' : '');
120 $addr_status->set('delay', int($latency * 1000));
121 $addr_status->set('_date', time);
122 my $error = $addr_status->addrnum ?
123 $addr_status->replace :
124 $addr_status->insert;
126 die "ERROR: could not update status for $addr\n$error\n";
132 freeside-pingd [ -i INTERVAL ] [ -v ] [ -x ] <username>