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

Revision 10832, 12.0 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 *
RevLine 
[10831]1#!/local/bin/perl --*-perl-*-
2;#
3;# ntptrap,v 3.1 1993/07/06 01:09:15 jbj Exp
4;#
5;# a client for the xntp mode 6 trap mechanism
6;#
7;# Copyright (c) 1992
8;#  Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
9;#
10;#
11;#############################################################
12$0 =~ s!^.*/([^/]+)$!\1!;               # strip to filename
13;# enforce STDOUT and STDERR to be line buffered
14$| = 1;
15select((select(STDERR),$|=1)[$[]);
16
17;#######################################
18;# load utility routines and definitions
19;#
20require('ntp.pl');                      # implementation of the NTP protocol
21eval { require('sys/socket.ph'); require('netinet/in.ph') unless defined(&INADDR_ANY); } ||
22do {
23  die("$0: $@") unless $[ == index($@, "Can't locate ");
24  warn "$0: $@";
25  warn "$0: supplying some default definitions\n";
26  eval 'sub INADDR_ANY { 0; } sub AF_INET {2;} sub SOCK_DGRAM {2;} 1;' || die "$0: $@";
27};
28require('getopts.pl');                  # option parsing
29require('ctime.pl');                    # date/time formatting
30
31;######################################
32;# define some global constants
33;#
34$BASE_TIMEOUT=10;
35$FRAG_TIMEOUT=10;
36$MAX_TRY = 5;
37$REFRESH_TIME=60*15;            # 15 minutes (server uses 1 hour)
38$ntp'timeout = $FRAG_TIMEOUT; #';
39
40;######################################
41;# now process options
42;#
43sub usage
44{
45    die("usage: $0 [-n] [-p <port>] [-l <logfile>] [host] ...\n");
46}
47
48$opt_l = "/dev/null";   # where to write debug messages to
49$opt_p = 0;             # port to use locally - (0 does mean: will be choosen by kernel)
50
51&usage unless &Getopts('l:p:');
52&Getopts if 0;  # make -w happy
53
54@Hosts = ($#ARGV < $[) ? ("localhost") : @ARGV;
55
56;# setup for debug output
57$DEBUGFILE=$opt_l;
58$DEBUGFILE="&STDERR" if $DEBUGFILE eq '-';
59
60open(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n");
61select((select(DEBUG),$|=1)[$[]);
62
63;# &log prints a single trap record (adding a (local) time stamp)
64sub log
65{
66    chop($date=&ctime(time));
67    print "$date ",@_,"\n";
68}
69
70sub debug
71{
72    print DEBUG @_,"\n";
73}
74;#
75$proto_udp = (getprotobyname('udp'))[$[+2] ||
76                (warn("$0: Could not get protocoll number for 'udp' using 17"), 17);
77
78$ntp_port = (getservbyname('ntp','udp'))[$[+2] ||
79              (warn("$0: Could not get port number for service ntp/udp using 123"), 123);
80
81;#
82socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n");
83
84;#
85bind(S, pack("S n N x8", &AF_INET, $opt_p, &INADDR_ANY)) ||
86    die("Cannot bind: $!\n");
87
88($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
89&log(sprintf("Listening at address %d.%d.%d.%d port %d",
90             unpack("C4",$my_addr), $my_port));
91
92;# disregister with all servers in case of termination
93sub cleanup
94{
95    &log("Aborted by signal \"$_[$[]\"") if defined($_[$[]);
96
97    foreach (@Hosts)
98    {
99        &ntp'send(S,31,0,"",pack("Sna4x8",&AF_INET,$ntp_port,$Hosts{$_})); #';
100    }
101    close(S);
102    exit(2);
103}
104
105$SIG{'HUP'} = 'cleanup';
106$SIG{'INT'} = 'cleanup';
107$SIG{'QUIT'} = 'cleanup';
108$SIG{'TERM'} = 'cleanup';
109
1100 && $a && $b;
111sub timeouts                    # sort timeout id array
112{
113    $TIMEOUTS{$a} <=> $TIMEOUTS{$b};
114}
115
116;# a Request element looks like: pack("a4SC",addr,associd,op)
117@Requests= ();
118
119;# compute requests for set trap control msgs to each host given
120{
121    local($name,$addr);
122   
123    foreach (@Hosts)
124    {
125        if (/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
126        {
127            ($name,$addr) =
128                (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[,$[+4];
129            unless (defined($name))
130            {
131                $name = sprintf("[[%d.%d.%d.%d]]",$1,$2,$3,$4);
132                $addr = pack("C4",$1,$2,$3,$4);
133            }
134        }
135        else
136        {
137            ($name,$addr) = (gethostbyname($_))[$[,$[+4];
138            unless (defined($name))
139            {
140                warn "$0: unknown host \"$_\" - ignored\n";
141                next;
142            }
143        }
144        next if defined($Host{$name});
145        $Host{$name} = $addr;
146        push(@Requests,pack("a4SC",$addr,0,6)); # schedule a set trap request for $name
147    }
148}
149
150sub hostname
151{
152    local($addr) = @_;
153    return $HostName{$addr} if defined($HostName{$addr});
154    local($name) = gethostbyaddr($addr,&AF_INET);
155    &debug(sprintf("hostname(%d.%d.%d.%d) = \"%s\"",unpack("C4",$addr),$name))
156        if defined($name);
157    defined($name) && ($HostName{$addr} = $name) && (return $name);
158    &debug(sprintf("Failed to get name for %d.%d.%d.%d",unpack("C4",$addr)));
159    return sprintf("[%d.%d.%d.%d]",unpack("C4",$addr));
160}
161
162;# when no hosts were given on the commandline no requests have been scheduled
163&usage unless (@Requests);
164
165&debug(sprintf("%d request(s) scheduled",scalar(@Requests)));
166grep(&debug("    - ".$_),keys(%Host));
167
168;# allocate variables;
169$addr="";
170$assoc=0;
171$op = 0;
172$timeout = 0;
173$ret="";
174%TIMEOUTS = ();
175%TIMEOUT_PROCS = ();
176@TIMEOUTS = ();         
177
178$len = 512;
179$buf = " " x $len;
180
181while (1)
182{
183    if (@Requests || @TIMEOUTS)         # if there is some work pending
184    {
185        if (@Requests)
186        {
187            ($addr,$assoc,$op) = unpack("a4SC",($req = shift(@Requests)));
188            &debug(sprintf("Request: %s: %s(%d)",&hostname($addr), &ntp'cntrlop_name($op), $assoc)); #';))
189            $ret = &ntp'send(S,$op,$assoc,"", #'(
190                             pack("Sna4x8",&AF_INET,$ntp_port,$addr));
191            &set_timeout("retry-".unpack("H*",$req),time+$BASE_TIMEOUT,
192                         sprintf("&retry(\"%s\");",unpack("H*",$req)));
193
194            last unless (defined($ret)); # warn called by ntp'send();
195
196            ;# if there are more requests just have a quick look for new messages
197            ;# otherwise grant server time for a response
198            $timeout = @Requests ? 0 : $BASE_TIMEOUT;
199        }
200        if ($timeout && @TIMEOUTS)
201        {
202            ;# ensure not to miss a timeout
203            if ($timeout + time > $TIMEOUTS{$TIMEOUTS[$[]})
204            {
205                $timeout = $TIMEOUTS{$TIMEOUTS[$[]} - time;
206                $timeout = 0 if $timeout < 0;
207            }
208        }
209    }
210    else
211    {
212        ;# no work yet - wait for some messages dropping in
213        ;# usually this will not hapen as the refresh semantic will
214        ;# always have a pending timeout
215        undef($timeout);
216    }
217
218    vec($mask="",fileno(S),1) = 1;
219    $ret = select($mask,undef,undef,$timeout);
220
221    warn("$0: select: $!\n"),last if $ret < 0;  # give up on error return from select
222
223    if ($ret == 0)
224    {
225        ;# timeout
226        if (@TIMEOUTS && time > $TIMEOUTS{$TIMEOUTS[$[]})
227        {
228            ;# handle timeout
229            $timeout_proc =
230                (delete $TIMEOUT_PROCS{$TIMEOUTS[$[]},
231                 delete $TIMEOUTS{shift(@TIMEOUTS)})[$[];
232            eval $timeout_proc;
233            die "timeout eval (\"$timeout_proc\"): $@\n" if $@;
234        }
235        ;# else: there may be something to be sent
236    }
237    else
238    {
239        ;# data avail
240        $from = recv(S,$buf,$len,0);
241        ;# give up on error return from recv
242        warn("$0: recv: $!\n"), last unless (defined($from));
243
244        $from = (unpack("Sna4",$from))[$[+2]; # keep host addr only
245        ;# could check for ntp_port - but who cares
246        &debug("-Packet from ",&hostname($from));
247
248        ;# stuff packet into ntp mode 6 receive machinery
249        ($ret,$data,$status,$associd,$op,$seq,$auth_keyid) =
250            &ntp'handle_packet($buf,$from); # ';
251        &debug(sprintf("%s uses auth_keyid %d",&hostname($from),$auth_keyid)) if defined($auth_keyid);
252        next unless defined($ret);
253
254        if ($ret eq "")
255        {
256            ;# handle packet
257            ;# simple trap response messages have neither timeout nor retries
258            &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))) unless $op == 7;
259            delete $RETRY{pack("a4SC",$from,$associd,$op)} unless $op == 7;
260
261            &process_response($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid);
262        }
263        else
264        {
265            ;# some kind of error
266            &log(sprintf("%50s: %s: %s",(gethostbyaddr($from,&AF_INET))[$[],$ret,$data));
267            if ($ret ne "TIMEOUT" && $ret ne "ERROR")
268            {
269                &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op)));
270            }
271        }
272    }
273   
274}
275
276warn("$0: terminating\n");
277&cleanup;
278exit 0;
279
280;##################################################
281;# timeout support
282;#
283sub set_timeout
284{
285    local($id,$time,$proc) = @_;
286   
287    $TIMEOUTS{$id} = $time;
288    $TIMEOUT_PROCS{$id} = $proc;
289    @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
290    chop($date=&ctime($time));
291    &debug(sprintf("Schedule timeout \"%s\" for %s", $id, $date));
292}
293
294sub clear_timeout
295{
296    local($id) = @_;
297    delete $TIMEOUTS{$id};
298    delete $TIMEOUT_PROCS{$id};
299    @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
300    &debug("Clear  timeout \"$id\"");
301}
302
3030 && &refresh;
304sub refresh
305{
306    local($addr) = @_;
307    $addr = pack("H*",$addr);
308    &debug(sprintf("Refreshing trap for %s", &hostname($addr)));
309    push(@Requests,pack("a4SC",$addr,0,6));
310}
311
3120 && &retry;
313sub retry
314{
315    local($tag) = @_;
316    $tag = pack("H*",$tag);
317    $RETRY{$tag} = 0 if (!defined($RETRY{$tag}));
318
319    if (++$RETRY{$tag} > $MAX_TRY)
320    {
321        &debug(sprintf("Retry failed: %s assoc %5d op %d",
322                       &hostname(substr($tag,$[,4)),
323                       unpack("x4SC",$tag)));
324        return;
325    }
326    &debug(sprintf("Retrying: %s assoc %5d op %d",
327                       &hostname(substr($tag,$[,4)),
328                       unpack("x4SC",$tag)));
329    push(@Requests,$tag);
330}
331
332sub process_response
333{
334    local($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid) = @_;
335   
336    $msg="";
337    if ($op == 7)               # trap response
338    {
339        $msg .= sprintf("%40s trap#%-5d",
340                        &hostname($from),$seq);
341        &debug (sprintf("\nTrap %d associd %d:\n%s\n===============\n",$seq,$associd,$data));
342        if ($associd == 0)      # system event
343        {
344            $msg .= "  SYSTEM   ";
345            $evnt = &ntp'SystemEvent($status); #';
346            $msg .= "$evnt ";
347            ;# for special cases add additional info
348            ($stratum) = ($data =~ /stratum=(\d+)/);
349            ($refid) = ($data =~ /refid=([\w\.]+)/);
350            $msg .= "stratum=$stratum refid=$refid";
351            if ($refid =~ /\[?(\d+)\.(\d+)\.(\d+)\.(\d+)/)
352            {
353                $msg .= " " . (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[];
354            }
355            if ($evnt eq "event_sync_chg")
356            {
357                $msg .= sprintf("%s %s ",
358                                &ntp'LI($status), #',
359                                &ntp'ClockSource($status) #'
360                                );
361            }
362            elsif ($evnt eq "event_sync/strat_chg")
363            {
364                ($peer) = ($data =~ /peer=([0-9]+)/);
365                $msg .= " peer=$peer";
366            }
367            elsif ($evnt eq "event_clock_excptn")
368            {
369                if (($device) = ($data =~ /device=\"([^\"]+)\"/))
370                {
371                    ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
372                    $Cstatus = hex($cstatus);
373                    $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
374                    ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
375                    $msg .= " \"$device\" \"$timecode\"";
376                }
377                else
378                {
379                    push(@Requests,pack("a4SC",$from, $associd, 4));
380                }
381            }
382        }
383        else                    # peer event
384        {
385            $msg .= sprintf("peer %5d ",$associd);
386            ($srcadr) = ($data =~ /srcadr=\[?([\d\.]+)/);
387            $msg .= sprintf("%-18s %40s ", "[$srcadr]",
388                            &hostname(pack("C4",split(/\./,$srcadr))));
389            $evnt = &ntp'PeerEvent($status); #';
390            $msg .= "$evnt ";
391            ;# for special cases include additional info
392            if ($evnt eq "event_clock_excptn")
393            {
394                if (($device) = ($data =~ /device=\"([^\"]+)\"/))
395                {
396                    ;#&debug("----\n$data\n====\n");
397                    ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
398                    $Cstatus = hex($cstatus);
399                    $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
400                    ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
401                    $msg .= " \"$device\" \"$timecode\"";
402                }
403                else
404                {
405                    ;# no clockvars included - post a cv request
406                    push(@Requests,pack("a4SC",$from, $associd, 4));
407                }
408            }
409            elsif ($evnt eq "event_stratum_chg")
410            {
411                ($stratum) = ($data =~ /stratum=(\d+)/);
412                $msg .= "new stratum $stratum";
413            }
414        }
415    }
416    elsif ($op == 6)            # set trap resonse
417    {
418        &debug("Set trap ok from ",&hostname($from));
419        &set_timeout("refresh-".unpack("H*",$from),time+$REFRESH_TIME,
420                     sprintf("&refresh(\"%s\");",unpack("H*",$from)));
421        return;
422    }
423    elsif ($op == 4)            # read clock variables response
424    {
425        ;# status of clock
426        $msg .= sprintf(" %40s ", &hostname($from));
427        if ($associd == 0)
428        {
429            $msg .= "system clock status: ";
430        }
431        else
432        {
433            $msg .= sprintf("peer %5d clock",$associd);
434        }
435        $msg .= sprintf("%-32s",&ntp'clock_status($status)); #');
436        ($device) = ($data =~ /device=\"([^\"]+)\"/);
437        ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
438        $msg .= " \"$device\" \"$timecode\"";
439    }
440    elsif ($op == 31)           # unset trap response (UNOFFICIAL op)
441    {
442        ;# clear timeout
443        &debug("Clear Trap ok from ",&hostname($from));
444        &clear_timeout("refresh-".unpack("H*",$from));
445        return;
446    }
447    else                        # unexpected response
448    {
449        $msg .= "unexpected response to op $op assoc=$associd";
450        $msg .= sprintf(" status=%04x",$status);
451    }
452    &log($msg);
453}
Note: See TracBrowser for help on using the repository browser.