454 lines
12 KiB
Perl
Executable File
454 lines
12 KiB
Perl
Executable File
#!/local/bin/perl --*-perl-*-
|
|
;#
|
|
;# ntptrap,v 3.1 1993/07/06 01:09:15 jbj Exp
|
|
;#
|
|
;# a client for the xntp mode 6 trap mechanism
|
|
;#
|
|
;# Copyright (c) 1992
|
|
;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
|
|
;#
|
|
;#
|
|
;#############################################################
|
|
$0 =~ s!^.*/([^/]+)$!\1!; # strip to filename
|
|
;# enforce STDOUT and STDERR to be line buffered
|
|
$| = 1;
|
|
select((select(STDERR),$|=1)[$[]);
|
|
|
|
;#######################################
|
|
;# load utility routines and definitions
|
|
;#
|
|
require('ntp.pl'); # implementation of the NTP protocol
|
|
eval { require('sys/socket.ph'); require('netinet/in.ph') unless defined(&INADDR_ANY); } ||
|
|
do {
|
|
die("$0: $@") unless $[ == index($@, "Can't locate ");
|
|
warn "$0: $@";
|
|
warn "$0: supplying some default definitions\n";
|
|
eval 'sub INADDR_ANY { 0; } sub AF_INET {2;} sub SOCK_DGRAM {2;} 1;' || die "$0: $@";
|
|
};
|
|
require('getopts.pl'); # option parsing
|
|
require('ctime.pl'); # date/time formatting
|
|
|
|
;######################################
|
|
;# define some global constants
|
|
;#
|
|
$BASE_TIMEOUT=10;
|
|
$FRAG_TIMEOUT=10;
|
|
$MAX_TRY = 5;
|
|
$REFRESH_TIME=60*15; # 15 minutes (server uses 1 hour)
|
|
$ntp'timeout = $FRAG_TIMEOUT; #';
|
|
|
|
;######################################
|
|
;# now process options
|
|
;#
|
|
sub usage
|
|
{
|
|
die("usage: $0 [-n] [-p <port>] [-l <logfile>] [host] ...\n");
|
|
}
|
|
|
|
$opt_l = "/dev/null"; # where to write debug messages to
|
|
$opt_p = 0; # port to use locally - (0 does mean: will be choosen by kernel)
|
|
|
|
&usage unless &Getopts('l:p:');
|
|
&Getopts if 0; # make -w happy
|
|
|
|
@Hosts = ($#ARGV < $[) ? ("localhost") : @ARGV;
|
|
|
|
;# setup for debug output
|
|
$DEBUGFILE=$opt_l;
|
|
$DEBUGFILE="&STDERR" if $DEBUGFILE eq '-';
|
|
|
|
open(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n");
|
|
select((select(DEBUG),$|=1)[$[]);
|
|
|
|
;# &log prints a single trap record (adding a (local) time stamp)
|
|
sub log
|
|
{
|
|
chop($date=&ctime(time));
|
|
print "$date ",@_,"\n";
|
|
}
|
|
|
|
sub debug
|
|
{
|
|
print DEBUG @_,"\n";
|
|
}
|
|
;#
|
|
$proto_udp = (getprotobyname('udp'))[$[+2] ||
|
|
(warn("$0: Could not get protocoll number for 'udp' using 17"), 17);
|
|
|
|
$ntp_port = (getservbyname('ntp','udp'))[$[+2] ||
|
|
(warn("$0: Could not get port number for service ntp/udp using 123"), 123);
|
|
|
|
;#
|
|
socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n");
|
|
|
|
;#
|
|
bind(S, pack("S n N x8", &AF_INET, $opt_p, &INADDR_ANY)) ||
|
|
die("Cannot bind: $!\n");
|
|
|
|
($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
|
|
&log(sprintf("Listening at address %d.%d.%d.%d port %d",
|
|
unpack("C4",$my_addr), $my_port));
|
|
|
|
;# disregister with all servers in case of termination
|
|
sub cleanup
|
|
{
|
|
&log("Aborted by signal \"$_[$[]\"") if defined($_[$[]);
|
|
|
|
foreach (@Hosts)
|
|
{
|
|
&ntp'send(S,31,0,"",pack("Sna4x8",&AF_INET,$ntp_port,$Hosts{$_})); #';
|
|
}
|
|
close(S);
|
|
exit(2);
|
|
}
|
|
|
|
$SIG{'HUP'} = 'cleanup';
|
|
$SIG{'INT'} = 'cleanup';
|
|
$SIG{'QUIT'} = 'cleanup';
|
|
$SIG{'TERM'} = 'cleanup';
|
|
|
|
0 && $a && $b;
|
|
sub timeouts # sort timeout id array
|
|
{
|
|
$TIMEOUTS{$a} <=> $TIMEOUTS{$b};
|
|
}
|
|
|
|
;# a Request element looks like: pack("a4SC",addr,associd,op)
|
|
@Requests= ();
|
|
|
|
;# compute requests for set trap control msgs to each host given
|
|
{
|
|
local($name,$addr);
|
|
|
|
foreach (@Hosts)
|
|
{
|
|
if (/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
|
|
{
|
|
($name,$addr) =
|
|
(gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[,$[+4];
|
|
unless (defined($name))
|
|
{
|
|
$name = sprintf("[[%d.%d.%d.%d]]",$1,$2,$3,$4);
|
|
$addr = pack("C4",$1,$2,$3,$4);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
($name,$addr) = (gethostbyname($_))[$[,$[+4];
|
|
unless (defined($name))
|
|
{
|
|
warn "$0: unknown host \"$_\" - ignored\n";
|
|
next;
|
|
}
|
|
}
|
|
next if defined($Host{$name});
|
|
$Host{$name} = $addr;
|
|
push(@Requests,pack("a4SC",$addr,0,6)); # schedule a set trap request for $name
|
|
}
|
|
}
|
|
|
|
sub hostname
|
|
{
|
|
local($addr) = @_;
|
|
return $HostName{$addr} if defined($HostName{$addr});
|
|
local($name) = gethostbyaddr($addr,&AF_INET);
|
|
&debug(sprintf("hostname(%d.%d.%d.%d) = \"%s\"",unpack("C4",$addr),$name))
|
|
if defined($name);
|
|
defined($name) && ($HostName{$addr} = $name) && (return $name);
|
|
&debug(sprintf("Failed to get name for %d.%d.%d.%d",unpack("C4",$addr)));
|
|
return sprintf("[%d.%d.%d.%d]",unpack("C4",$addr));
|
|
}
|
|
|
|
;# when no hosts were given on the commandline no requests have been scheduled
|
|
&usage unless (@Requests);
|
|
|
|
&debug(sprintf("%d request(s) scheduled",scalar(@Requests)));
|
|
grep(&debug(" - ".$_),keys(%Host));
|
|
|
|
;# allocate variables;
|
|
$addr="";
|
|
$assoc=0;
|
|
$op = 0;
|
|
$timeout = 0;
|
|
$ret="";
|
|
%TIMEOUTS = ();
|
|
%TIMEOUT_PROCS = ();
|
|
@TIMEOUTS = ();
|
|
|
|
$len = 512;
|
|
$buf = " " x $len;
|
|
|
|
while (1)
|
|
{
|
|
if (@Requests || @TIMEOUTS) # if there is some work pending
|
|
{
|
|
if (@Requests)
|
|
{
|
|
($addr,$assoc,$op) = unpack("a4SC",($req = shift(@Requests)));
|
|
&debug(sprintf("Request: %s: %s(%d)",&hostname($addr), &ntp'cntrlop_name($op), $assoc)); #';))
|
|
$ret = &ntp'send(S,$op,$assoc,"", #'(
|
|
pack("Sna4x8",&AF_INET,$ntp_port,$addr));
|
|
&set_timeout("retry-".unpack("H*",$req),time+$BASE_TIMEOUT,
|
|
sprintf("&retry(\"%s\");",unpack("H*",$req)));
|
|
|
|
last unless (defined($ret)); # warn called by ntp'send();
|
|
|
|
;# if there are more requests just have a quick look for new messages
|
|
;# otherwise grant server time for a response
|
|
$timeout = @Requests ? 0 : $BASE_TIMEOUT;
|
|
}
|
|
if ($timeout && @TIMEOUTS)
|
|
{
|
|
;# ensure not to miss a timeout
|
|
if ($timeout + time > $TIMEOUTS{$TIMEOUTS[$[]})
|
|
{
|
|
$timeout = $TIMEOUTS{$TIMEOUTS[$[]} - time;
|
|
$timeout = 0 if $timeout < 0;
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
;# no work yet - wait for some messages dropping in
|
|
;# usually this will not hapen as the refresh semantic will
|
|
;# always have a pending timeout
|
|
undef($timeout);
|
|
}
|
|
|
|
vec($mask="",fileno(S),1) = 1;
|
|
$ret = select($mask,undef,undef,$timeout);
|
|
|
|
warn("$0: select: $!\n"),last if $ret < 0; # give up on error return from select
|
|
|
|
if ($ret == 0)
|
|
{
|
|
;# timeout
|
|
if (@TIMEOUTS && time > $TIMEOUTS{$TIMEOUTS[$[]})
|
|
{
|
|
;# handle timeout
|
|
$timeout_proc =
|
|
(delete $TIMEOUT_PROCS{$TIMEOUTS[$[]},
|
|
delete $TIMEOUTS{shift(@TIMEOUTS)})[$[];
|
|
eval $timeout_proc;
|
|
die "timeout eval (\"$timeout_proc\"): $@\n" if $@;
|
|
}
|
|
;# else: there may be something to be sent
|
|
}
|
|
else
|
|
{
|
|
;# data avail
|
|
$from = recv(S,$buf,$len,0);
|
|
;# give up on error return from recv
|
|
warn("$0: recv: $!\n"), last unless (defined($from));
|
|
|
|
$from = (unpack("Sna4",$from))[$[+2]; # keep host addr only
|
|
;# could check for ntp_port - but who cares
|
|
&debug("-Packet from ",&hostname($from));
|
|
|
|
;# stuff packet into ntp mode 6 receive machinery
|
|
($ret,$data,$status,$associd,$op,$seq,$auth_keyid) =
|
|
&ntp'handle_packet($buf,$from); # ';
|
|
&debug(sprintf("%s uses auth_keyid %d",&hostname($from),$auth_keyid)) if defined($auth_keyid);
|
|
next unless defined($ret);
|
|
|
|
if ($ret eq "")
|
|
{
|
|
;# handle packet
|
|
;# simple trap response messages have neither timeout nor retries
|
|
&clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))) unless $op == 7;
|
|
delete $RETRY{pack("a4SC",$from,$associd,$op)} unless $op == 7;
|
|
|
|
&process_response($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid);
|
|
}
|
|
else
|
|
{
|
|
;# some kind of error
|
|
&log(sprintf("%50s: %s: %s",(gethostbyaddr($from,&AF_INET))[$[],$ret,$data));
|
|
if ($ret ne "TIMEOUT" && $ret ne "ERROR")
|
|
{
|
|
&clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op)));
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
warn("$0: terminating\n");
|
|
&cleanup;
|
|
exit 0;
|
|
|
|
;##################################################
|
|
;# timeout support
|
|
;#
|
|
sub set_timeout
|
|
{
|
|
local($id,$time,$proc) = @_;
|
|
|
|
$TIMEOUTS{$id} = $time;
|
|
$TIMEOUT_PROCS{$id} = $proc;
|
|
@TIMEOUTS = sort timeouts keys(%TIMEOUTS);
|
|
chop($date=&ctime($time));
|
|
&debug(sprintf("Schedule timeout \"%s\" for %s", $id, $date));
|
|
}
|
|
|
|
sub clear_timeout
|
|
{
|
|
local($id) = @_;
|
|
delete $TIMEOUTS{$id};
|
|
delete $TIMEOUT_PROCS{$id};
|
|
@TIMEOUTS = sort timeouts keys(%TIMEOUTS);
|
|
&debug("Clear timeout \"$id\"");
|
|
}
|
|
|
|
0 && &refresh;
|
|
sub refresh
|
|
{
|
|
local($addr) = @_;
|
|
$addr = pack("H*",$addr);
|
|
&debug(sprintf("Refreshing trap for %s", &hostname($addr)));
|
|
push(@Requests,pack("a4SC",$addr,0,6));
|
|
}
|
|
|
|
0 && &retry;
|
|
sub retry
|
|
{
|
|
local($tag) = @_;
|
|
$tag = pack("H*",$tag);
|
|
$RETRY{$tag} = 0 if (!defined($RETRY{$tag}));
|
|
|
|
if (++$RETRY{$tag} > $MAX_TRY)
|
|
{
|
|
&debug(sprintf("Retry failed: %s assoc %5d op %d",
|
|
&hostname(substr($tag,$[,4)),
|
|
unpack("x4SC",$tag)));
|
|
return;
|
|
}
|
|
&debug(sprintf("Retrying: %s assoc %5d op %d",
|
|
&hostname(substr($tag,$[,4)),
|
|
unpack("x4SC",$tag)));
|
|
push(@Requests,$tag);
|
|
}
|
|
|
|
sub process_response
|
|
{
|
|
local($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid) = @_;
|
|
|
|
$msg="";
|
|
if ($op == 7) # trap response
|
|
{
|
|
$msg .= sprintf("%40s trap#%-5d",
|
|
&hostname($from),$seq);
|
|
&debug (sprintf("\nTrap %d associd %d:\n%s\n===============\n",$seq,$associd,$data));
|
|
if ($associd == 0) # system event
|
|
{
|
|
$msg .= " SYSTEM ";
|
|
$evnt = &ntp'SystemEvent($status); #';
|
|
$msg .= "$evnt ";
|
|
;# for special cases add additional info
|
|
($stratum) = ($data =~ /stratum=(\d+)/);
|
|
($refid) = ($data =~ /refid=([\w\.]+)/);
|
|
$msg .= "stratum=$stratum refid=$refid";
|
|
if ($refid =~ /\[?(\d+)\.(\d+)\.(\d+)\.(\d+)/)
|
|
{
|
|
$msg .= " " . (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[];
|
|
}
|
|
if ($evnt eq "event_sync_chg")
|
|
{
|
|
$msg .= sprintf("%s %s ",
|
|
&ntp'LI($status), #',
|
|
&ntp'ClockSource($status) #'
|
|
);
|
|
}
|
|
elsif ($evnt eq "event_sync/strat_chg")
|
|
{
|
|
($peer) = ($data =~ /peer=([0-9]+)/);
|
|
$msg .= " peer=$peer";
|
|
}
|
|
elsif ($evnt eq "event_clock_excptn")
|
|
{
|
|
if (($device) = ($data =~ /device=\"([^\"]+)\"/))
|
|
{
|
|
($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
|
|
$Cstatus = hex($cstatus);
|
|
$msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
|
|
($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
|
|
$msg .= " \"$device\" \"$timecode\"";
|
|
}
|
|
else
|
|
{
|
|
push(@Requests,pack("a4SC",$from, $associd, 4));
|
|
}
|
|
}
|
|
}
|
|
else # peer event
|
|
{
|
|
$msg .= sprintf("peer %5d ",$associd);
|
|
($srcadr) = ($data =~ /srcadr=\[?([\d\.]+)/);
|
|
$msg .= sprintf("%-18s %40s ", "[$srcadr]",
|
|
&hostname(pack("C4",split(/\./,$srcadr))));
|
|
$evnt = &ntp'PeerEvent($status); #';
|
|
$msg .= "$evnt ";
|
|
;# for special cases include additional info
|
|
if ($evnt eq "event_clock_excptn")
|
|
{
|
|
if (($device) = ($data =~ /device=\"([^\"]+)\"/))
|
|
{
|
|
;#&debug("----\n$data\n====\n");
|
|
($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
|
|
$Cstatus = hex($cstatus);
|
|
$msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
|
|
($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
|
|
$msg .= " \"$device\" \"$timecode\"";
|
|
}
|
|
else
|
|
{
|
|
;# no clockvars included - post a cv request
|
|
push(@Requests,pack("a4SC",$from, $associd, 4));
|
|
}
|
|
}
|
|
elsif ($evnt eq "event_stratum_chg")
|
|
{
|
|
($stratum) = ($data =~ /stratum=(\d+)/);
|
|
$msg .= "new stratum $stratum";
|
|
}
|
|
}
|
|
}
|
|
elsif ($op == 6) # set trap resonse
|
|
{
|
|
&debug("Set trap ok from ",&hostname($from));
|
|
&set_timeout("refresh-".unpack("H*",$from),time+$REFRESH_TIME,
|
|
sprintf("&refresh(\"%s\");",unpack("H*",$from)));
|
|
return;
|
|
}
|
|
elsif ($op == 4) # read clock variables response
|
|
{
|
|
;# status of clock
|
|
$msg .= sprintf(" %40s ", &hostname($from));
|
|
if ($associd == 0)
|
|
{
|
|
$msg .= "system clock status: ";
|
|
}
|
|
else
|
|
{
|
|
$msg .= sprintf("peer %5d clock",$associd);
|
|
}
|
|
$msg .= sprintf("%-32s",&ntp'clock_status($status)); #');
|
|
($device) = ($data =~ /device=\"([^\"]+)\"/);
|
|
($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
|
|
$msg .= " \"$device\" \"$timecode\"";
|
|
}
|
|
elsif ($op == 31) # unset trap response (UNOFFICIAL op)
|
|
{
|
|
;# clear timeout
|
|
&debug("Clear Trap ok from ",&hostname($from));
|
|
&clear_timeout("refresh-".unpack("H*",$from));
|
|
return;
|
|
}
|
|
else # unexpected response
|
|
{
|
|
$msg .= "unexpected response to op $op assoc=$associd";
|
|
$msg .= sprintf(" status=%04x",$status);
|
|
}
|
|
&log($msg);
|
|
}
|