/contrib/ntp/scripts/monitoring/ntp.pl

  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
 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 byte 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}
226
227sub PeerEvent
228{
229    &getval(&psw_PCode($_[$[]),*PeerEvent);
230}
231
232sub 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
252sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
253sub 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
265sub 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;#
277sub 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
289sub 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
309sub 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
327sub 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
455sub 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
474sub pad
475{
476    return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
477}
478
4791;