diff options
Diffstat (limited to 'contrib/ntp/scripts/monitoring/ntp.pl')
-rw-r--r-- | contrib/ntp/scripts/monitoring/ntp.pl | 478 |
1 files changed, 478 insertions, 0 deletions
diff --git a/contrib/ntp/scripts/monitoring/ntp.pl b/contrib/ntp/scripts/monitoring/ntp.pl new file mode 100644 index 0000000..ea9e69c --- /dev/null +++ b/contrib/ntp/scripts/monitoring/ntp.pl @@ -0,0 +1,478 @@ +#!/local/bin/perl +;# +;# ntp.pl,v 3.1 1993/07/06 01:09:09 jbj Exp +;# +;# process loop filter statistics file and either +;# - show statistics periodically using gnuplot +;# - or print a single plot +;# +;# Copyright (c) 1992 +;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg +;# +;# +;############################################################# + +package ntp; + +$NTP_version = 2; +$ctrl_mode=6; + +$byte1 = (($NTP_version & 0x7)<< 3) & 0x34 | ($ctrl_mode & 0x7); +$MAX_DATA = 468; + +$sequence = 0; # initial sequence number incred before used +$pad=4; +$do_auth=0; # no possibility today +$keyid=0; +;#list if known keys (passwords) +%KEYS = ( 0, "\200\200\200\200\200\200\200\200", + ); + +;#----------------------------------------------------------------------------- +;# access routines for ntp control packet + ;# NTP control message format + ;# C LI|VN|MODE LI 2bit=00 VN 3bit=2(3) MODE 3bit=6 : $byte1 + ;# C R|E|M|Op R response E error M more Op opcode + ;# n sequence + ;# n status + ;# n associd + ;# n offset + ;# n count + ;# a+ data (+ padding) + ;# optional authentication data + ;# N key + ;# N2 checksum + +;# first bye of packet +sub pkt_LI { return ($_[$[] >> 6) & 0x3; } +sub pkt_VN { return ($_[$[] >> 3) & 0x7; } +sub pkt_MODE { return ($_[$[] ) & 0x7; } + +;# second byte of packet +sub pkt_R { return ($_[$[] & 0x80) == 0x80; } +sub pkt_E { return ($_[$[] & 0x40) == 0x40; } +sub pkt_M { return ($_[$[] & 0x20) == 0x20; } +sub pkt_OP { return $_[$[] & 0x1f; } + +;#----------------------------------------------------------------------------- + +sub setkey +{ + local($id,$key) = @_; + + $KEYS{$id} = $key if (defined($key)); + if (! defined($KEYS{$id})) + { + warn "Key $id not yet specified - key not changed\n"; + return undef; + } + return ($keyid,$keyid = $id)[$[]; +} + +;#----------------------------------------------------------------------------- +sub numerical { $a <=> $b; } + +;#----------------------------------------------------------------------------- + +sub send #' +{ + local($fh,$opcode, $associd, $data,$address) = @_; + $fh = caller(0)."'$fh"; + + local($junksize,$junk,$packet,$offset,$ret); + $offset = 0; + + $sequence++; + while(1) + { + $junksize = length($data); + $junksize = $MAX_DATA if $junksize > $MAX_DATA; + + ($junk,$data) = $data =~ /^(.{$junksize})(.*)$/; + $packet + = pack("C2n5a".(($junk eq "") ? 0 : &pad($junksize+12,$pad)-12), + $byte1, + ($opcode & 0x1f) | ($data ? 0x20 : 0), + $sequence, + 0, $associd, + $offset, $junksize, $junk); + if ($do_auth) + { + ;# not yet + } + $offset += $junksize; + + if (defined($address)) + { + $ret = send($fh, $packet, 0, $address); + } + else + { + $ret = send($fh, $packet, 0); + } + + if (! defined($ret)) + { + warn "send failed: $!\n"; + return undef; + } + elsif ($ret != length($packet)) + { + warn "send failed: sent only $ret from ".length($packet). "bytes\n"; + return undef; + } + return $sequence unless $data; + } +} + +;#----------------------------------------------------------------------------- +;# status interpretation +;# +sub getval +{ + local($val,*list) = @_; + + return $list{$val} if defined($list{$val}); + return sprintf("%s#%d",$list{"-"},$val) if defined($list{"-"}); + return "unknown-$val"; +} + +;#--------------------------------- +;# system status +;# +;# format: |LI|CS|SECnt|SECode| LI=2bit CS=6bit SECnt=4bit SECode=4bit +sub ssw_LI { return ($_[$[] >> 14) & 0x3; } +sub ssw_CS { return ($_[$[] >> 8) & 0x3f; } +sub ssw_SECnt { return ($_[$[] >> 4) & 0xf; } +sub ssw_SECode { return $_[$[] & 0xf; } + +%LI = ( 0, "leap_none", 1, "leap_add_sec", 2, "leap_del_sec", 3, "sync_alarm", "-", "leap"); +%ClockSource = (0, "sync_unspec", + 1, "sync_lf_clock", + 2, "sync_uhf_clock", + 3, "sync_hf_clock", + 4, "sync_local_proto", + 5, "sync_ntp", + 6, "sync_udp/time", + 7, "sync_wristwatch", + "-", "ClockSource", + ); + +%SystemEvent = (0, "event_unspec", + 1, "event_restart", + 2, "event_fault", + 3, "event_sync_chg", + 4, "event_sync/strat_chg", + 5, "event_clock_reset", + 6, "event_bad_date", + 7, "event_clock_excptn", + "-", "event", + ); +sub LI +{ + &getval(&ssw_LI($_[$[]),*LI); +} +sub ClockSource +{ + &getval(&ssw_CS($_[$[]),*ClockSource); +} + +sub SystemEvent +{ + &getval(&ssw_SECode($_[$[]),*SystemEvent); +} + +sub system_status +{ + return sprintf("%s, %s, %d event%s, %s", &LI($_[$[]), &ClockSource($_[$[]), + &ssw_SECnt($_[$[]), ((&ssw_SECnt($_[$[])==1) ? "" : "s"), + &SystemEvent($_[$[])); +} +;#--------------------------------- +;# peer status +;# +;# format: |PStat|PSel|PCnt|PCode| Pstat=6bit PSel=2bit PCnt=4bit PCode=4bit +sub psw_PStat_config { return ($_[$[] & 0x8000) == 0x8000; } +sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; } +sub psw_PStat_authentic { return ($_[$[] & 0x2000) == 0x2000; } +sub psw_PStat_reach { return ($_[$[] & 0x1000) == 0x1000; } +sub psw_PStat_sane { return ($_[$[] & 0x0800) == 0x0800; } +sub psw_PStat_dispok { return ($_[$[] & 0x0400) == 0x0400; } +sub psw_PStat { return ($_[$[] >> 10) & 0x3f; } +sub psw_PSel { return ($_[$[] >> 8) & 0x3; } +sub psw_PCnt { return ($_[$[] >> 4) & 0xf; } +sub psw_PCode { return $_[$[] & 0xf; } + +%PeerSelection = (0, "sel_reject", + 1, "sel_candidate", + 2, "sel_selcand", + 3, "sel_sys.peer", + "-", "PeerSel", + ); +%PeerEvent = (0, "event_unspec", + 1, "event_ip_err", + 2, "event_authen", + 3, "event_unreach", + 4, "event_reach", + 5, "event_clock_excptn", + 6, "event_stratum_chg", + "-", "event", + ); + +sub PeerSelection +{ + &getval(&psw_PSel($_[$[]),*PeerSelection); +} +sub PeerEvent +{ + &getval(&psw_PCode($_[$[]),*PeerEvent); +} + +sub peer_status +{ + local($x) = (""); + $x .= "config," if &psw_PStat_config($_[$[]); + $x .= "authenable," if &psw_PStat_authenable($_[$[]); + $x .= "authentic," if &psw_PStat_authentic($_[$[]); + $x .= "reach," if &psw_PStat_reach($_[$[]); + $x .= &psw_PStat_sane($_[$[]) ? "sane," : "insane,"; + $x .= "hi_disp," unless &psw_PStat_dispok($_[$[]); + + $x .= sprintf(" %s, %d event%s, %s", &PeerSelection($_[$[]), + &psw_PCnt($_[$[]), ((&psw_PCnt($_[$[]) == 1) ? "" : "s"), + &PeerEvent($_[$[])); + return $x; +} + +;#--------------------------------- +;# clock status +;# +;# format: |CStat|CEvnt| CStat=8bit CEvnt=8bit +sub csw_CStat { return ($_[$[] >> 8) & 0xff; } +sub csw_CEvnt { return $_[$[] & 0xff; } + +%ClockStatus = (0, "clk_nominal", + 1, "clk_timeout", + 2, "clk_badreply", + 3, "clk_fault", + 4, "clk_prop", + 5, "clk_baddate", + 6, "clk_badtime", + "-", "clk", + ); + +sub clock_status +{ + return sprintf("%s, last %s", + &getval(&csw_CStat($_[$[]),*ClockStatus), + &getval(&csw_CEvnt($_[$[]),*ClockStatus)); +} + +;#--------------------------------- +;# error status +;# +;# format: |Err|reserved| Err=8bit +;# +sub esw_Err { return ($_[$[] >> 8) & 0xff; } + +%ErrorStatus = (0, "err_unspec", + 1, "err_auth_fail", + 2, "err_invalid_fmt", + 3, "err_invalid_opcode", + 4, "err_unknown_assoc", + 5, "err_unknown_var", + 6, "err_invalid_value", + 7, "err_adm_prohibit", + ); + +sub error_status +{ + return sprintf("%s", &getval(&esw_Err($_[$[]),*ErrorStatus)); +} + +;#----------------------------------------------------------------------------- +;# +;# cntrl op name translation + +%CntrlOpName = (1, "read_status", + 2, "read_variables", + 3, "write_variables", + 4, "read_clock_variables", + 5, "write_clock_variables", + 6, "set_trap", + 7, "trap_response", + 31, "unset_trap", # !!! unofficial !!! + "-", "cntrlop", + ); + +sub cntrlop_name +{ + return &getval($_[$[],*CntrlOpName); +} + +;#----------------------------------------------------------------------------- + +$STAT_short_pkt = 0; +$STAT_pkt = 0; + +;# process a NTP control message (response) packet +;# returns a list ($ret,$data,$status,$associd,$op,$seq,$auth_keyid) +;# $ret: undef --> not yet complete +;# "" --> complete packet received +;# "ERROR" --> error during receive, bad packet, ... +;# else --> error packet - list may contain useful info + + +sub handle_packet +{ + local($pkt,$from) = @_; # parameters + local($len_pkt) = (length($pkt)); +;# local(*FRAGS,*lastseen); + local($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data); + local($autch_keyid,$auth_cksum); + + $STAT_pkt++; + if ($len_pkt < 12) + { + $STAT_short_pkt++; + return ("ERROR","short packet received"); + } + + ;# now break packet apart + ($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data) = + unpack("C2n5a".($len_pkt-12),$pkt); + $data=substr($data,$[,$count); + if ((($len_pkt - 12) - &pad($count,4)) >= 12) + { + ;# looks like an authenticator + ($auth_keyid,$auth_cksum) = + unpack("Na8",substr($pkt,$len_pkt-12+$[,12)); + $STAT_auth++; + ;# no checking of auth_cksum (yet ?) + } + + if (&pkt_VN($li_vn_mode) != $NTP_version) + { + $STAT_bad_version++; + return ("ERROR","version ".&pkt_VN($li_vn_mode)."packet ignored"); + } + + if (&pkt_MODE($li_vn_mode) != $ctrl_mode) + { + $STAT_bad_mode++; + return ("ERROR", "mode ".&pkt_MODE($li_vn_mode)." packet ignored"); + } + + ;# handle single fragment fast + if ($offset == 0 && &pkt_M($r_e_m_op) == 0) + { + $STAT_single_frag++; + if (&pkt_E($r_e_m_op)) + { + $STAT_err_pkt++; + return (&error_status($status), + $data,$status,$associd,&pkt_OP($r_e_m_op),$seq, + $auth_keyid); + } + else + { + return ("", + $data,$status,$associd,&pkt_OP($r_e_m_op),$seq, + $auth_keyid); + } + } + else + { + ;# fragment - set up local name space + $id = "$from$seq".&pkt_OP($r_e_m_op); + $ID{$id} = 1; + *FRAGS = "$id FRAGS"; + *lastseen = "$id lastseen"; + + $STAT_frag++; + + $lastseen = 1 if !&pkt_M($r_e_m_op); + if (!defined(%FRAGS)) + { + # (&pkt_M($r_e_m_op) ? " more" : "")."\n"; + $FRAGS{$offset} = $data; + ;# save other info + @FRAGS = ($status,$associd,&pkt_OP($r_e_m_op),$seq,$auth_keyid,$r_e_m_op); + } + else + { + # (&pkt_M($r_e_m_op) ? " more" : "")."\n"; + ;# add frag to previous - combine on the fly + if (defined($FRAGS{$offset})) + { + $STAT_dup_frag++; + return ("ERROR","duplicate fragment at $offset seq=$seq"); + } + + $FRAGS{$offset} = $data; + + undef($loff); + foreach $off (sort numerical keys(%FRAGS)) + { + next unless defined($FRAGS{$off}); + if (defined($loff) && + ($loff + length($FRAGS{$loff})) == $off) + { + $FRAGS{$loff} .= $FRAGS{$off}; + delete $FRAGS{$off}; + last; + } + $loff = $off; + } + + ;# return packet if all frags arrived + ;# at most two frags with possible padding ??? + if ($lastseen && defined($FRAGS{0}) && + (((scalar(@x=sort numerical keys(%FRAGS)) == 2) && + (length($FRAGS{0}) + 8) > $x[$[+1]) || + (scalar(@x=sort numerical keys(%FRAGS)) < 2))) + { + @x=((&pkt_E($r_e_m_op) ? &error_status($status) : ""), + $FRAGS{0},@FRAGS); + &pkt_E($r_e_m_op) ? $STAT_err_frag++ : $STAT_frag_all++; + undef(%FRAGS); + undef(@FRAGS); + undef($lastseen); + delete $ID{$id}; + &main'clear_timeout($id); + return @x; + } + else + { + &main'set_timeout($id,time+$timeout,"&ntp'handle_packet_timeout(\"".unpack("H*",$id)."\");"); #'"; + } + } + return (undef); + } +} + +sub handle_packet_timeout +{ + local($id) = @_; + local($r_e_m_op,*FRAGS,*lastseen,@x) = (@FRAGS[$[+5]); + + *FRAGS = "$id FRAGS"; + *lastseen = "$id lastseen"; + + @x=((&pkt_E($r_e_m_op) ? &error_status($status) : "TIMEOUT"), + $FRAGS{0},@FRAGS[$[ .. $[+4]); + $STAT_frag_timeout++; + undef(%FRAGS); + undef(@FRAGS); + undef($lastseen); + delete $ID{$id}; + return @x; +} + + +sub pad +{ + return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]); +} + +1; |