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
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 byte 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_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                    );
181sub LI
182{
183    &getval(&ssw_LI($_[$[]),*LI);
184}
185sub ClockSource
186{
187    &getval(&ssw_CS($_[$[]),*ClockSource);
188}
189
190sub SystemEvent
191{
192    &getval(&ssw_SECode($_[$[]),*SystemEvent);
193}
194
195sub 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
205sub psw_PStat_config     { return ($_[$[] & 0x8000) == 0x8000; }
206sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
207sub psw_PStat_authentic  { return ($_[$[] & 0x2000) == 0x2000; }
208sub psw_PStat_reach      { return ($_[$[] & 0x1000) == 0x1000; }
209sub psw_PStat_bcast      { return ($_[$[] & 0x0800) == 0x0800; }
210sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
211sub psw_PSel  { return ($_[$[] >> 8)  & 0x3;  }
212sub psw_PCnt  { return ($_[$[] >> 4)  & 0xf; }
213sub 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
244sub PeerSelection
245{
246    &getval(&psw_PSel($_[$[]),*PeerSelection);
247}
248
249sub PeerEvent
250{
251    &getval(&psw_PCode($_[$[]),*PeerEvent);
252}
253
254sub 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
273sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
274sub 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
286sub 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;#
298sub 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
310sub 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
336sub 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
354sub 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
482sub 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
501sub pad
502{
503    return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
504}
505
5061;
507