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
Indexes created Mon Jul 06 00:25:43 UTC 2026