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