contrib/ntp/scripts/monitoring/ntptrap

   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;
  15 select((select(STDERR),$|=1)[$[]);
  16
  17 ;#######################################
  18 ;# load utility routines and definitions
  19 ;#
  20 require('ntp.pl');                      # implementation of the NTP protocol
  21 use 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 #};
  30 require('getopts.pl');                  # option parsing
  31 require('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 ;#
  46 sub 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
  65 open(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n");
  66 select((select(DEBUG),$|=1)[$[]);
  67
  68 ;# &log prints a single trap record (adding a (local) time stamp)
  69 sub log
  70 {
  71     chop($date=&ctime(time));
  72     print "$date ",@_,"\n";
  73 }
  74
  75 sub 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 ;#
  87 socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n");
  88
  89 ;#
  90 bind(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
  98 sub 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
 120 0 && $a && $b;
 121 sub 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
 161 sub 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)));
 177 grep(&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
 192 while (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
 287 warn("$0: terminating\n");
 288 &cleanup;
 289 exit 0;
 290
 291 ;##################################################
 292 ;# timeout support
 293 ;#
 294 sub 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
 305 sub 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
 314 0 && &refresh;
 315 sub 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
 323 0 && &retry;
 324 sub 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
 343 sub 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 }