Annotation of embedaddon/ntp/scripts/monitoring/ntp.pl, revision 1.1.1.1

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>