1 #!/local/bin/perl --*-perl-*-
3 ;# ntptrap,v 3.1 1993/07/06 01:09:15 jbj Exp
5 ;# a client for the xntp mode 6 trap mechanism
8 ;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
11 ;#############################################################
12 $0 =~ s!^.*/([^/]+)$!$1!; # strip to filename
13 ;# enforce STDOUT and STDERR to be line buffered
15 select((select(STDERR),$|=1)[$[]);
17 ;#######################################
18 ;# load utility routines and definitions
20 require('ntp.pl'); # implementation of the NTP protocol
23 #eval { require('sys/socket.ph'); require('netinet/in.ph') unless defined(&INADDR_ANY); } ||
25 #die("$0: $@") unless $[ == index($@, "Can't locate ");
27 #warn "$0: supplying some default definitions\n";
28 #eval 'sub INADDR_ANY { 0; } sub AF_INET {2;} sub SOCK_DGRAM {2;} 1;' || die "$0: $@";
30 require('getopts.pl'); # option parsing
31 require('ctime.pl'); # date/time formatting
33 ;######################################
34 ;# define some global constants
39 $REFRESH_TIME=60*15; # 15 minutes (server uses 1 hour)
40 $ntp'timeout = $FRAG_TIMEOUT; #';
43 ;######################################
44 ;# now process options
48 die("usage: $0 [-p <port>] [-l <logfile>] [host] ...\n");
51 &usage unless &Getopts('l:p:');
52 &Getopts if 0; # make -w happy
54 $opt_l = "/dev/null" # where to write debug messages to
56 $opt_p = 0 # port to use locally - (0 does mean: will be chosen by kernel)
59 @Hosts = ($#ARGV < $[) ? ("localhost") : @ARGV;
61 ;# setup for debug output
63 $DEBUGFILE="&STDERR" if $DEBUGFILE eq '-';
65 open(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n");
66 select((select(DEBUG),$|=1)[$[]);
68 ;# &log prints a single trap record (adding a (local) time stamp)
71 chop($date=&ctime(time));
72 print "$date ",@_,"\n";
80 $proto_udp = (getprotobyname('udp'))[$[+2] ||
81 (warn("$0: Could not get protocoll number for 'udp' using 17"), 17);
83 $ntp_port = (getservbyname('ntp','udp'))[$[+2] ||
84 (warn("$0: Could not get port number for service ntp/udp using 123"), 123);
87 socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n");
90 bind(S, pack("S n a4 x8", &AF_INET, $opt_p, &INADDR_ANY)) ||
91 die("Cannot bind: $!\n");
93 ($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
94 &log(sprintf("Listening at address %d.%d.%d.%d port %d",
95 unpack("C4",$my_addr), $my_port));
97 ;# disregister with all servers in case of termination
100 &log("Aborted by signal \"$_[$[]\"") if defined($_[$[]);
104 if ( ! defined($Host{$_}) )
106 print "no info for host '$_'\n";
109 &ntp'send(S,31,0,"",pack("Sna4x8",&AF_INET,$ntp_port,$Host{$_})); #';
115 $SIG{'HUP'} = 'cleanup';
116 $SIG{'INT'} = 'cleanup';
117 $SIG{'QUIT'} = 'cleanup';
118 $SIG{'TERM'} = 'cleanup';
121 sub timeouts # sort timeout id array
123 $TIMEOUTS{$a} <=> $TIMEOUTS{$b};
126 ;# a Request element looks like: pack("a4SC",addr,associd,op)
129 ;# compute requests for set trap control msgs to each host given
135 if (/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
138 (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[,$[+4];
139 unless (defined($name))
141 $name = sprintf("[[%d.%d.%d.%d]]",$1,$2,$3,$4);
142 $addr = pack("C4",$1,$2,$3,$4);
147 ($name,$addr) = (gethostbyname($_))[$[,$[+4];
148 unless (defined($name))
150 warn "$0: unknown host \"$_\" - ignored\n";
154 next if defined($Host{$name});
155 $Host{$name} = $addr;
157 push(@Requests,pack("a4SC",$addr,0,6)); # schedule a set trap request for $name
164 return $HostName{$addr} if defined($HostName{$addr});
165 local($name) = gethostbyaddr($addr,&AF_INET);
166 &debug(sprintf("hostname(%d.%d.%d.%d) = \"%s\"",unpack("C4",$addr),$name))
168 defined($name) && ($HostName{$addr} = $name) && (return $name);
169 &debug(sprintf("Failed to get name for %d.%d.%d.%d",unpack("C4",$addr)));
170 return sprintf("[%d.%d.%d.%d]",unpack("C4",$addr));
173 ;# when no hosts were given on the commandline no requests have been scheduled
174 &usage unless (@Requests);
176 &debug(sprintf("%d request(s) scheduled",scalar(@Requests)));
177 grep(&debug(" - ".$_),keys(%Host));
179 ;# allocate variables;
194 if (@Requests || @TIMEOUTS) # if there is some work pending
198 ($addr,$assoc,$op) = unpack("a4SC",($req = shift(@Requests)));
199 &debug(sprintf("Request: %s: %s(%d)",&hostname($addr), &ntp'cntrlop_name($op), $assoc)); #';))
200 $ret = &ntp'send(S,$op,$assoc,"", #'(
201 pack("Sna4x8",&AF_INET,$ntp_port,$addr));
202 &set_timeout("retry-".unpack("H*",$req),time+$BASE_TIMEOUT,
203 sprintf("&retry(\"%s\");",unpack("H*",$req)));
205 last unless (defined($ret)); # warn called by ntp'send();
207 ;# if there are more requests just have a quick look for new messages
208 ;# otherwise grant server time for a response
209 $timeout = @Requests ? 0 : $BASE_TIMEOUT;
211 if ($timeout && @TIMEOUTS)
213 ;# ensure not to miss a timeout
214 if ($timeout + time > $TIMEOUTS{$TIMEOUTS[$[]})
216 $timeout = $TIMEOUTS{$TIMEOUTS[$[]} - time;
217 $timeout = 0 if $timeout < 0;
223 ;# no work yet - wait for some messages dropping in
224 ;# usually this will not hapen as the refresh semantic will
225 ;# always have a pending timeout
229 vec($mask="",fileno(S),1) = 1;
230 $ret = select($mask,undef,undef,$timeout);
232 warn("$0: select: $!\n"),last if $ret < 0; # give up on error return from select
237 if (@TIMEOUTS && time > $TIMEOUTS{$TIMEOUTS[$[]})
241 (delete $TIMEOUT_PROCS{$TIMEOUTS[$[]},
242 delete $TIMEOUTS{shift(@TIMEOUTS)})[$[];
244 die "timeout eval (\"$timeout_proc\"): $@\n" if $@;
246 ;# else: there may be something to be sent
251 $from = recv(S,$buf,$len,0);
252 ;# give up on error return from recv
253 warn("$0: recv: $!\n"), last unless (defined($from));
255 $from = (unpack("Sna4",$from))[$[+2]; # keep host addr only
256 ;# could check for ntp_port - but who cares
257 &debug("-Packet from ",&hostname($from));
259 ;# stuff packet into ntp mode 6 receive machinery
260 ($ret,$data,$status,$associd,$op,$seq,$auth_keyid) =
261 &ntp'handle_packet($buf,$from); # ';
262 &debug(sprintf("%s uses auth_keyid %d",&hostname($from),$auth_keyid)) if defined($auth_keyid);
263 next unless defined($ret);
268 ;# simple trap response messages have neither timeout nor retries
269 &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))) unless $op == 7;
270 delete $RETRY{pack("a4SC",$from,$associd,$op)} unless $op == 7;
272 &process_response($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid);
276 ;# some kind of error
277 &log(sprintf("%50s: %s: %s",(gethostbyaddr($from,&AF_INET))[$[],$ret,$data));
278 if ($ret ne "TIMEOUT" && $ret ne "ERROR")
280 &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op)));
287 warn("$0: terminating\n");
291 ;##################################################
296 local($id,$time,$proc) = @_;
298 $TIMEOUTS{$id} = $time;
299 $TIMEOUT_PROCS{$id} = $proc;
300 @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
301 chop($date=&ctime($time));
302 &debug(sprintf("Schedule timeout \"%s\" for %s", $id, $date));
308 delete $TIMEOUTS{$id};
309 delete $TIMEOUT_PROCS{$id};
310 @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
311 &debug("Clear timeout \"$id\"");
317 local($addr) = @_[$[];
318 $addr = pack("H*",$addr);
319 &debug(sprintf("Refreshing trap for %s", &hostname($addr)));
320 push(@Requests,pack("a4SC",$addr,0,6));
327 $tag = pack("H*",$tag);
328 $RETRY{$tag} = 0 if (!defined($RETRY{$tag}));
330 if (++$RETRY{$tag} > $MAX_TRY)
332 &debug(sprintf("Retry failed: %s assoc %5d op %d",
333 &hostname(substr($tag,$[,4)),
334 unpack("x4SC",$tag)));
337 &debug(sprintf("Retrying: %s assoc %5d op %d",
338 &hostname(substr($tag,$[,4)),
339 unpack("x4SC",$tag)));
340 push(@Requests,$tag);
345 local($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid) = @_;
348 if ($op == 7) # trap response
350 $msg .= sprintf("%40s trap#%-5d",
351 &hostname($from),$seq);
352 &debug (sprintf("\nTrap %d associd %d:\n%s\n===============\n",$seq,$associd,$data));
353 if ($associd == 0) # system event
356 $evnt = &ntp'SystemEvent($status); #';
358 ;# for special cases add additional info
359 ($stratum) = ($data =~ /stratum=(\d+)/);
360 ($refid) = ($data =~ /refid=([\w\.]+)/);
361 $msg .= "stratum=$stratum refid=$refid";
362 if ($refid =~ /\[?(\d+)\.(\d+)\.(\d+)\.(\d+)/)
364 local($x) = (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET));
365 $msg .= " " . $x if defined($x)
367 if ($evnt eq "event_sync_chg")
369 $msg .= sprintf("%s %s ",
370 &ntp'LI($status), #',
371 &ntp'ClockSource($status) #'
374 elsif ($evnt eq "event_sync/strat_chg")
376 ($peer) = ($data =~ /peer=([0-9]+)/);
377 $msg .= " peer=$peer";
379 elsif ($evnt eq "event_clock_excptn")
381 if (($device) = ($data =~ /device=\"([^\"]+)\"/))
383 ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
384 $Cstatus = hex($cstatus);
385 $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
386 ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
387 $msg .= " \"$device\" \"$timecode\"";
391 push(@Requests,pack("a4SC",$from, $associd, 4));
397 $msg .= sprintf("peer %5d ",$associd);
398 ($srcadr) = ($data =~ /srcadr=\[?([\d\.]+)/);
399 $msg .= sprintf("%-18s %40s ", "[$srcadr]",
400 &hostname(pack("C4",split(/\./,$srcadr))));
401 $evnt = &ntp'PeerEvent($status); #';
403 ;# for special cases include additional info
404 if ($evnt eq "event_clock_excptn")
406 if (($device) = ($data =~ /device=\"([^\"]+)\"/))
408 ;#&debug("----\n$data\n====\n");
409 ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
410 $Cstatus = hex($cstatus);
411 $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
412 ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
413 $msg .= " \"$device\" \"$timecode\"";
417 ;# no clockvars included - post a cv request
418 push(@Requests,pack("a4SC",$from, $associd, 4));
421 elsif ($evnt eq "event_stratum_chg")
423 ($stratum) = ($data =~ /stratum=(\d+)/);
424 $msg .= "new stratum $stratum";
428 elsif ($op == 6) # set trap resonse
430 &debug("Set trap ok from ",&hostname($from));
431 &set_timeout("refresh-".unpack("H*",$from),time+$REFRESH_TIME,
432 sprintf("&refresh(\"%s\");",unpack("H*",$from)));
435 elsif ($op == 4) # read clock variables response
438 $msg .= sprintf(" %40s ", &hostname($from));
441 $msg .= "system clock status: ";
445 $msg .= sprintf("peer %5d clock",$associd);
447 $msg .= sprintf("%-32s",&ntp'clock_status($status)); #');
448 ($device) = ($data =~ /device=\"([^\"]+)\"/);
449 ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
450 $msg .= " \"$device\" \"$timecode\"";
452 elsif ($op == 31) # unset trap response (UNOFFICIAL op)
455 &debug("Clear Trap ok from ",&hostname($from));
456 &clear_timeout("refresh-".unpack("H*",$from));
459 else # unexpected response
461 $msg .= "unexpected response to op $op assoc=$associd";
462 $msg .= sprintf(" status=%04x",$status);