source: trunk/third/xntp/scripts/monitoring/ntploopstat @ 16192

Revision 16192, 11.6 KB checked in by ghudson, 24 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r16191, which included commits to RCS files with non-trunk default branches.
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2# --*-perl-*-
3;#
4;# ntploopstat,v 3.1 1993/07/06 01:09:11 jbj Exp
5;#
6;# Poll NTP server using NTP mode 7 loopinfo request.
7;# Log info and timestamp to file for processing by ntploopwatch.
8;#
9;#
10;# Copyright (c) 1992
11;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
12;#
13;#################################################################
14;#
15;# The format written to the logfile is the same as used by xntpd
16;# for the loopstats file.
17;# This script however allows to gather loop filter statistics from
18;# remote servers where you do not have access to the loopstats logfile.
19;#
20;# Please note: Communication delays affect the accuracy of the
21;#              timestamps recorded. Effects from these delays will probably
22;#              not show up, as timestamps are recorded to the second only.
23;#              (Should have implemented &gettimeofday()..)
24;#
25
26$0 =~ s!^.*/([^/]+)$!$1!;               # beautify script name
27
28$ntpserver = 'localhost';               # default host to poll
29$delay = 60;                            # default sampling rate
30                                       ;# keep it shorter than minpoll (=64)
31                                       ;# to get all values
32
33require "ctime.pl";
34;# handle bug in early ctime distributions
35$ENV{'TZ'} = 'MET' unless defined($ENV{'TZ'}) || $] > 4.010;
36
37if (defined(@ctime'MoY))
38{
39    *MonthName = *ctime'MoY;
40}
41else
42{
43    @MonthName = ('Jan','Feb','Mar','Apr','May','Jun',
44                  'Jul','Aug','Sep','Oct','Nov','Dec');
45}
46
47;# this routine can be redefined to point to syslog if necessary
48sub msg
49{
50    return unless $verbose;
51
52    print  STDERR "$0: ";
53    printf STDERR @_;
54}
55
56;#############################################################
57;#
58;# process command line
59$usage = <<"E-O-S";
60
61usage:
62  $0 [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver]
63E-O-S
64
65while($_ = shift)
66{
67    /^-v(\d*)$/ && ($verbose=($1 eq '') ? 1 : $1,1) && next;
68    /^-d(\d*)$/ &&
69        do {
70            ($1 ne '') && ($delay = $1,1) && next;
71            @ARGV || die("$0: delay value missing after -d\n$usage");
72            $delay = shift;
73            ($delay  >= 0) || die("$0: bad delay value \"$delay\"\n$usage");
74            next;
75        };
76    /^-l$/ &&
77        do {
78            @ARGV || die("$0: logfile missing after -l\n$usage");
79            $logfile = shift;
80            next;
81        };
82    /^-t(\d*(\.\d*)?)$/ &&
83        do {
84            ($1 ne '') && ($timeout = $1,1) && next;
85            @ARGV || die("$0: timeout value missing after -t\n$usage\n");
86            $timeout = shift;
87            ($timeout > 0) ||
88                die("$0: bad timeout value \"$timeout\"\n$usage");
89            next;
90        };
91   
92    /^-/ && die("$0: unknown option \"$_\"\n$usage");
93
94    ;# any other argument is server to poll
95    $ntpserver = $_;
96    last;
97}
98
99if (@ARGV)
100{
101    warn("unexpected arguments: ".join(" ",@ARGV).".\n");
102    die("$0: too many servers specified\n$usage");
103}
104
105;# logfile defaults to include server name
106;# The name of the current month is appended and
107;# the file is opened and closed for each sample.
108;#
109$logfile = "loopstats:$ntpserver." unless defined($logfile);
110$timeout = 12.0 unless defined($timeout); # wait $timeout seconds for reply
111
112$MAX_FAIL = 60;                         # give up after $MAX_FAIL failed polls
113
114
115$MJD_1970 = 40587;
116
117if (eval 'require "syscall.ph";')
118{
119    if (defined(&SYS_gettimeofday))
120    {
121        ;# assume standard
122        ;# gettimeofday(struct timeval *tp,struct timezone *tzp)
123        ;# syntax for gettimeofday syscall
124        ;# tzp = NULL -> undef
125        ;# tp = (long,long)
126        eval 'sub time { local($tz) = pack("LL",0,0);
127              (&msg("gettimeofday failed: $!\n"),
128              return (time))
129              unless syscall(&SYS_gettimeofday,$tz,undef) == 0;
130              local($s,$us) = unpack("LL",$tz);
131              return $s + $us/1000000; }';
132        local($t1,$t2,$t3);
133        $t1 = time;
134        eval '$t2 = &time;';
135        $t3 = time;
136        die("$0: gettimeofday failed: $@.\n") if defined($@) && $@;
137        die("$0: gettimeofday inconsistency time=$t1,gettimeofday=$t2,time=$t2\n")
138            if (int($t1) != int($t2) && int($t3) != int($t2));
139        &msg("Using gettimeofday for timestamps\n");
140    }
141    else
142    {
143        warn("No gettimeofday syscall found - using time builtin for timestamps\n");
144        eval 'sub time { return time; }';
145    }
146}
147else
148{
149    warn("No syscall.ph file found - using time builtin for timestamps\n");
150    eval 'sub time { return time; }';
151}
152
153
154;#------------------+
155;# from ntp_request.h
156;#------------------+
157
158;# NTP mode 7 packet format:
159;#      Byte 1:     ResponseBit MoreBit Version(3bit) Mode(3bit)==7
160;#      Byte 2:     AuthBit Sequence #   - 0 - 127 see MoreBit
161;#      Byte 3:     Implementation #
162;#      Byte 4:     Request Code
163;#
164;#      Short 1:    Err(3bit) NumItems(12bit)
165;#      Short 2:    MBZ(3bit)=0 DataItemSize(12bit)
166;#      0 - 500 byte Data
167;#  if AuthBit is set:
168;#      Long:       KeyId
169;#      2xLong:     AuthCode
170
171;#
172$IMPL_XNTPD  = 2;
173$REQ_LOOP_INFO = 8;
174
175
176;# request packet for REQ_LOOP_INFO:
177;#     B1:  RB=0 MB=0 V=2 M=7
178;#     B2:  S# = 0
179;#     B3:  I# = IMPL_XNTPD
180;#     B4:  RC = REQ_LOOP_INFO
181;#     S1:  E=0 NI=0
182;#     S2:  MBZ=0 DIS=0
183;#     data:  32 byte 0 padding
184;#            8byte timestamp if encryption, 0 padding otherwise
185$loopinfo_reqpkt =
186    pack("CCCC nn x32 x8", 0x17, 0, $IMPL_XNTPD, $REQ_LOOP_INFO, 0, 0);
187
188;# ignore any auth data in packets
189$loopinfo_response_size =
190    1+1+1+1+2+2                 # header size like request pkt
191    + 8                         # l_fp last_offset
192    + 8                         # l_fp drift_comp
193    + 4                         # u_long compliance
194    + 4                         # u_long watchdog_timer
195    ;
196$loopinfo_response_fmt    = "C4n2N2N2NN";
197$loopinfo_response_fmt_v2 = "C4n2N2N2N2N";
198
199;#
200;# prepare connection to server
201;#
202
203;# workaround for broken socket.ph on dynix_ptx
204eval 'sub INTEL {1;}' unless defined(&INTEL);
205eval 'sub ATT {1;}'  unless defined(&ATT);
206
207require "sys/socket.ph";
208
209require 'netinet/in.ph';
210
211;# if you do not have netinet/in.ph enable the following lines
212;#eval 'sub INADDR_ANY { 0x00000000; }' unless defined(&INADDR_ANY);
213;#eval 'sub IPPRORO_UDP { 17; }' unless defined(&IPPROTO_UDP);
214
215if ($ntpserver =~ /^((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)$/)
216{
217    local($a,$b,$c,$d) = ($1,$3,$5,$7);
218    $a = oct($a) if defined($2);
219    $b = oct($b) if defined($4);
220    $c = oct($c) if defined($6);
221    $d = oct($d) if defined($8);
222    $server_addr = pack("C4", $a,$b,$c,$d);
223
224    $server_mainname
225        = (gethostbyaddr($server_addr,&AF_INET))[$[] || $ntpserver;
226}
227else
228{
229    ($server_mainname,$server_addr)
230        = (gethostbyname($ntpserver))[$[,$[+4];
231
232    die("$0: host \"$ntpserver\" is unknown\n")
233        unless defined($server_addr);
234}
235&msg ("Address of server \"$ntpserver\" is \"%d.%d.%d.%d\"\n",
236      unpack("C4",$server_addr));
237
238$proto_udp = (getprotobyname('udp'))[$[+2] || &IPPROTO_UDP;
239 
240$ntp_port =
241    (getservbyname('ntp','udp'))[$[+2] ||
242    (warn "Could not get port number for service \"ntp/udp\" using 123\n"),
243    ($ntp_port=123);
244 
245;#
2460 && &SOCK_DGRAM;               # satisfy perl -w ...
247socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) ||
248    die("Cannot open socket: $!\n");
249
250bind(S, pack("S n N x8", &AF_INET, 0, &INADDR_ANY)) ||
251    die("Cannot bind: $!\n");
252 
253($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
254
255&msg("Listening at address %d.%d.%d.%d port %d\n",
256     unpack("C4",$my_addr), $my_port);
257
258$server_inaddr = pack("Sna4x8", &AF_INET, $ntp_port, $server_addr);
259
260;############################################################
261;#
262;# the main loop:
263;#      send request
264;#      get reply
265;#      wait til next sample time
266
267undef($lasttime);
268$lostpacket = 0;
269
270while(1)
271{
272    $stime = &time;
273
274    &msg("Sending request $stime...\n");
275
276    $ret = send(S,$loopinfo_reqpkt,0,$server_inaddr);
277
278    if (! defined($ret) || $ret < length($loopinfo_reqpkt))
279    {
280        warn("$0: send failed ret=($ret): $!\n");
281        $fail++;
282        next;
283    }
284
285    &msg("Waiting for reply...\n");
286
287    $mask = ""; vec($mask,fileno(S),1) = 1;
288    $ret = select($mask,undef,undef,$timeout);
289
290    if (! defined($ret))
291    {
292        warn("$0: select failed: $!\n");
293        $fail++;
294        next;
295    }
296    elsif ($ret == 0)
297    {
298        warn("$0: request to $ntpserver timed out ($timeout seconds)\n");
299        ;# do not count this event as failure
300        ;# it usually this happens due to dropped udp packets on noisy and
301        ;# havily loaded lines, so just try again;
302        $lostpacket = 1;
303        next;
304    }
305
306    &msg("Receiving reply...\n");
307
308    $len = 520;                         # max size of a mode 7 packet
309    $reply = "";                        # just make it defined for -w
310    $ret = recv(S,$reply,$len,0);
311
312    if (!defined($ret))
313    {
314        warn("$0: recv failed: $!\n");
315        $fail++;
316        next;
317    }
318
319    $etime = &time;
320    &msg("Received at\t$etime\n");
321
322    ;#$time = ($stime + $etime) / 2; # symmetric delay assumed
323    $time = $etime;             # the above assumption breaks for X25
324                               ;# so taking etime makes timestamps be a
325                               ;# little late, but keeps them increasing
326                               ;# monotonously
327
328    &msg(sprintf("Reply from %d.%d.%d.%d took %f seconds\n",
329                 (unpack("SnC4",$ret))[$[+2 .. $[+5], ($etime - $stime)));
330
331    if ($len < $loopinfo_response_size)
332    {
333        warn("$0: short packet ($len bytes) received ($loopinfo_response_size bytes expected\n");
334        $fail++;
335        next;
336    }
337   
338    ($b1,$b2,$b3,$b4,$s1,$s2,
339     $offset_i,$offset_f,$drift_i,$drift_f,$compl,$watchdog)
340        = unpack($loopinfo_response_fmt,$reply);
341
342    ;# check reply
343    if (($s1 >> 12) != 0)             # error !
344    {
345        die("$0: got error reply ".($s1>>12)."\n");
346    }
347    if (($b1 != 0x97 && $b1 != 0x9f) || # Reply NotMore V=2 M=7
348        ($b2 != 0 && $b2 != 0x80) ||    # S=0 Auth no/yes
349        $b3 != $IMPL_XNTPD ||           # ! IMPL_XNTPD
350        $b4 != $REQ_LOOP_INFO ||        # Ehh.. not loopinfo reply ?
351        $s1 != 1 ||                     # ????
352        ($s2 != 24 && $s2 != 28)        #
353        )
354    {
355        warn("$0: Bad/unexpected reply from server:\n");
356        warn("  \"".unpack("H*",$reply)."\"\n");
357        warn("   ".sprintf("b1=%x b2=%x b3=%x b4=%x s1=%d s2=%d\n",
358                           $b1,$b2,$b3,$b4,$s1,$s2));
359        $fail++;
360        next;
361    }
362    elsif ($s2 == 28)
363    {
364      ;# seems to be a version 2 xntpd
365      ($b1,$b2,$b3,$b4,$s1,$s2,
366       $offset_i,$offset_f,$drift_i,$drift_f,$compl_i,$compl_f,$watchdog)
367          = unpack($loopinfo_response_fmt_v2,$reply);
368      $compl = &lfptoa($compl_i, $compl_f);
369    }
370
371    $time -= $watchdog;
372
373    $offset = &lfptoa($offset_i, $offset_f);
374    $drift  = &lfptoa($drift_i, $drift_f);
375
376    &log($time,$offset,$drift,$compl) && ($fail = 0);;
377}
378continue
379{
380    die("$0: Too many failures - terminating\n") if $fail > $MAX_FAIL;
381    &msg("Sleeping " . ($lostpacket ? ($delay / 2) : $delay) . " seconds...\n");
382
383    sleep($lostpacket ? ($delay / 2) : $delay);
384    $lostpacket = 0;
385}
386
387sub log
388{
389    local($time,$offs,$freq,$cmpl) = @_;
390    local($y,$m,$d);
391    local($fname,$suff) = ($logfile);
392
393
394    ;# silently drop sample if distance to last sample is too low
395    if (defined($lasttime) && ($lasttime + 2) >= $time)
396    {
397      &msg("Dropped packet - old sample\n");
398      return 1;
399    }
400
401    ;# $suff determines which samples end up in the same file
402    ;# could have used $year (;-) or WeekOfYear, DayOfYear,....
403    ;# Change it to your suit...
404
405    ($d,$m,$y) = (localtime($time))[$[+3 .. $[+5];
406    $suff = sprintf("%04d%02d%02d",$y+1900,$m+1,$d);
407    $fname .= $suff;
408    if (!open(LOG,">>$fname"))
409    {
410        warn("$0: open($fname) failed: $!\n");
411        $fail++;
412        return 0;
413    }
414    else
415    {
416        ;# file format
417        ;#          MJD seconds offset drift compliance
418        printf LOG ("%d %.3lf %.8lf %.7lf %d\n",
419                    int($time/86400)+$MJD_1970,
420                    $time - int($time/86400) * 86400,
421                    $offs,$freq,$cmpl);
422        close(LOG);
423        $lasttime = $time;
424    }
425    return 1;
426}
427
428;# see ntp_fp.h to understand this
429sub lfptoa
430{
431    local($i,$f) = @_;
432    local($sign) = 1;
433
434   
435    if ($i & 0x80000000)
436    {
437        if ($f == 0)
438        {
439            $i = -$i;
440        }
441        else
442        {
443            $f = -$f;
444            $i = ~$i;
445            $i += 1;                    # 2s complement
446        }
447        $sign = -1;
448        ;#print "NEG: $i $f\n";
449    }
450    else
451    {
452        ;#print "POS: $i $f\n";
453    }
454    ;# unlike xntpd I have perl do the dirty work.
455    ;# Using floats here may affect precision, but
456    ;# currently these bits aren't significant anyway
457    return $sign * ($i + $f/2**32);   
458}
Note: See TracBrowser for help on using the repository browser.