3 ;# ntp.pl,v 3.1 1993/07/06 01:09:09 jbj Exp
5 ;# process loop filter statistics file and either
6 ;# - show statistics periodically using gnuplot
7 ;# - or print a single plot
10 ;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
13 ;#############################################################
20 $byte1 = (($NTP_version & 0x7)<< 3) & 0x34 | ($ctrl_mode & 0x7);
23 $sequence = 0; # initial sequence number incred before used
25 $do_auth=0; # no possibility today
27 ;#list if known keys (passwords)
28 %KEYS = ( 0, "\200\200\200\200\200\200\200\200",
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
41 ;# a+ data (+ padding)
42 ;# optional authentication data
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; }
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; }
57 ;#-----------------------------------------------------------------------------
63 $KEYS{$id} = $key if (defined($key));
64 if (! defined($KEYS{$id}))
66 warn "Key $id not yet specified - key not changed\n";
69 return ($keyid,$keyid = $id)[$[];
72 ;#-----------------------------------------------------------------------------
73 sub numerical { $a <=> $b; }
75 ;#-----------------------------------------------------------------------------
79 local($fh,$opcode, $associd, $data,$address) = @_;
80 $fh = caller(0)."'$fh";
82 local($junksize,$junk,$packet,$offset,$ret);
88 $junksize = length($data);
89 $junksize = $MAX_DATA if $junksize > $MAX_DATA;
91 ($junk,$data) = $data =~ /^(.{$junksize})(.*)$/;
93 = pack("C2n5a".(($junk eq "") ? 0 : &pad($junksize+12,$pad)-12),
95 ($opcode & 0x1f) | ($data ? 0x20 : 0),
98 $offset, $junksize, $junk);
103 $offset += $junksize;
105 if (defined($address))
107 $ret = send($fh, $packet, 0, $address);
111 $ret = send($fh, $packet, 0);
116 warn "send failed: $!\n";
119 elsif ($ret != length($packet))
121 warn "send failed: sent only $ret from ".length($packet). "bytes\n";
124 return $sequence unless $data;
128 ;#-----------------------------------------------------------------------------
129 ;# status interpretation
133 local($val,*list) = @_;
135 return $list{$val} if defined($list{$val});
136 return sprintf("%s#%d",$list{"-"},$val) if defined($list{"-"});
137 return "unknown-$val";
140 ;#---------------------------------
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; }
149 %LI = ( 0, "leap_none", 1, "leap_add_sec", 2, "leap_del_sec", 3, "sync_alarm", "-", "leap");
150 %ClockSource = (0, "sync_unspec",
155 5, "sync_local_proto",
158 8, "sync_wristwatch",
163 %SystemEvent = (0, "event_unspec",
164 1, "event_freq_not_set",
166 3, "event_spike_detect",
167 4, "event_freq_mode",
168 5, "event_clock_sync",
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",
177 14, "event_loaded_leaps",
178 15, "event_stale_leaps",
183 &getval(&ssw_LI($_[$[]),*LI);
187 &getval(&ssw_CS($_[$[]),*ClockSource);
192 &getval(&ssw_SECode($_[$[]),*SystemEvent);
197 return sprintf("%s, %s, %d event%s, %s", &LI($_[$[]), &ClockSource($_[$[]),
198 &ssw_SECnt($_[$[]), ((&ssw_SECnt($_[$[])==1) ? "" : "s"),
199 &SystemEvent($_[$[]));
201 ;#---------------------------------
204 ;# format: |PStat|PSel|PCnt|PCode| Pstat=6bit PSel=2bit PCnt=4bit PCode=4bit
205 sub psw_PStat_config { return ($_[$[] & 0x8000) == 0x8000; }
206 sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
207 sub psw_PStat_authentic { return ($_[$[] & 0x2000) == 0x2000; }
208 sub psw_PStat_reach { return ($_[$[] & 0x1000) == 0x1000; }
209 sub psw_PStat_bcast { return ($_[$[] & 0x0800) == 0x0800; }
210 sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
211 sub psw_PSel { return ($_[$[] >> 8) & 0x3; }
212 sub psw_PCnt { return ($_[$[] >> 4) & 0xf; }
213 sub psw_PCode { return $_[$[] & 0xf; }
215 %PeerSelection = (0, "sel_reject",
225 %PeerEvent = (0, "event_unspec",
227 2, "event_demobilize",
232 7, "event_rate_exceed",
234 9, "event_leap_armed",
235 10, "event_sys_peer",
236 11, "event_clock_event",
237 12, "event_bad_auth",
239 14, "event_intlv_mode",
240 15, "event_intlv_err",
246 &getval(&psw_PSel($_[$[]),*PeerSelection);
251 &getval(&psw_PCode($_[$[]),*PeerEvent);
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($_[$[]);
263 $x .= sprintf(" %s, %d event%s, %s", &PeerSelection($_[$[]),
264 &psw_PCnt($_[$[]), ((&psw_PCnt($_[$[]) == 1) ? "" : "s"),
269 ;#---------------------------------
272 ;# format: |CStat|CEvnt| CStat=8bit CEvnt=8bit
273 sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
274 sub csw_CEvnt { return $_[$[] & 0xff; }
276 %ClockStatus = (0, "clk_nominal",
288 return sprintf("%s, last %s",
289 &getval(&csw_CStat($_[$[]),*ClockStatus),
290 &getval(&csw_CEvnt($_[$[]),*ClockStatus));
293 ;#---------------------------------
296 ;# format: |Err|reserved| Err=8bit
298 sub esw_Err { return ($_[$[] >> 8) & 0xff; }
300 %ErrorStatus = (0, "err_unspec",
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",
312 return sprintf("%s", &getval(&esw_Err($_[$[]),*ErrorStatus));
315 ;#-----------------------------------------------------------------------------
317 ;# cntrl op name translation
319 %CntrlOpName = (0, "reserved",
322 3, "write_variables",
323 4, "read_clock_variables",
324 5, "write_clock_variables",
332 31, "unset_trap", # !!! unofficial !!!
338 return &getval($_[$[],*CntrlOpName);
341 ;#-----------------------------------------------------------------------------
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
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);
366 return ("ERROR","short packet received");
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)
375 ;# looks like an authenticator
376 ($auth_keyid,$auth_cksum) =
377 unpack("Na8",substr($pkt,$len_pkt-12+$[,12));
379 ;# no checking of auth_cksum (yet ?)
382 if (&pkt_VN($li_vn_mode) != $NTP_version)
385 return ("ERROR","version ".&pkt_VN($li_vn_mode)."packet ignored");
388 if (&pkt_MODE($li_vn_mode) != $ctrl_mode)
391 return ("ERROR", "mode ".&pkt_MODE($li_vn_mode)." packet ignored");
394 ;# handle single fragment fast
395 if ($offset == 0 && &pkt_M($r_e_m_op) == 0)
398 if (&pkt_E($r_e_m_op))
401 return (&error_status($status),
402 $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
408 $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
414 ;# fragment - set up local name space
415 $id = "$from$seq".&pkt_OP($r_e_m_op);
417 *FRAGS = "$id FRAGS";
418 *lastseen = "$id lastseen";
422 $lastseen = 1 if !&pkt_M($r_e_m_op);
425 print((&pkt_M($r_e_m_op) ? " more" : "")."\n");
426 $FRAGS{$offset} = $data;
428 @FRAGS = ($status,$associd,&pkt_OP($r_e_m_op),$seq,$auth_keyid,$r_e_m_op);
432 print((&pkt_M($r_e_m_op) ? " more" : "")."\n");
433 ;# add frag to previous - combine on the fly
434 if (defined($FRAGS{$offset}))
437 return ("ERROR","duplicate fragment at $offset seq=$seq");
440 $FRAGS{$offset} = $data;
443 foreach $off (sort numerical keys(%FRAGS))
445 next unless defined($FRAGS{$off});
446 if (defined($loff) &&
447 ($loff + length($FRAGS{$loff})) == $off)
449 $FRAGS{$loff} .= $FRAGS{$off};
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)))
463 @x=((&pkt_E($r_e_m_op) ? &error_status($status) : ""),
465 &pkt_E($r_e_m_op) ? $STAT_err_frag++ : $STAT_frag_all++;
470 &main'clear_timeout($id);
475 &main'set_timeout($id,time+$timeout,"&ntp'handle_packet_timeout(\"".unpack("H*",$id)."\");"); #'";
482 sub handle_packet_timeout
485 local($r_e_m_op,*FRAGS,*lastseen,@x) = (@FRAGS[$[+5]);
487 *FRAGS = "$id FRAGS";
488 *lastseen = "$id lastseen";
490 @x=((&pkt_E($r_e_m_op) ? &error_status($status) : "TIMEOUT"),
491 $FRAGS{0},@FRAGS[$[ .. $[+4]);
492 $STAT_frag_timeout++;
503 return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);