ntp.pl revision 54359 
1#!/local/bin/perl
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
15package 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 bye of packet
47sub pkt_LI   { return ($_[$[] >> 6) & 0x3; }
48sub pkt_VN   { return ($_[$[] >> 3) & 0x7; }
49sub pkt_MODE { return ($_[$[]     ) & 0x7; }
50
51;# second byte of packet
52sub pkt_R  { return ($_[$[] & 0x80) == 0x80; }
53sub pkt_E  { return ($_[$[] & 0x40) == 0x40; }
54sub pkt_M  { return ($_[$[] & 0x20) == 0x20; }
55sub pkt_OP { return $_[$[] & 0x1f; }
56
57;#-----------------------------------------------------------------------------
58
59sub 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;#-----------------------------------------------------------------------------
73sub numerical { $a <=> $b; }
74
75;#-----------------------------------------------------------------------------
76
77sub 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;#
131sub 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
144sub ssw_LI     { return ($_[$[] >> 14) & 0x3; }
145sub ssw_CS     { return ($_[$[] >> 8)  & 0x3f; }
146sub ssw_SECnt  { return ($_[$[] >> 4)  & 0xf; }
147sub 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		);
171sub LI
172{
173    &getval(&ssw_LI($_[$[]),*LI);
174}
175sub ClockSource
176{
177    &getval(&ssw_CS($_[$[]),*ClockSource);
178}
179
180sub SystemEvent
181{
182    &getval(&ssw_SECode($_[$[]),*SystemEvent);
183}
184
185sub 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
195sub psw_PStat_config     { return ($_[$[] & 0x8000) == 0x8000; }
196sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
197sub psw_PStat_authentic  { return ($_[$[] & 0x2000) == 0x2000; }
198sub psw_PStat_reach      { return ($_[$[] & 0x1000) == 0x1000; }
199sub psw_PStat_sane       { return ($_[$[] & 0x0800) == 0x0800; }
200sub psw_PStat_dispok     { return ($_[$[] & 0x0400) == 0x0400; }
201sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
202sub psw_PSel  { return ($_[$[] >> 8)  & 0x3;  }
203sub psw_PCnt  { return ($_[$[] >> 4)  & 0xf; }
204sub 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
222sub PeerSelection
223{
224    &getval(&psw_PSel($_[$[]),*PeerSelection);
225}
226sub PeerEvent
227{
228    &getval(&psw_PCode($_[$[]),*PeerEvent);
229}
230
231sub peer_status
232{
233    local($x) = ("");
234    $x .= "config,"     if &psw_PStat_config($_[$[]);
235    $x .= "authenable," if &psw_PStat_authenable($_[$[]);
236    $x .= "authentic,"  if &psw_PStat_authentic($_[$[]);
237    $x .= "reach,"      if &psw_PStat_reach($_[$[]);
238    $x .= &psw_PStat_sane($_[$[]) ? "sane," : "insane,";
239    $x .= "hi_disp," unless &psw_PStat_dispok($_[$[]);
240
241    $x .= sprintf(" %s, %d event%s, %s", &PeerSelection($_[$[]),
242		  &psw_PCnt($_[$[]), ((&psw_PCnt($_[$[]) == 1) ? "" : "s"),
243		  &PeerEvent($_[$[]));
244    return $x;
245}
246
247;#---------------------------------
248;# clock status
249;#
250;# format: |CStat|CEvnt| CStat=8bit CEvnt=8bit
251sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
252sub csw_CEvnt { return $_[$[] & 0xff; }
253
254%ClockStatus = (0, "clk_nominal",
255		1, "clk_timeout",
256		2, "clk_badreply",
257		3, "clk_fault",
258		4, "clk_prop",
259		5, "clk_baddate",
260		6, "clk_badtime",
261		"-", "clk",
262	       );
263
264sub clock_status
265{
266    return sprintf("%s, last %s",
267		   &getval(&csw_CStat($_[$[]),*ClockStatus),
268		   &getval(&csw_CEvnt($_[$[]),*ClockStatus));
269}
270
271;#---------------------------------
272;# error status
273;#
274;# format: |Err|reserved|  Err=8bit
275;#
276sub esw_Err { return ($_[$[] >> 8) & 0xff; }
277
278%ErrorStatus = (0, "err_unspec",
279		1, "err_auth_fail",
280		2, "err_invalid_fmt",
281		3, "err_invalid_opcode",
282		4, "err_unknown_assoc",
283		5, "err_unknown_var",
284		6, "err_invalid_value",
285		7, "err_adm_prohibit",
286		);
287
288sub error_status
289{
290    return sprintf("%s", &getval(&esw_Err($_[$[]),*ErrorStatus));
291}
292
293;#-----------------------------------------------------------------------------
294;#
295;# cntrl op name translation
296
297%CntrlOpName = (1, "read_status",
298		2, "read_variables",
299		3, "write_variables",
300		4, "read_clock_variables",
301		5, "write_clock_variables",
302		6, "set_trap",
303		7, "trap_response",
304		31, "unset_trap", # !!! unofficial !!!
305		"-", "cntrlop",
306		);
307
308sub cntrlop_name
309{
310    return &getval($_[$[],*CntrlOpName);
311}
312
313;#-----------------------------------------------------------------------------
314
315$STAT_short_pkt = 0;
316$STAT_pkt = 0;
317
318;# process a NTP control message (response) packet
319;# returns a list ($ret,$data,$status,$associd,$op,$seq,$auth_keyid)
320;#      $ret: undef     --> not yet complete
321;#            ""        --> complete packet received
322;#            "ERROR"   --> error during receive, bad packet, ...
323;#          else        --> error packet - list may contain useful info
324
325
326sub handle_packet
327{
328    local($pkt,$from) = @_;	# parameters
329    local($len_pkt) = (length($pkt));
330;#    local(*FRAGS,*lastseen);
331    local($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data);
332    local($autch_keyid,$auth_cksum);
333
334    $STAT_pkt++;
335    if ($len_pkt < 12)
336    {
337	$STAT_short_pkt++;
338	return ("ERROR","short packet received");
339    }
340
341    ;# now break packet apart
342    ($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data) =
343	unpack("C2n5a".($len_pkt-12),$pkt);
344    $data=substr($data,$[,$count);
345    if ((($len_pkt - 12) - &pad($count,4)) >= 12)
346    {
347	;# looks like an authenticator
348	($auth_keyid,$auth_cksum) =
349	    unpack("Na8",substr($pkt,$len_pkt-12+$[,12));
350	$STAT_auth++;
351	;# no checking of auth_cksum (yet ?)
352    }
353
354    if (&pkt_VN($li_vn_mode) != $NTP_version)
355    {
356	$STAT_bad_version++;
357	return ("ERROR","version ".&pkt_VN($li_vn_mode)."packet ignored");
358    }
359
360    if (&pkt_MODE($li_vn_mode) != $ctrl_mode)
361    {
362	$STAT_bad_mode++;
363	return ("ERROR", "mode ".&pkt_MODE($li_vn_mode)." packet ignored");
364    }
365
366    ;# handle single fragment fast
367    if ($offset == 0 && &pkt_M($r_e_m_op) == 0)
368    {
369	$STAT_single_frag++;
370	if (&pkt_E($r_e_m_op))
371	{
372	    $STAT_err_pkt++;
373	    return (&error_status($status),
374		    $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
375		    $auth_keyid);
376	}
377	else
378	{
379	    return ("",
380		    $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
381		    $auth_keyid);
382	}
383    }
384    else
385    {
386	;# fragment - set up local name space
387	$id = "$from$seq".&pkt_OP($r_e_m_op);
388	$ID{$id} = 1;
389	*FRAGS = "$id FRAGS";
390	*lastseen = "$id lastseen";
391
392	$STAT_frag++;
393
394	$lastseen = 1 if !&pkt_M($r_e_m_op);
395	if (!defined(%FRAGS))
396	{
397	    # (&pkt_M($r_e_m_op) ? " more" : "")."\n";
398	    $FRAGS{$offset} = $data;
399	    ;# save other info
400	    @FRAGS = ($status,$associd,&pkt_OP($r_e_m_op),$seq,$auth_keyid,$r_e_m_op);
401	}
402	else
403	{
404	    # (&pkt_M($r_e_m_op) ? " more" : "")."\n";
405	    ;# add frag to previous - combine on the fly
406	    if (defined($FRAGS{$offset}))
407	    {
408		$STAT_dup_frag++;
409		return ("ERROR","duplicate fragment at $offset seq=$seq");
410	    }
411
412	    $FRAGS{$offset} = $data;
413
414	    undef($loff);
415	    foreach $off (sort numerical keys(%FRAGS))
416	    {
417		next unless defined($FRAGS{$off});
418		if (defined($loff) &&
419		    ($loff + length($FRAGS{$loff})) == $off)
420		{
421		    $FRAGS{$loff} .= $FRAGS{$off};
422		    delete $FRAGS{$off};
423		    last;
424		}
425		$loff = $off;
426	    }
427
428	    ;# return packet if all frags arrived
429	    ;# at most two frags with possible padding ???
430	    if ($lastseen && defined($FRAGS{0}) &&
431		(((scalar(@x=sort numerical keys(%FRAGS)) == 2) &&
432		  (length($FRAGS{0}) + 8) > $x[$[+1]) ||
433		  (scalar(@x=sort numerical keys(%FRAGS)) < 2)))
434	    {
435		@x=((&pkt_E($r_e_m_op) ? &error_status($status) : ""),
436		    $FRAGS{0},@FRAGS);
437		&pkt_E($r_e_m_op) ? $STAT_err_frag++ : $STAT_frag_all++;
438		undef(%FRAGS);
439		undef(@FRAGS);
440		undef($lastseen);
441		delete $ID{$id};
442		&main'clear_timeout($id);
443		return @x;
444	    }
445	    else
446	    {
447		&main'set_timeout($id,time+$timeout,"&ntp'handle_packet_timeout(\"".unpack("H*",$id)."\");"); #'";
448	    }
449	}
450	return (undef);
451    }
452}
453
454sub handle_packet_timeout
455{
456    local($id) = @_;
457    local($r_e_m_op,*FRAGS,*lastseen,@x) = (@FRAGS[$[+5]);
458
459    *FRAGS = "$id FRAGS";
460    *lastseen = "$id lastseen";
461
462    @x=((&pkt_E($r_e_m_op) ? &error_status($status) : "TIMEOUT"),
463	$FRAGS{0},@FRAGS[$[ .. $[+4]);
464    $STAT_frag_timeout++;
465    undef(%FRAGS);
466    undef(@FRAGS);
467    undef($lastseen);
468    delete $ID{$id};
469    return @x;
470}
471
472
473sub pad
474{
475    return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
476}
477
4781;
479