1: #!/usr/bin/perl -w
2: ;#
3: ;# ntp.pl,v 3.1 1993/07/06 01:09:09 jbj Exp
4: ;#
5: ;# process loop filter statistics file and either
6: ;# - show statistics periodically using gnuplot
7: ;# - or print a single plot
8: ;#
9: ;# Copyright (c) 1992
10: ;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
11: ;#
12: ;#
13: ;#############################################################
14:
15: package ntp;
16:
17: $NTP_version = 2;
18: $ctrl_mode=6;
19:
20: $byte1 = (($NTP_version & 0x7)<< 3) & 0x34 | ($ctrl_mode & 0x7);
21: $MAX_DATA = 468;
22:
23: $sequence = 0; # initial sequence number incred before used
24: $pad=4;
25: $do_auth=0; # no possibility today
26: $keyid=0;
27: ;#list if known keys (passwords)
28: %KEYS = ( 0, "\200\200\200\200\200\200\200\200",
29: );
30:
31: ;#-----------------------------------------------------------------------------
32: ;# access routines for ntp control packet
33: ;# NTP control message format
34: ;# C LI|VN|MODE LI 2bit=00 VN 3bit=2(3) MODE 3bit=6 : $byte1
35: ;# C R|E|M|Op R response E error M more Op opcode
36: ;# n sequence
37: ;# n status
38: ;# n associd
39: ;# n offset
40: ;# n count
41: ;# a+ data (+ padding)
42: ;# optional authentication data
43: ;# N key
44: ;# N2 checksum
45:
46: ;# first byte of packet
47: sub pkt_LI { return ($_[$[] >> 6) & 0x3; }
48: sub pkt_VN { return ($_[$[] >> 3) & 0x7; }
49: sub pkt_MODE { return ($_[$[] ) & 0x7; }
50:
51: ;# second byte of packet
52: sub pkt_R { return ($_[$[] & 0x80) == 0x80; }
53: sub pkt_E { return ($_[$[] & 0x40) == 0x40; }
54: sub pkt_M { return ($_[$[] & 0x20) == 0x20; }
55: sub pkt_OP { return $_[$[] & 0x1f; }
56:
57: ;#-----------------------------------------------------------------------------
58:
59: sub setkey
60: {
61: local($id,$key) = @_;
62:
63: $KEYS{$id} = $key if (defined($key));
64: if (! defined($KEYS{$id}))
65: {
66: warn "Key $id not yet specified - key not changed\n";
67: return undef;
68: }
69: return ($keyid,$keyid = $id)[$[];
70: }
71:
72: ;#-----------------------------------------------------------------------------
73: sub numerical { $a <=> $b; }
74:
75: ;#-----------------------------------------------------------------------------
76:
77: sub send #'
78: {
79: local($fh,$opcode, $associd, $data,$address) = @_;
80: $fh = caller(0)."'$fh";
81:
82: local($junksize,$junk,$packet,$offset,$ret);
83: $offset = 0;
84:
85: $sequence++;
86: while(1)
87: {
88: $junksize = length($data);
89: $junksize = $MAX_DATA if $junksize > $MAX_DATA;
90:
91: ($junk,$data) = $data =~ /^(.{$junksize})(.*)$/;
92: $packet
93: = pack("C2n5a".(($junk eq "") ? 0 : &pad($junksize+12,$pad)-12),
94: $byte1,
95: ($opcode & 0x1f) | ($data ? 0x20 : 0),
96: $sequence,
97: 0, $associd,
98: $offset, $junksize, $junk);
99: if ($do_auth)
100: {
101: ;# not yet
102: }
103: $offset += $junksize;
104:
105: if (defined($address))
106: {
107: $ret = send($fh, $packet, 0, $address);
108: }
109: else
110: {
111: $ret = send($fh, $packet, 0);
112: }
113:
114: if (! defined($ret))
115: {
116: warn "send failed: $!\n";
117: return undef;
118: }
119: elsif ($ret != length($packet))
120: {
121: warn "send failed: sent only $ret from ".length($packet). "bytes\n";
122: return undef;
123: }
124: return $sequence unless $data;
125: }
126: }
127:
128: ;#-----------------------------------------------------------------------------
129: ;# status interpretation
130: ;#
131: sub getval
132: {
133: local($val,*list) = @_;
134:
135: return $list{$val} if defined($list{$val});
136: return sprintf("%s#%d",$list{"-"},$val) if defined($list{"-"});
137: return "unknown-$val";
138: }
139:
140: ;#---------------------------------
141: ;# system status
142: ;#
143: ;# format: |LI|CS|SECnt|SECode| LI=2bit CS=6bit SECnt=4bit SECode=4bit
144: sub ssw_LI { return ($_[$[] >> 14) & 0x3; }
145: sub ssw_CS { return ($_[$[] >> 8) & 0x3f; }
146: sub ssw_SECnt { return ($_[$[] >> 4) & 0xf; }
147: sub ssw_SECode { return $_[$[] & 0xf; }
148:
149: %LI = ( 0, "leap_none", 1, "leap_add_sec", 2, "leap_del_sec", 3, "sync_alarm", "-", "leap");
150: %ClockSource = (0, "sync_unspec",
151: 1, "sync_lf_clock",
152: 2, "sync_uhf_clock",
153: 3, "sync_hf_clock",
154: 4, "sync_local_proto",
155: 5, "sync_ntp",
156: 6, "sync_udp/time",
157: 7, "sync_wristwatch",
158: "-", "ClockSource",
159: );
160:
161: %SystemEvent = (0, "event_unspec",
162: 1, "event_restart",
163: 2, "event_fault",
164: 3, "event_sync_chg",
165: 4, "event_sync/strat_chg",
166: 5, "event_clock_reset",
167: 6, "event_bad_date",
168: 7, "event_clock_excptn",
169: "-", "event",
170: );
171: sub LI
172: {
173: &getval(&ssw_LI($_[$[]),*LI);
174: }
175: sub ClockSource
176: {
177: &getval(&ssw_CS($_[$[]),*ClockSource);
178: }
179:
180: sub SystemEvent
181: {
182: &getval(&ssw_SECode($_[$[]),*SystemEvent);
183: }
184:
185: sub system_status
186: {
187: return sprintf("%s, %s, %d event%s, %s", &LI($_[$[]), &ClockSource($_[$[]),
188: &ssw_SECnt($_[$[]), ((&ssw_SECnt($_[$[])==1) ? "" : "s"),
189: &SystemEvent($_[$[]));
190: }
191: ;#---------------------------------
192: ;# peer status
193: ;#
194: ;# format: |PStat|PSel|PCnt|PCode| Pstat=6bit PSel=2bit PCnt=4bit PCode=4bit
195: sub psw_PStat_config { return ($_[$[] & 0x8000) == 0x8000; }
196: sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
197: sub psw_PStat_authentic { return ($_[$[] & 0x2000) == 0x2000; }
198: sub psw_PStat_reach { return ($_[$[] & 0x1000) == 0x1000; }
199: sub psw_PStat_sane { return ($_[$[] & 0x0800) == 0x0800; }
200: sub psw_PStat_dispok { return ($_[$[] & 0x0400) == 0x0400; }
201: sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
202: sub psw_PSel { return ($_[$[] >> 8) & 0x3; }
203: sub psw_PCnt { return ($_[$[] >> 4) & 0xf; }
204: sub psw_PCode { return $_[$[] & 0xf; }
205:
206: %PeerSelection = (0, "sel_reject",
207: 1, "sel_candidate",
208: 2, "sel_selcand",
209: 3, "sel_sys.peer",
210: "-", "PeerSel",
211: );
212: %PeerEvent = (0, "event_unspec",
213: 1, "event_ip_err",
214: 2, "event_authen",
215: 3, "event_unreach",
216: 4, "event_reach",
217: 5, "event_clock_excptn",
218: 6, "event_stratum_chg",
219: "-", "event",
220: );
221:
222: sub PeerSelection
223: {
224: &getval(&psw_PSel($_[$[]),*PeerSelection);
225: }
226:
227: sub PeerEvent
228: {
229: &getval(&psw_PCode($_[$[]),*PeerEvent);
230: }
231:
232: sub peer_status
233: {
234: local($x) = ("");
235: $x .= "config," if &psw_PStat_config($_[$[]);
236: $x .= "authenable," if &psw_PStat_authenable($_[$[]);
237: $x .= "authentic," if &psw_PStat_authentic($_[$[]);
238: $x .= "reach," if &psw_PStat_reach($_[$[]);
239: $x .= &psw_PStat_sane($_[$[]) ? "sane," : "insane,";
240: $x .= "hi_disp," unless &psw_PStat_dispok($_[$[]);
241:
242: $x .= sprintf(" %s, %d event%s, %s", &PeerSelection($_[$[]),
243: &psw_PCnt($_[$[]), ((&psw_PCnt($_[$[]) == 1) ? "" : "s"),
244: &PeerEvent($_[$[]));
245: return $x;
246: }
247:
248: ;#---------------------------------
249: ;# clock status
250: ;#
251: ;# format: |CStat|CEvnt| CStat=8bit CEvnt=8bit
252: sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
253: sub csw_CEvnt { return $_[$[] & 0xff; }
254:
255: %ClockStatus = (0, "clk_nominal",
256: 1, "clk_timeout",
257: 2, "clk_badreply",
258: 3, "clk_fault",
259: 4, "clk_prop",
260: 5, "clk_baddate",
261: 6, "clk_badtime",
262: "-", "clk",
263: );
264:
265: sub clock_status
266: {
267: return sprintf("%s, last %s",
268: &getval(&csw_CStat($_[$[]),*ClockStatus),
269: &getval(&csw_CEvnt($_[$[]),*ClockStatus));
270: }
271:
272: ;#---------------------------------
273: ;# error status
274: ;#
275: ;# format: |Err|reserved| Err=8bit
276: ;#
277: sub esw_Err { return ($_[$[] >> 8) & 0xff; }
278:
279: %ErrorStatus = (0, "err_unspec",
280: 1, "err_auth_fail",
281: 2, "err_invalid_fmt",
282: 3, "err_invalid_opcode",
283: 4, "err_unknown_assoc",
284: 5, "err_unknown_var",
285: 6, "err_invalid_value",
286: 7, "err_adm_prohibit",
287: );
288:
289: sub error_status
290: {
291: return sprintf("%s", &getval(&esw_Err($_[$[]),*ErrorStatus));
292: }
293:
294: ;#-----------------------------------------------------------------------------
295: ;#
296: ;# cntrl op name translation
297:
298: %CntrlOpName = (1, "read_status",
299: 2, "read_variables",
300: 3, "write_variables",
301: 4, "read_clock_variables",
302: 5, "write_clock_variables",
303: 6, "set_trap",
304: 7, "trap_response",
305: 31, "unset_trap", # !!! unofficial !!!
306: "-", "cntrlop",
307: );
308:
309: sub cntrlop_name
310: {
311: return &getval($_[$[],*CntrlOpName);
312: }
313:
314: ;#-----------------------------------------------------------------------------
315:
316: $STAT_short_pkt = 0;
317: $STAT_pkt = 0;
318:
319: ;# process a NTP control message (response) packet
320: ;# returns a list ($ret,$data,$status,$associd,$op,$seq,$auth_keyid)
321: ;# $ret: undef --> not yet complete
322: ;# "" --> complete packet received
323: ;# "ERROR" --> error during receive, bad packet, ...
324: ;# else --> error packet - list may contain useful info
325:
326:
327: sub handle_packet
328: {
329: local($pkt,$from) = @_; # parameters
330: local($len_pkt) = (length($pkt));
331: ;# local(*FRAGS,*lastseen);
332: local($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data);
333: local($autch_keyid,$auth_cksum);
334:
335: $STAT_pkt++;
336: if ($len_pkt < 12)
337: {
338: $STAT_short_pkt++;
339: return ("ERROR","short packet received");
340: }
341:
342: ;# now break packet apart
343: ($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data) =
344: unpack("C2n5a".($len_pkt-12),$pkt);
345: $data=substr($data,$[,$count);
346: if ((($len_pkt - 12) - &pad($count,4)) >= 12)
347: {
348: ;# looks like an authenticator
349: ($auth_keyid,$auth_cksum) =
350: unpack("Na8",substr($pkt,$len_pkt-12+$[,12));
351: $STAT_auth++;
352: ;# no checking of auth_cksum (yet ?)
353: }
354:
355: if (&pkt_VN($li_vn_mode) != $NTP_version)
356: {
357: $STAT_bad_version++;
358: return ("ERROR","version ".&pkt_VN($li_vn_mode)."packet ignored");
359: }
360:
361: if (&pkt_MODE($li_vn_mode) != $ctrl_mode)
362: {
363: $STAT_bad_mode++;
364: return ("ERROR", "mode ".&pkt_MODE($li_vn_mode)." packet ignored");
365: }
366:
367: ;# handle single fragment fast
368: if ($offset == 0 && &pkt_M($r_e_m_op) == 0)
369: {
370: $STAT_single_frag++;
371: if (&pkt_E($r_e_m_op))
372: {
373: $STAT_err_pkt++;
374: return (&error_status($status),
375: $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
376: $auth_keyid);
377: }
378: else
379: {
380: return ("",
381: $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
382: $auth_keyid);
383: }
384: }
385: else
386: {
387: ;# fragment - set up local name space
388: $id = "$from$seq".&pkt_OP($r_e_m_op);
389: $ID{$id} = 1;
390: *FRAGS = "$id FRAGS";
391: *lastseen = "$id lastseen";
392:
393: $STAT_frag++;
394:
395: $lastseen = 1 if !&pkt_M($r_e_m_op);
396: if (!defined(%FRAGS))
397: {
398: print((&pkt_M($r_e_m_op) ? " more" : "")."\n");
399: $FRAGS{$offset} = $data;
400: ;# save other info
401: @FRAGS = ($status,$associd,&pkt_OP($r_e_m_op),$seq,$auth_keyid,$r_e_m_op);
402: }
403: else
404: {
405: print((&pkt_M($r_e_m_op) ? " more" : "")."\n");
406: ;# add frag to previous - combine on the fly
407: if (defined($FRAGS{$offset}))
408: {
409: $STAT_dup_frag++;
410: return ("ERROR","duplicate fragment at $offset seq=$seq");
411: }
412:
413: $FRAGS{$offset} = $data;
414:
415: undef($loff);
416: foreach $off (sort numerical keys(%FRAGS))
417: {
418: next unless defined($FRAGS{$off});
419: if (defined($loff) &&
420: ($loff + length($FRAGS{$loff})) == $off)
421: {
422: $FRAGS{$loff} .= $FRAGS{$off};
423: delete $FRAGS{$off};
424: last;
425: }
426: $loff = $off;
427: }
428:
429: ;# return packet if all frags arrived
430: ;# at most two frags with possible padding ???
431: if ($lastseen && defined($FRAGS{0}) &&
432: (((scalar(@x=sort numerical keys(%FRAGS)) == 2) &&
433: (length($FRAGS{0}) + 8) > $x[$[+1]) ||
434: (scalar(@x=sort numerical keys(%FRAGS)) < 2)))
435: {
436: @x=((&pkt_E($r_e_m_op) ? &error_status($status) : ""),
437: $FRAGS{0},@FRAGS);
438: &pkt_E($r_e_m_op) ? $STAT_err_frag++ : $STAT_frag_all++;
439: undef(%FRAGS);
440: undef(@FRAGS);
441: undef($lastseen);
442: delete $ID{$id};
443: &main'clear_timeout($id);
444: return @x;
445: }
446: else
447: {
448: &main'set_timeout($id,time+$timeout,"&ntp'handle_packet_timeout(\"".unpack("H*",$id)."\");"); #'";
449: }
450: }
451: return (undef);
452: }
453: }
454:
455: sub handle_packet_timeout
456: {
457: local($id) = @_;
458: local($r_e_m_op,*FRAGS,*lastseen,@x) = (@FRAGS[$[+5]);
459:
460: *FRAGS = "$id FRAGS";
461: *lastseen = "$id lastseen";
462:
463: @x=((&pkt_E($r_e_m_op) ? &error_status($status) : "TIMEOUT"),
464: $FRAGS{0},@FRAGS[$[ .. $[+4]);
465: $STAT_frag_timeout++;
466: undef(%FRAGS);
467: undef(@FRAGS);
468: undef($lastseen);
469: delete $ID{$id};
470: return @x;
471: }
472:
473:
474: sub pad
475: {
476: return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
477: }
478:
479: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ntp.pl 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