dist/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_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                 );
 171 sub LI
 172 {
 173     &getval(&ssw_LI($_[$[]),*LI);
 174 }
 175 sub ClockSource
 176 {
 177     &getval(&ssw_CS($_[$[]),*ClockSource);
 178 }
 179
 180 sub SystemEvent
 181 {
 182     &getval(&ssw_SECode($_[$[]),*SystemEvent);
 183 }
 184
 185 sub 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
 195 sub psw_PStat_config     { return ($_[$[] & 0x8000) == 0x8000; }
 196 sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
 197 sub psw_PStat_authentic  { return ($_[$[] & 0x2000) == 0x2000; }
 198 sub psw_PStat_reach      { return ($_[$[] & 0x1000) == 0x1000; }
 199 sub psw_PStat_sane       { return ($_[$[] & 0x0800) == 0x0800; }
 200 sub psw_PStat_dispok     { return ($_[$[] & 0x0400) == 0x0400; }
 201 sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
 202 sub psw_PSel  { return ($_[$[] >> 8)  & 0x3;  }
 203 sub psw_PCnt  { return ($_[$[] >> 4)  & 0xf; }
 204 sub 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
 222 sub PeerSelection
 223 {
 224     &getval(&psw_PSel($_[$[]),*PeerSelection);
 225 }
 226
 227 sub PeerEvent
 228 {
 229     &getval(&psw_PCode($_[$[]),*PeerEvent);
 230 }
 231
 232 sub 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
 252 sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
 253 sub 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
 265 sub 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 ;#
 277 sub 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
 289 sub 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
 309 sub 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
 327 sub 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
 455 sub 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
 474 sub pad
 475 {
 476     return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
 477 }
 478
 479 1;