Home | History | Annotate | Line # | Download | only in monitoring
ntp.pl revision 1.1.1.2.6.2 
      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_pps",
    152 		2, "sync_lf_clock",
    153 		3, "sync_hf_clock",
    154 		4, "sync_uhf_clock",
    155 		5, "sync_local_proto",
    156 		6, "sync_ntp",
    157 		7, "sync_udp/time",
    158 		8, "sync_wristwatch",
    159 		9, "sync_telephone",
    160 		"-", "ClockSource",
    161 		);
    162 
    163 %SystemEvent = (0, "event_unspec",
    164 		1, "event_freq_not_set",
    165 		2, "event_freq_set",
    166 		3, "event_spike_detect",
    167 		4, "event_freq_mode",
    168 		5, "event_clock_sync",
    169 		6, "event_restart",
    170 		7, "event_panic_stop",
    171 		8, "event_no_sys_peer",
    172 		9, "event_leap_armed",
    173 		10, "event_leap_disarmed",
    174 		11, "event_leap_event",
    175 		12, "event_clock_step",
    176 		13, "event_kern",
    177 		14, "event_loaded_leaps",
    178 		15, "event_stale_leaps",
    179 		"-", "event",
    180 		);
    181 sub LI
    182 {
    183     &getval(&ssw_LI($_[$[]),*LI);
    184 }
    185 sub ClockSource
    186 {
    187     &getval(&ssw_CS($_[$[]),*ClockSource);
    188 }
    189 
    190 sub SystemEvent
    191 {
    192     &getval(&ssw_SECode($_[$[]),*SystemEvent);
    193 }
    194 
    195 sub system_status
    196 {
    197     return sprintf("%s, %s, %d event%s, %s", &LI($_[$[]), &ClockSource($_[$[]),
    198 		   &ssw_SECnt($_[$[]), ((&ssw_SECnt($_[$[])==1) ? "" : "s"),
    199 		   &SystemEvent($_[$[]));
    200 }
    201 ;#---------------------------------
    202 ;# peer status
    203 ;#
    204 ;# format: |PStat|PSel|PCnt|PCode| Pstat=6bit PSel=2bit PCnt=4bit PCode=4bit
    205 sub psw_PStat_config     { return ($_[$[] & 0x8000) == 0x8000; }
    206 sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
    207 sub psw_PStat_authentic  { return ($_[$[] & 0x2000) == 0x2000; }
    208 sub psw_PStat_reach      { return ($_[$[] & 0x1000) == 0x1000; }
    209 sub psw_PStat_bcast      { return ($_[$[] & 0x0800) == 0x0800; }
    210 sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
    211 sub psw_PSel  { return ($_[$[] >> 8)  & 0x3;  }
    212 sub psw_PCnt  { return ($_[$[] >> 4)  & 0xf; }
    213 sub psw_PCode { return $_[$[] & 0xf; }
    214 
    215 %PeerSelection = (0, "sel_reject",
    216 		  1, "sel_falsetick",
    217 		  2, "sel_excess",
    218 		  3, "sel_outlier",
    219 		  4, "sel_candidate",
    220 		  5, "sel_backup",
    221 		  6, "sel_sys.peer",
    222 		  6, "sel_pps.peer",
    223 		  "-", "PeerSel",
    224 		  );
    225 %PeerEvent = (0, "event_unspec",
    226 	      1, "event_mobilize",
    227 	      2, "event_demobilize",
    228 	      3, "event_unreach",
    229 	      4, "event_reach",
    230 	      5, "event_restart",
    231 	      6, "event_no_reply",
    232 	      7, "event_rate_exceed",
    233 	      8, "event_denied",
    234 	      9, "event_leap_armed",
    235 	      10, "event_sys_peer",
    236 	      11, "event_clock_event",
    237 	      12, "event_bad_auth",
    238 	      13, "event_popcorn",
    239 	      14, "event_intlv_mode",
    240 	      15, "event_intlv_err",
    241 	      "-", "event",
    242 	      );
    243 
    244 sub PeerSelection
    245 {
    246     &getval(&psw_PSel($_[$[]),*PeerSelection);
    247 }
    248 
    249 sub PeerEvent
    250 {
    251     &getval(&psw_PCode($_[$[]),*PeerEvent);
    252 }
    253 
    254 sub peer_status
    255 {
    256     local($x) = ("");
    257     $x .= "config,"     if &psw_PStat_config($_[$[]);
    258     $x .= "authenable," if &psw_PStat_authenable($_[$[]);
    259     $x .= "authentic,"  if &psw_PStat_authentic($_[$[]);
    260     $x .= "reach,"      if &psw_PStat_reach($_[$[]);
    261     $x .= "bcast,"      if &psw_PStat_bcast($_[$[]);
    262 
    263     $x .= sprintf(" %s, %d event%s, %s", &PeerSelection($_[$[]),
    264 		  &psw_PCnt($_[$[]), ((&psw_PCnt($_[$[]) == 1) ? "" : "s"),
    265 		  &PeerEvent($_[$[]));
    266     return $x;
    267 }
    268 
    269 ;#---------------------------------
    270 ;# clock status
    271 ;#
    272 ;# format: |CStat|CEvnt| CStat=8bit CEvnt=8bit
    273 sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
    274 sub csw_CEvnt { return $_[$[] & 0xff; }
    275 
    276 %ClockStatus = (0, "clk_nominal",
    277 		1, "clk_timeout",
    278 		2, "clk_badreply",
    279 		3, "clk_fault",
    280 		4, "clk_badsig",
    281 		5, "clk_baddate",
    282 		6, "clk_badtime",
    283 		"-", "clk",
    284 	       );
    285 
    286 sub clock_status
    287 {
    288     return sprintf("%s, last %s",
    289 		   &getval(&csw_CStat($_[$[]),*ClockStatus),
    290 		   &getval(&csw_CEvnt($_[$[]),*ClockStatus));
    291 }
    292 
    293 ;#---------------------------------
    294 ;# error status
    295 ;#
    296 ;# format: |Err|reserved|  Err=8bit
    297 ;#
    298 sub esw_Err { return ($_[$[] >> 8) & 0xff; }
    299 
    300 %ErrorStatus = (0, "err_unspec",
    301 		1, "err_auth_fail",
    302 		2, "err_invalid_fmt",
    303 		3, "err_invalid_opcode",
    304 		4, "err_unknown_assoc",
    305 		5, "err_unknown_var",
    306 		6, "err_invalid_value",
    307 		7, "err_adm_prohibit",
    308 		);
    309 
    310 sub error_status
    311 {
    312     return sprintf("%s", &getval(&esw_Err($_[$[]),*ErrorStatus));
    313 }
    314 
    315 ;#-----------------------------------------------------------------------------
    316 ;#
    317 ;# cntrl op name translation
    318 
    319 %CntrlOpName = (0, "reserved",
    320 		1, "read_status",
    321 		2, "read_variables",
    322 		3, "write_variables",
    323 		4, "read_clock_variables",
    324 		5, "write_clock_variables",
    325 		6, "set_trap",
    326 		7, "trap_response",
    327 		8, "configure",
    328 		9, "saveconf",
    329 		10, "read_mru",
    330 		11, "read_ordlist",
    331 		12, "rqst_nonce",
    332 		31, "unset_trap", # !!! unofficial !!!
    333 		"-", "cntrlop",
    334 		);
    335 
    336 sub cntrlop_name
    337 {
    338     return &getval($_[$[],*CntrlOpName);
    339 }
    340 
    341 ;#-----------------------------------------------------------------------------
    342 
    343 $STAT_short_pkt = 0;
    344 $STAT_pkt = 0;
    345 
    346 ;# process a NTP control message (response) packet
    347 ;# returns a list ($ret,$data,$status,$associd,$op,$seq,$auth_keyid)
    348 ;#      $ret: undef     --> not yet complete
    349 ;#            ""        --> complete packet received
    350 ;#            "ERROR"   --> error during receive, bad packet, ...
    351 ;#          else        --> error packet - list may contain useful info
    352 
    353 
    354 sub handle_packet
    355 {
    356     local($pkt,$from) = @_;	# parameters
    357     local($len_pkt) = (length($pkt));
    358 ;#    local(*FRAGS,*lastseen);
    359     local($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data);
    360     local($autch_keyid,$auth_cksum);
    361 
    362     $STAT_pkt++;
    363     if ($len_pkt < 12)
    364     {
    365 	$STAT_short_pkt++;
    366 	return ("ERROR","short packet received");
    367     }
    368 
    369     ;# now break packet apart
    370     ($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data) =
    371 	unpack("C2n5a".($len_pkt-12),$pkt);
    372     $data=substr($data,$[,$count);
    373     if ((($len_pkt - 12) - &pad($count,4)) >= 12)
    374     {
    375 	;# looks like an authenticator
    376 	($auth_keyid,$auth_cksum) =
    377 	    unpack("Na8",substr($pkt,$len_pkt-12+$[,12));
    378 	$STAT_auth++;
    379 	;# no checking of auth_cksum (yet ?)
    380     }
    381 
    382     if (&pkt_VN($li_vn_mode) != $NTP_version)
    383     {
    384 	$STAT_bad_version++;
    385 	return ("ERROR","version ".&pkt_VN($li_vn_mode)."packet ignored");
    386     }
    387 
    388     if (&pkt_MODE($li_vn_mode) != $ctrl_mode)
    389     {
    390 	$STAT_bad_mode++;
    391 	return ("ERROR", "mode ".&pkt_MODE($li_vn_mode)." packet ignored");
    392     }
    393     
    394     ;# handle single fragment fast
    395     if ($offset == 0 && &pkt_M($r_e_m_op) == 0)
    396     {
    397 	$STAT_single_frag++;
    398 	if (&pkt_E($r_e_m_op))
    399 	{
    400 	    $STAT_err_pkt++;
    401 	    return (&error_status($status),
    402 		    $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
    403 		    $auth_keyid);
    404 	}
    405 	else
    406 	{
    407 	    return ("",
    408 		    $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
    409 		    $auth_keyid);
    410 	}
    411     }
    412     else
    413     {
    414 	;# fragment - set up local name space
    415 	$id = "$from$seq".&pkt_OP($r_e_m_op);
    416 	$ID{$id} = 1;
    417 	*FRAGS = "$id FRAGS";
    418 	*lastseen = "$id lastseen";
    419 	
    420 	$STAT_frag++;
    421 	
    422 	$lastseen = 1 if !&pkt_M($r_e_m_op);
    423 	if (!%FRAGS)
    424 	{
    425 	    print((&pkt_M($r_e_m_op) ? " more" : "")."\n");
    426 	    $FRAGS{$offset} = $data;
    427 	    ;# save other info
    428 	    @FRAGS = ($status,$associd,&pkt_OP($r_e_m_op),$seq,$auth_keyid,$r_e_m_op);
    429 	}
    430 	else
    431 	{
    432 	    print((&pkt_M($r_e_m_op) ? " more" : "")."\n");
    433 	    ;# add frag to previous - combine on the fly
    434 	    if (defined($FRAGS{$offset}))
    435 	    {
    436 		$STAT_dup_frag++;
    437 		return ("ERROR","duplicate fragment at $offset seq=$seq");
    438 	    }
    439 	    
    440 	    $FRAGS{$offset} = $data;
    441 	    
    442 	    undef($loff);
    443 	    foreach $off (sort numerical keys(%FRAGS))
    444 	    {
    445 		next unless defined($FRAGS{$off});
    446 		if (defined($loff) &&
    447 		    ($loff + length($FRAGS{$loff})) == $off)
    448 		{
    449 		    $FRAGS{$loff} .= $FRAGS{$off};
    450 		    delete $FRAGS{$off};
    451 		    last;
    452 		}
    453 		$loff = $off;
    454 	    }
    455 
    456 	    ;# return packet if all frags arrived
    457 	    ;# at most two frags with possible padding ???
    458 	    if ($lastseen && defined($FRAGS{0}) &&
    459 		(((scalar(@x=sort numerical keys(%FRAGS)) == 2) &&
    460 		  (length($FRAGS{0}) + 8) > $x[$[+1]) ||
    461 		  (scalar(@x=sort numerical keys(%FRAGS)) < 2)))
    462 	    {
    463 		@x=((&pkt_E($r_e_m_op) ? &error_status($status) : ""),
    464 		    $FRAGS{0},@FRAGS);
    465 		&pkt_E($r_e_m_op) ? $STAT_err_frag++ : $STAT_frag_all++;
    466 		undef(%FRAGS);
    467 		undef(@FRAGS);
    468 		undef($lastseen);
    469 		delete $ID{$id};
    470 		&main'clear_timeout($id);
    471 		return @x;
    472 	    }
    473 	    else
    474 	    {
    475 		&main'set_timeout($id,time+$timeout,"&ntp'handle_packet_timeout(\"".unpack("H*",$id)."\");"); #'";
    476 	    }
    477 	}
    478 	return (undef);
    479     }
    480 }
    481 
    482 sub handle_packet_timeout
    483 {
    484     local($id) = @_;
    485     local($r_e_m_op,*FRAGS,*lastseen,@x) = (@FRAGS[$[+5]);
    486     
    487     *FRAGS = "$id FRAGS";
    488     *lastseen = "$id lastseen";
    489     
    490     @x=((&pkt_E($r_e_m_op) ? &error_status($status) : "TIMEOUT"),
    491 	$FRAGS{0},@FRAGS[$[ .. $[+4]);
    492     $STAT_frag_timeout++;
    493     undef(%FRAGS);
    494     undef(@FRAGS);
    495     undef($lastseen);
    496     delete $ID{$id};
    497     return @x;
    498 }
    499 
    500 
    501 sub pad
    502 {
    503     return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
    504 }
    505 
    506 1;
    507