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 } 466
Indexes created Wed Apr 15 00:22:22 UTC 2026