source: trunk/third/xntp/scripts/monitoring/ntp.pl @ 10832

Revision 10832, 11.4 KB checked in by brlewis, 27 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r10831, which included commits to RCS files with non-trunk default branches.
  • Property svn:executable set to *
Line 
1#!/local/bin/perl
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
15package 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 bye of packet
47sub pkt_LI   { return ($_[$[] >> 6) & 0x3; }
48sub pkt_VN   { return ($_[$[] >> 3) & 0x7; }
49sub pkt_MODE { return ($_[$[]     ) & 0x7; }
50
51;# second byte of packet
52sub pkt_R  { return ($_[$[] & 0x80) == 0x80; }
53sub pkt_E  { return ($_[$[] & 0x40) == 0x40; }
54sub pkt_M  { return ($_[$[] & 0x20) == 0x20; }
55sub pkt_OP { return $_[$[] & 0x1f; }
56
57;#-----------------------------------------------------------------------------
58
59sub 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;#-----------------------------------------------------------------------------
73sub numerical { $a <=> $b; }
74
75;#-----------------------------------------------------------------------------
76
77sub 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;#
131sub 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
144sub ssw_LI     { return ($_[$[] >> 14) & 0x3; }
145sub ssw_CS     { return ($_[$[] >> 8)  & 0x3f; }
146sub ssw_SECnt  { return ($_[$[] >> 4)  & 0xf; }
147sub 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                );
171sub LI
172{
173    &getval(&ssw_LI($_[$[]),*LI);
174}
175sub ClockSource
176{
177    &getval(&ssw_CS($_[$[]),*ClockSource);
178}
179
180sub SystemEvent
181{
182    &getval(&ssw_SECode($_[$[]),*SystemEvent);
183}
184
185sub 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
195sub psw_PStat_config     { return ($_[$[] & 0x8000) == 0x8000; }
196sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
197sub psw_PStat_authentic  { return ($_[$[] & 0x2000) == 0x2000; }
198sub psw_PStat_reach      { return ($_[$[] & 0x1000) == 0x1000; }
199sub psw_PStat_sane       { return ($_[$[] & 0x0800) == 0x0800; }
200sub psw_PStat_dispok     { return ($_[$[] & 0x0400) == 0x0400; }
201sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
202sub psw_PSel  { return ($_[$[] >> 8)  & 0x3;  }
203sub psw_PCnt  { return ($_[$[] >> 4)  & 0xf; }
204sub 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
222sub PeerSelection
223{
224    &getval(&psw_PSel($_[$[]),*PeerSelection);
225}
226sub PeerEvent
227{
228    &getval(&psw_PCode($_[$[]),*PeerEvent);
229}
230
231sub peer_status
232{
233    local($x) = ("");
234    $x .= "config,"     if &psw_PStat_config($_[$[]);
235    $x .= "authenable," if &psw_PStat_authenable($_[$[]);
236    $x .= "authentic,"  if &psw_PStat_authentic($_[$[]);
237    $x .= "reach,"      if &psw_PStat_reach($_[$[]);
238    $x .= &psw_PStat_sane($_[$[]) ? "sane," : "insane,";
239    $x .= "hi_disp," unless &psw_PStat_dispok($_[$[]);
240
241    $x .= sprintf(" %s, %d event%s, %s", &PeerSelection($_[$[]),
242                  &psw_PCnt($_[$[]), ((&psw_PCnt($_[$[]) == 1) ? "" : "s"),
243                  &PeerEvent($_[$[]));
244    return $x;
245}
246
247;#---------------------------------
248;# clock status
249;#
250;# format: |CStat|CEvnt| CStat=8bit CEvnt=8bit
251sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
252sub csw_CEvnt { return $_[$[] & 0xff; }
253
254%ClockStatus = (0, "clk_nominal",
255                1, "clk_timeout",
256                2, "clk_badreply",
257                3, "clk_fault",
258                4, "clk_prop",
259                5, "clk_baddate",
260                6, "clk_badtime",
261                "-", "clk",
262               );
263
264sub clock_status
265{
266    return sprintf("%s, last %s",
267                   &getval(&csw_CStat($_[$[]),*ClockStatus),
268                   &getval(&csw_CEvnt($_[$[]),*ClockStatus));
269}
270
271;#---------------------------------
272;# error status
273;#
274;# format: |Err|reserved|  Err=8bit
275;#
276sub esw_Err { return ($_[$[] >> 8) & 0xff; }
277
278%ErrorStatus = (0, "err_unspec",
279                1, "err_auth_fail",
280                2, "err_invalid_fmt",
281                3, "err_invalid_opcode",
282                4, "err_unknown_assoc",
283                5, "err_unknown_var",
284                6, "err_invalid_value",
285                7, "err_adm_prohibit",
286                );
287
288sub error_status
289{
290    return sprintf("%s", &getval(&esw_Err($_[$[]),*ErrorStatus));
291}
292
293;#-----------------------------------------------------------------------------
294;#
295;# cntrl op name translation
296
297%CntrlOpName = (1, "read_status",
298                2, "read_variables",
299                3, "write_variables",
300                4, "read_clock_variables",
301                5, "write_clock_variables",
302                6, "set_trap",
303                7, "trap_response",
304                31, "unset_trap", # !!! unofficial !!!
305                "-", "cntrlop",
306                );
307
308sub cntrlop_name
309{
310    return &getval($_[$[],*CntrlOpName);
311}
312
313;#-----------------------------------------------------------------------------
314
315$STAT_short_pkt = 0;
316$STAT_pkt = 0;
317
318;# process a NTP control message (response) packet
319;# returns a list ($ret,$data,$status,$associd,$op,$seq,$auth_keyid)
320;#      $ret: undef     --> not yet complete
321;#            ""        --> complete packet received
322;#            "ERROR"   --> error during receive, bad packet, ...
323;#          else        --> error packet - list may contain useful info
324
325
326sub handle_packet
327{
328    local($pkt,$from) = @_;     # parameters
329    local($len_pkt) = (length($pkt));
330;#    local(*FRAGS,*lastseen);
331    local($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data);
332    local($autch_keyid,$auth_cksum);
333
334    $STAT_pkt++;
335    if ($len_pkt < 12)
336    {
337        $STAT_short_pkt++;
338        return ("ERROR","short packet received");
339    }
340
341    ;# now break packet apart
342    ($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data) =
343        unpack("C2n5a".($len_pkt-12),$pkt);
344    $data=substr($data,$[,$count);
345    if ((($len_pkt - 12) - &pad($count,4)) >= 12)
346    {
347        ;# looks like an authenticator
348        ($auth_keyid,$auth_cksum) =
349            unpack("Na8",substr($pkt,$len_pkt-12+$[,12));
350        $STAT_auth++;
351        ;# no checking of auth_cksum (yet ?)
352    }
353
354    if (&pkt_VN($li_vn_mode) != $NTP_version)
355    {
356        $STAT_bad_version++;
357        return ("ERROR","version ".&pkt_VN($li_vn_mode)."packet ignored");
358    }
359
360    if (&pkt_MODE($li_vn_mode) != $ctrl_mode)
361    {
362        $STAT_bad_mode++;
363        return ("ERROR", "mode ".&pkt_MODE($li_vn_mode)." packet ignored");
364    }
365   
366    ;# handle single fragment fast
367    if ($offset == 0 && &pkt_M($r_e_m_op) == 0)
368    {
369        $STAT_single_frag++;
370        if (&pkt_E($r_e_m_op))
371        {
372            $STAT_err_pkt++;
373            return (&error_status($status),
374                    $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
375                    $auth_keyid);
376        }
377        else
378        {
379            return ("",
380                    $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
381                    $auth_keyid);
382        }
383    }
384    else
385    {
386        ;# fragment - set up local name space
387        $id = "$from$seq".&pkt_OP($r_e_m_op);
388        $ID{$id} = 1;
389        *FRAGS = "$id FRAGS";
390        *lastseen = "$id lastseen";
391       
392        $STAT_frag++;
393       
394        $lastseen = 1 if !&pkt_M($r_e_m_op);
395        if (!defined(%FRAGS))
396        {
397            (&pkt_M($r_e_m_op) ? " more" : "")."\n";
398            $FRAGS{$offset} = $data;
399            ;# save other info
400            @FRAGS = ($status,$associd,&pkt_OP($r_e_m_op),$seq,$auth_keyid,$r_e_m_op);
401        }
402        else
403        {
404            (&pkt_M($r_e_m_op) ? " more" : "")."\n";
405            ;# add frag to previous - combine on the fly
406            if (defined($FRAGS{$offset}))
407            {
408                $STAT_dup_frag++;
409                return ("ERROR","duplicate fragment at $offset seq=$seq");
410            }
411           
412            $FRAGS{$offset} = $data;
413           
414            undef($loff);
415            foreach $off (sort numerical keys(%FRAGS))
416            {
417                next unless defined($FRAGS{$off});
418                if (defined($loff) &&
419                    ($loff + length($FRAGS{$loff})) == $off)
420                {
421                    $FRAGS{$loff} .= $FRAGS{$off};
422                    delete $FRAGS{$off};
423                    last;
424                }
425                $loff = $off;
426            }
427
428            ;# return packet if all frags arrived
429            ;# at most two frags with possible padding ???
430            if ($lastseen && defined($FRAGS{0}) &&
431                scalar(@x=sort numerical keys(%FRAGS)) <= 2 &&
432                (length($FRAGS{0}) + 8) > $x[$[+1])
433            {
434                @x=((&pkt_E($r_e_m_op) ? &error_status($status) : ""),
435                    $FRAGS{0},@FRAGS);
436                &pkt_E($r_e_m_op) ? $STAT_err_frag++ : $STAT_frag_all++;
437                undef(%FRAGS);
438                undef(@FRAGS);
439                undef($lastseen);
440                delete $ID{$id};
441                &main'clear_timeout($id);
442                return @x;
443            }
444            else
445            {
446                &main'set_timeout($id,time+$timeout,"&ntp'handle_packet_timeout(\"".unpack("H*",$id)."\");"); #'";
447            }
448        }
449        return (undef);
450    }
451}
452
453sub handle_packet_timeout
454{
455    local($id) = @_;
456    local($r_e_m_op,*FRAGS,*lastseen,@x) = (@FRAGS[$[+5]);
457   
458    *FRAGS = "$id FRAGS";
459    *lastseen = "$id lastseen";
460   
461    @x=((&pkt_E($r_e_m_op) ? &error_status($status) : "TIMEOUT"),
462        $FRAGS{0},@FRAGS[$[ .. $[+4]);
463    $STAT_frag_timeout++;
464    undef(%FRAGS);
465    undef(@FRAGS);
466    undef($lastseen);
467    delete $ID{$id};
468    return @x;
469}
470
471
472sub pad
473{
474    return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
475}
476
4771;
Note: See TracBrowser for help on using the repository browser.