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
  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;