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

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