1: #!/local/bin/perl --*-perl-*-
2: ;#
3: ;# ntptrap,v 3.1 1993/07/06 01:09:15 jbj Exp
4: ;#
5: ;# a client for the xntp mode 6 trap mechanism
6: ;#
7: ;# Copyright (c) 1992
8: ;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
9: ;#
10: ;#
11: ;#############################################################
12: $0 =~ s!^.*/([^/]+)$!$1!; # strip to filename
13: ;# enforce STDOUT and STDERR to be line buffered
14: $| = 1;
15: select((select(STDERR),$|=1)[$[]);
16:
17: ;#######################################
18: ;# load utility routines and definitions
19: ;#
20: require('ntp.pl'); # implementation of the NTP protocol
21: use Socket;
22:
23: #eval { require('sys/socket.ph'); require('netinet/in.ph') unless defined(&INADDR_ANY); } ||
24: #do {
25: #die("$0: $@") unless $[ == index($@, "Can't locate ");
26: #warn "$0: $@";
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: $@";
29: #};
30: require('getopts.pl'); # option parsing
31: require('ctime.pl'); # date/time formatting
32:
33: ;######################################
34: ;# define some global constants
35: ;#
36: $BASE_TIMEOUT=10;
37: $FRAG_TIMEOUT=10;
38: $MAX_TRY = 5;
39: $REFRESH_TIME=60*15; # 15 minutes (server uses 1 hour)
40: $ntp'timeout = $FRAG_TIMEOUT; #';
41: $ntp'timeout if 0;
42:
43: ;######################################
44: ;# now process options
45: ;#
46: sub usage
47: {
48: die("usage: $0 [-n] [-p <port>] [-l <logfile>] [host] ...\n");
49: }
50:
51: $opt_l = "/dev/null"; # where to write debug messages to
52: $opt_p = 0; # port to use locally - (0 does mean: will be choosen by kernel)
53:
54: &usage unless &Getopts('l:p:');
55: &Getopts if 0; # make -w happy
56:
57: @Hosts = ($#ARGV < $[) ? ("localhost") : @ARGV;
58:
59: ;# setup for debug output
60: $DEBUGFILE=$opt_l;
61: $DEBUGFILE="&STDERR" if $DEBUGFILE eq '-';
62:
63: open(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n");
64: select((select(DEBUG),$|=1)[$[]);
65:
66: ;# &log prints a single trap record (adding a (local) time stamp)
67: sub log
68: {
69: chop($date=&ctime(time));
70: print "$date ",@_,"\n";
71: }
72:
73: sub debug
74: {
75: print DEBUG @_,"\n";
76: }
77: ;#
78: $proto_udp = (getprotobyname('udp'))[$[+2] ||
79: (warn("$0: Could not get protocoll number for 'udp' using 17"), 17);
80:
81: $ntp_port = (getservbyname('ntp','udp'))[$[+2] ||
82: (warn("$0: Could not get port number for service ntp/udp using 123"), 123);
83:
84: ;#
85: socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n");
86:
87: ;#
88: bind(S, pack("S n a4 x8", &AF_INET, $opt_p, &INADDR_ANY)) ||
89: die("Cannot bind: $!\n");
90:
91: ($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
92: &log(sprintf("Listening at address %d.%d.%d.%d port %d",
93: unpack("C4",$my_addr), $my_port));
94:
95: ;# disregister with all servers in case of termination
96: sub cleanup
97: {
98: &log("Aborted by signal \"$_[$[]\"") if defined($_[$[]);
99:
100: foreach (@Hosts)
101: {
102: if ( ! defined($Host{$_}) )
103: {
104: print "no info for host '$_'\n";
105: next;
106: }
107: &ntp'send(S,31,0,"",pack("Sna4x8",&AF_INET,$ntp_port,$Host{$_})); #';
108: }
109: close(S);
110: exit(2);
111: }
112:
113: $SIG{'HUP'} = 'cleanup';
114: $SIG{'INT'} = 'cleanup';
115: $SIG{'QUIT'} = 'cleanup';
116: $SIG{'TERM'} = 'cleanup';
117:
118: 0 && $a && $b;
119: sub timeouts # sort timeout id array
120: {
121: $TIMEOUTS{$a} <=> $TIMEOUTS{$b};
122: }
123:
124: ;# a Request element looks like: pack("a4SC",addr,associd,op)
125: @Requests= ();
126:
127: ;# compute requests for set trap control msgs to each host given
128: {
129: local($name,$addr);
130:
131: foreach (@Hosts)
132: {
133: if (/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
134: {
135: ($name,$addr) =
136: (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[,$[+4];
137: unless (defined($name))
138: {
139: $name = sprintf("[[%d.%d.%d.%d]]",$1,$2,$3,$4);
140: $addr = pack("C4",$1,$2,$3,$4);
141: }
142: }
143: else
144: {
145: ($name,$addr) = (gethostbyname($_))[$[,$[+4];
146: unless (defined($name))
147: {
148: warn "$0: unknown host \"$_\" - ignored\n";
149: next;
150: }
151: }
152: next if defined($Host{$name});
153: $Host{$name} = $addr;
154: $Host{$_} = $addr;
155: push(@Requests,pack("a4SC",$addr,0,6)); # schedule a set trap request for $name
156: }
157: }
158:
159: sub hostname
160: {
161: local($addr) = @_;
162: return $HostName{$addr} if defined($HostName{$addr});
163: local($name) = gethostbyaddr($addr,&AF_INET);
164: &debug(sprintf("hostname(%d.%d.%d.%d) = \"%s\"",unpack("C4",$addr),$name))
165: if defined($name);
166: defined($name) && ($HostName{$addr} = $name) && (return $name);
167: &debug(sprintf("Failed to get name for %d.%d.%d.%d",unpack("C4",$addr)));
168: return sprintf("[%d.%d.%d.%d]",unpack("C4",$addr));
169: }
170:
171: ;# when no hosts were given on the commandline no requests have been scheduled
172: &usage unless (@Requests);
173:
174: &debug(sprintf("%d request(s) scheduled",scalar(@Requests)));
175: grep(&debug(" - ".$_),keys(%Host));
176:
177: ;# allocate variables;
178: $addr="";
179: $assoc=0;
180: $op = 0;
181: $timeout = 0;
182: $ret="";
183: %TIMEOUTS = ();
184: %TIMEOUT_PROCS = ();
185: @TIMEOUTS = ();
186:
187: $len = 512;
188: $buf = " " x $len;
189:
190: while (1)
191: {
192: if (@Requests || @TIMEOUTS) # if there is some work pending
193: {
194: if (@Requests)
195: {
196: ($addr,$assoc,$op) = unpack("a4SC",($req = shift(@Requests)));
197: &debug(sprintf("Request: %s: %s(%d)",&hostname($addr), &ntp'cntrlop_name($op), $assoc)); #';))
198: $ret = &ntp'send(S,$op,$assoc,"", #'(
199: pack("Sna4x8",&AF_INET,$ntp_port,$addr));
200: &set_timeout("retry-".unpack("H*",$req),time+$BASE_TIMEOUT,
201: sprintf("&retry(\"%s\");",unpack("H*",$req)));
202:
203: last unless (defined($ret)); # warn called by ntp'send();
204:
205: ;# if there are more requests just have a quick look for new messages
206: ;# otherwise grant server time for a response
207: $timeout = @Requests ? 0 : $BASE_TIMEOUT;
208: }
209: if ($timeout && @TIMEOUTS)
210: {
211: ;# ensure not to miss a timeout
212: if ($timeout + time > $TIMEOUTS{$TIMEOUTS[$[]})
213: {
214: $timeout = $TIMEOUTS{$TIMEOUTS[$[]} - time;
215: $timeout = 0 if $timeout < 0;
216: }
217: }
218: }
219: else
220: {
221: ;# no work yet - wait for some messages dropping in
222: ;# usually this will not hapen as the refresh semantic will
223: ;# always have a pending timeout
224: undef($timeout);
225: }
226:
227: vec($mask="",fileno(S),1) = 1;
228: $ret = select($mask,undef,undef,$timeout);
229:
230: warn("$0: select: $!\n"),last if $ret < 0; # give up on error return from select
231:
232: if ($ret == 0)
233: {
234: ;# timeout
235: if (@TIMEOUTS && time > $TIMEOUTS{$TIMEOUTS[$[]})
236: {
237: ;# handle timeout
238: $timeout_proc =
239: (delete $TIMEOUT_PROCS{$TIMEOUTS[$[]},
240: delete $TIMEOUTS{shift(@TIMEOUTS)})[$[];
241: eval $timeout_proc;
242: die "timeout eval (\"$timeout_proc\"): $@\n" if $@;
243: }
244: ;# else: there may be something to be sent
245: }
246: else
247: {
248: ;# data avail
249: $from = recv(S,$buf,$len,0);
250: ;# give up on error return from recv
251: warn("$0: recv: $!\n"), last unless (defined($from));
252:
253: $from = (unpack("Sna4",$from))[$[+2]; # keep host addr only
254: ;# could check for ntp_port - but who cares
255: &debug("-Packet from ",&hostname($from));
256:
257: ;# stuff packet into ntp mode 6 receive machinery
258: ($ret,$data,$status,$associd,$op,$seq,$auth_keyid) =
259: &ntp'handle_packet($buf,$from); # ';
260: &debug(sprintf("%s uses auth_keyid %d",&hostname($from),$auth_keyid)) if defined($auth_keyid);
261: next unless defined($ret);
262:
263: if ($ret eq "")
264: {
265: ;# handle packet
266: ;# simple trap response messages have neither timeout nor retries
267: &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))) unless $op == 7;
268: delete $RETRY{pack("a4SC",$from,$associd,$op)} unless $op == 7;
269:
270: &process_response($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid);
271: }
272: else
273: {
274: ;# some kind of error
275: &log(sprintf("%50s: %s: %s",(gethostbyaddr($from,&AF_INET))[$[],$ret,$data));
276: if ($ret ne "TIMEOUT" && $ret ne "ERROR")
277: {
278: &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op)));
279: }
280: }
281: }
282:
283: }
284:
285: warn("$0: terminating\n");
286: &cleanup;
287: exit 0;
288:
289: ;##################################################
290: ;# timeout support
291: ;#
292: sub set_timeout
293: {
294: local($id,$time,$proc) = @_;
295:
296: $TIMEOUTS{$id} = $time;
297: $TIMEOUT_PROCS{$id} = $proc;
298: @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
299: chop($date=&ctime($time));
300: &debug(sprintf("Schedule timeout \"%s\" for %s", $id, $date));
301: }
302:
303: sub clear_timeout
304: {
305: local($id) = @_;
306: delete $TIMEOUTS{$id};
307: delete $TIMEOUT_PROCS{$id};
308: @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
309: &debug("Clear timeout \"$id\"");
310: }
311:
312: 0 && &refresh;
313: sub refresh
314: {
315: local($addr) = @_[$[];
316: $addr = pack("H*",$addr);
317: &debug(sprintf("Refreshing trap for %s", &hostname($addr)));
318: push(@Requests,pack("a4SC",$addr,0,6));
319: }
320:
321: 0 && &retry;
322: sub retry
323: {
324: local($tag) = @_;
325: $tag = pack("H*",$tag);
326: $RETRY{$tag} = 0 if (!defined($RETRY{$tag}));
327:
328: if (++$RETRY{$tag} > $MAX_TRY)
329: {
330: &debug(sprintf("Retry failed: %s assoc %5d op %d",
331: &hostname(substr($tag,$[,4)),
332: unpack("x4SC",$tag)));
333: return;
334: }
335: &debug(sprintf("Retrying: %s assoc %5d op %d",
336: &hostname(substr($tag,$[,4)),
337: unpack("x4SC",$tag)));
338: push(@Requests,$tag);
339: }
340:
341: sub process_response
342: {
343: local($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid) = @_;
344:
345: $msg="";
346: if ($op == 7) # trap response
347: {
348: $msg .= sprintf("%40s trap#%-5d",
349: &hostname($from),$seq);
350: &debug (sprintf("\nTrap %d associd %d:\n%s\n===============\n",$seq,$associd,$data));
351: if ($associd == 0) # system event
352: {
353: $msg .= " SYSTEM ";
354: $evnt = &ntp'SystemEvent($status); #';
355: $msg .= "$evnt ";
356: ;# for special cases add additional info
357: ($stratum) = ($data =~ /stratum=(\d+)/);
358: ($refid) = ($data =~ /refid=([\w\.]+)/);
359: $msg .= "stratum=$stratum refid=$refid";
360: if ($refid =~ /\[?(\d+)\.(\d+)\.(\d+)\.(\d+)/)
361: {
362: local($x) = (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET));
363: $msg .= " " . $x if defined($x)
364: }
365: if ($evnt eq "event_sync_chg")
366: {
367: $msg .= sprintf("%s %s ",
368: &ntp'LI($status), #',
369: &ntp'ClockSource($status) #'
370: );
371: }
372: elsif ($evnt eq "event_sync/strat_chg")
373: {
374: ($peer) = ($data =~ /peer=([0-9]+)/);
375: $msg .= " peer=$peer";
376: }
377: elsif ($evnt eq "event_clock_excptn")
378: {
379: if (($device) = ($data =~ /device=\"([^\"]+)\"/))
380: {
381: ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
382: $Cstatus = hex($cstatus);
383: $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
384: ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
385: $msg .= " \"$device\" \"$timecode\"";
386: }
387: else
388: {
389: push(@Requests,pack("a4SC",$from, $associd, 4));
390: }
391: }
392: }
393: else # peer event
394: {
395: $msg .= sprintf("peer %5d ",$associd);
396: ($srcadr) = ($data =~ /srcadr=\[?([\d\.]+)/);
397: $msg .= sprintf("%-18s %40s ", "[$srcadr]",
398: &hostname(pack("C4",split(/\./,$srcadr))));
399: $evnt = &ntp'PeerEvent($status); #';
400: $msg .= "$evnt ";
401: ;# for special cases include additional info
402: if ($evnt eq "event_clock_excptn")
403: {
404: if (($device) = ($data =~ /device=\"([^\"]+)\"/))
405: {
406: ;#&debug("----\n$data\n====\n");
407: ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
408: $Cstatus = hex($cstatus);
409: $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
410: ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
411: $msg .= " \"$device\" \"$timecode\"";
412: }
413: else
414: {
415: ;# no clockvars included - post a cv request
416: push(@Requests,pack("a4SC",$from, $associd, 4));
417: }
418: }
419: elsif ($evnt eq "event_stratum_chg")
420: {
421: ($stratum) = ($data =~ /stratum=(\d+)/);
422: $msg .= "new stratum $stratum";
423: }
424: }
425: }
426: elsif ($op == 6) # set trap resonse
427: {
428: &debug("Set trap ok from ",&hostname($from));
429: &set_timeout("refresh-".unpack("H*",$from),time+$REFRESH_TIME,
430: sprintf("&refresh(\"%s\");",unpack("H*",$from)));
431: return;
432: }
433: elsif ($op == 4) # read clock variables response
434: {
435: ;# status of clock
436: $msg .= sprintf(" %40s ", &hostname($from));
437: if ($associd == 0)
438: {
439: $msg .= "system clock status: ";
440: }
441: else
442: {
443: $msg .= sprintf("peer %5d clock",$associd);
444: }
445: $msg .= sprintf("%-32s",&ntp'clock_status($status)); #');
446: ($device) = ($data =~ /device=\"([^\"]+)\"/);
447: ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
448: $msg .= " \"$device\" \"$timecode\"";
449: }
450: elsif ($op == 31) # unset trap response (UNOFFICIAL op)
451: {
452: ;# clear timeout
453: &debug("Clear Trap ok from ",&hostname($from));
454: &clear_timeout("refresh-".unpack("H*",$from));
455: return;
456: }
457: else # unexpected response
458: {
459: $msg .= "unexpected response to op $op assoc=$associd";
460: $msg .= sprintf(" status=%04x",$status);
461: }
462: &log($msg);
463: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ntptrap CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / ntp / scripts / monitoring