154359Sroberto#!/local/bin/perl --*-perl-*- 254359Sroberto;# 354359Sroberto;# ntptrap,v 3.1 1993/07/06 01:09:15 jbj Exp 454359Sroberto;# 554359Sroberto;# a client for the xntp mode 6 trap mechanism 654359Sroberto;# 754359Sroberto;# Copyright (c) 1992 854359Sroberto;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg 954359Sroberto;# 1054359Sroberto;# 1154359Sroberto;############################################################# 1254359Sroberto$0 =~ s!^.*/([^/]+)$!$1!; # strip to filename 1354359Sroberto;# enforce STDOUT and STDERR to be line buffered 1454359Sroberto$| = 1; 1554359Srobertoselect((select(STDERR),$|=1)[$[]); 1654359Sroberto 1754359Sroberto;####################################### 1854359Sroberto;# load utility routines and definitions 1954359Sroberto;# 2054359Srobertorequire('ntp.pl'); # implementation of the NTP protocol 2154359Srobertouse Socket; 2254359Sroberto 2354359Sroberto#eval { require('sys/socket.ph'); require('netinet/in.ph') unless defined(&INADDR_ANY); } || 2454359Sroberto#do { 2554359Sroberto #die("$0: $@") unless $[ == index($@, "Can't locate "); 2654359Sroberto #warn "$0: $@"; 2754359Sroberto #warn "$0: supplying some default definitions\n"; 2854359Sroberto #eval 'sub INADDR_ANY { 0; } sub AF_INET {2;} sub SOCK_DGRAM {2;} 1;' || die "$0: $@"; 2954359Sroberto#}; 3054359Srobertorequire('getopts.pl'); # option parsing 3154359Srobertorequire('ctime.pl'); # date/time formatting 3254359Sroberto 3354359Sroberto;###################################### 3454359Sroberto;# define some global constants 3554359Sroberto;# 3654359Sroberto$BASE_TIMEOUT=10; 3754359Sroberto$FRAG_TIMEOUT=10; 3854359Sroberto$MAX_TRY = 5; 3954359Sroberto$REFRESH_TIME=60*15; # 15 minutes (server uses 1 hour) 4054359Sroberto$ntp'timeout = $FRAG_TIMEOUT; #'; 4154359Sroberto$ntp'timeout if 0; 4254359Sroberto 4354359Sroberto;###################################### 4454359Sroberto;# now process options 4554359Sroberto;# 4654359Srobertosub usage 4754359Sroberto{ 48280849Scy die("usage: $0 [-p <port>] [-l <logfile>] [host] ...\n"); 4954359Sroberto} 5054359Sroberto 5154359Sroberto&usage unless &Getopts('l:p:'); 5254359Sroberto&Getopts if 0; # make -w happy 5354359Sroberto 54280849Scy$opt_l = "/dev/null" # where to write debug messages to 55280849Scy if (!$opt_l); 56280849Scy$opt_p = 0 # port to use locally - (0 does mean: will be chosen by kernel) 57280849Scy if (!$opt_p); 58280849Scy 5954359Sroberto@Hosts = ($#ARGV < $[) ? ("localhost") : @ARGV; 6054359Sroberto 6154359Sroberto;# setup for debug output 6254359Sroberto$DEBUGFILE=$opt_l; 6354359Sroberto$DEBUGFILE="&STDERR" if $DEBUGFILE eq '-'; 6454359Sroberto 6554359Srobertoopen(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n"); 6654359Srobertoselect((select(DEBUG),$|=1)[$[]); 6754359Sroberto 6854359Sroberto;# &log prints a single trap record (adding a (local) time stamp) 6954359Srobertosub log 7054359Sroberto{ 7154359Sroberto chop($date=&ctime(time)); 7254359Sroberto print "$date ",@_,"\n"; 7354359Sroberto} 7454359Sroberto 7554359Srobertosub debug 7654359Sroberto{ 7754359Sroberto print DEBUG @_,"\n"; 7854359Sroberto} 7954359Sroberto;# 8054359Sroberto$proto_udp = (getprotobyname('udp'))[$[+2] || 8154359Sroberto (warn("$0: Could not get protocoll number for 'udp' using 17"), 17); 8254359Sroberto 8354359Sroberto$ntp_port = (getservbyname('ntp','udp'))[$[+2] || 8454359Sroberto (warn("$0: Could not get port number for service ntp/udp using 123"), 123); 8554359Sroberto 8654359Sroberto;# 8754359Srobertosocket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n"); 8854359Sroberto 8954359Sroberto;# 9054359Srobertobind(S, pack("S n a4 x8", &AF_INET, $opt_p, &INADDR_ANY)) || 9154359Sroberto die("Cannot bind: $!\n"); 9254359Sroberto 9354359Sroberto($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2]; 9454359Sroberto&log(sprintf("Listening at address %d.%d.%d.%d port %d", 9554359Sroberto unpack("C4",$my_addr), $my_port)); 9654359Sroberto 9754359Sroberto;# disregister with all servers in case of termination 9854359Srobertosub cleanup 9954359Sroberto{ 10054359Sroberto &log("Aborted by signal \"$_[$[]\"") if defined($_[$[]); 10154359Sroberto 10254359Sroberto foreach (@Hosts) 10354359Sroberto { 10454359Sroberto if ( ! defined($Host{$_}) ) 10554359Sroberto { 10654359Sroberto print "no info for host '$_'\n"; 10754359Sroberto next; 10854359Sroberto } 10954359Sroberto &ntp'send(S,31,0,"",pack("Sna4x8",&AF_INET,$ntp_port,$Host{$_})); #'; 11054359Sroberto } 11154359Sroberto close(S); 11254359Sroberto exit(2); 11354359Sroberto} 11454359Sroberto 11554359Sroberto$SIG{'HUP'} = 'cleanup'; 11654359Sroberto$SIG{'INT'} = 'cleanup'; 11754359Sroberto$SIG{'QUIT'} = 'cleanup'; 11854359Sroberto$SIG{'TERM'} = 'cleanup'; 11954359Sroberto 12054359Sroberto0 && $a && $b; 12154359Srobertosub timeouts # sort timeout id array 12254359Sroberto{ 12354359Sroberto $TIMEOUTS{$a} <=> $TIMEOUTS{$b}; 12454359Sroberto} 12554359Sroberto 12654359Sroberto;# a Request element looks like: pack("a4SC",addr,associd,op) 12754359Sroberto@Requests= (); 12854359Sroberto 12954359Sroberto;# compute requests for set trap control msgs to each host given 13054359Sroberto{ 13154359Sroberto local($name,$addr); 13254359Sroberto 13354359Sroberto foreach (@Hosts) 13454359Sroberto { 13554359Sroberto if (/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) 13654359Sroberto { 13754359Sroberto ($name,$addr) = 13854359Sroberto (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[,$[+4]; 13954359Sroberto unless (defined($name)) 14054359Sroberto { 14154359Sroberto $name = sprintf("[[%d.%d.%d.%d]]",$1,$2,$3,$4); 14254359Sroberto $addr = pack("C4",$1,$2,$3,$4); 14354359Sroberto } 14454359Sroberto } 14554359Sroberto else 14654359Sroberto { 14754359Sroberto ($name,$addr) = (gethostbyname($_))[$[,$[+4]; 14854359Sroberto unless (defined($name)) 14954359Sroberto { 15054359Sroberto warn "$0: unknown host \"$_\" - ignored\n"; 15154359Sroberto next; 15254359Sroberto } 15354359Sroberto } 15454359Sroberto next if defined($Host{$name}); 15554359Sroberto $Host{$name} = $addr; 15654359Sroberto $Host{$_} = $addr; 15754359Sroberto push(@Requests,pack("a4SC",$addr,0,6)); # schedule a set trap request for $name 15854359Sroberto } 15954359Sroberto} 16054359Sroberto 16154359Srobertosub hostname 16254359Sroberto{ 16354359Sroberto local($addr) = @_; 16454359Sroberto return $HostName{$addr} if defined($HostName{$addr}); 16554359Sroberto local($name) = gethostbyaddr($addr,&AF_INET); 16654359Sroberto &debug(sprintf("hostname(%d.%d.%d.%d) = \"%s\"",unpack("C4",$addr),$name)) 16754359Sroberto if defined($name); 16854359Sroberto defined($name) && ($HostName{$addr} = $name) && (return $name); 16954359Sroberto &debug(sprintf("Failed to get name for %d.%d.%d.%d",unpack("C4",$addr))); 17054359Sroberto return sprintf("[%d.%d.%d.%d]",unpack("C4",$addr)); 17154359Sroberto} 17254359Sroberto 17354359Sroberto;# when no hosts were given on the commandline no requests have been scheduled 17454359Sroberto&usage unless (@Requests); 17554359Sroberto 17654359Sroberto&debug(sprintf("%d request(s) scheduled",scalar(@Requests))); 17754359Srobertogrep(&debug(" - ".$_),keys(%Host)); 17854359Sroberto 17954359Sroberto;# allocate variables; 18054359Sroberto$addr=""; 18154359Sroberto$assoc=0; 18254359Sroberto$op = 0; 18354359Sroberto$timeout = 0; 18454359Sroberto$ret=""; 18554359Sroberto%TIMEOUTS = (); 18654359Sroberto%TIMEOUT_PROCS = (); 18754359Sroberto@TIMEOUTS = (); 18854359Sroberto 18954359Sroberto$len = 512; 19054359Sroberto$buf = " " x $len; 19154359Sroberto 19254359Srobertowhile (1) 19354359Sroberto{ 19454359Sroberto if (@Requests || @TIMEOUTS) # if there is some work pending 19554359Sroberto { 19654359Sroberto if (@Requests) 19754359Sroberto { 19854359Sroberto ($addr,$assoc,$op) = unpack("a4SC",($req = shift(@Requests))); 19954359Sroberto &debug(sprintf("Request: %s: %s(%d)",&hostname($addr), &ntp'cntrlop_name($op), $assoc)); #';)) 20054359Sroberto $ret = &ntp'send(S,$op,$assoc,"", #'( 20154359Sroberto pack("Sna4x8",&AF_INET,$ntp_port,$addr)); 20254359Sroberto &set_timeout("retry-".unpack("H*",$req),time+$BASE_TIMEOUT, 20354359Sroberto sprintf("&retry(\"%s\");",unpack("H*",$req))); 20454359Sroberto 20554359Sroberto last unless (defined($ret)); # warn called by ntp'send(); 20654359Sroberto 20754359Sroberto ;# if there are more requests just have a quick look for new messages 20854359Sroberto ;# otherwise grant server time for a response 20954359Sroberto $timeout = @Requests ? 0 : $BASE_TIMEOUT; 21054359Sroberto } 21154359Sroberto if ($timeout && @TIMEOUTS) 21254359Sroberto { 21354359Sroberto ;# ensure not to miss a timeout 21454359Sroberto if ($timeout + time > $TIMEOUTS{$TIMEOUTS[$[]}) 21554359Sroberto { 21654359Sroberto $timeout = $TIMEOUTS{$TIMEOUTS[$[]} - time; 21754359Sroberto $timeout = 0 if $timeout < 0; 21854359Sroberto } 21954359Sroberto } 22054359Sroberto } 22154359Sroberto else 22254359Sroberto { 22354359Sroberto ;# no work yet - wait for some messages dropping in 22454359Sroberto ;# usually this will not hapen as the refresh semantic will 22554359Sroberto ;# always have a pending timeout 22654359Sroberto undef($timeout); 22754359Sroberto } 22854359Sroberto 22954359Sroberto vec($mask="",fileno(S),1) = 1; 23054359Sroberto $ret = select($mask,undef,undef,$timeout); 23154359Sroberto 23254359Sroberto warn("$0: select: $!\n"),last if $ret < 0; # give up on error return from select 23354359Sroberto 23454359Sroberto if ($ret == 0) 23554359Sroberto { 23654359Sroberto ;# timeout 23754359Sroberto if (@TIMEOUTS && time > $TIMEOUTS{$TIMEOUTS[$[]}) 23854359Sroberto { 23954359Sroberto ;# handle timeout 24054359Sroberto $timeout_proc = 24154359Sroberto (delete $TIMEOUT_PROCS{$TIMEOUTS[$[]}, 24254359Sroberto delete $TIMEOUTS{shift(@TIMEOUTS)})[$[]; 24354359Sroberto eval $timeout_proc; 24454359Sroberto die "timeout eval (\"$timeout_proc\"): $@\n" if $@; 24554359Sroberto } 24654359Sroberto ;# else: there may be something to be sent 24754359Sroberto } 24854359Sroberto else 24954359Sroberto { 25054359Sroberto ;# data avail 25154359Sroberto $from = recv(S,$buf,$len,0); 25254359Sroberto ;# give up on error return from recv 25354359Sroberto warn("$0: recv: $!\n"), last unless (defined($from)); 25454359Sroberto 25554359Sroberto $from = (unpack("Sna4",$from))[$[+2]; # keep host addr only 25654359Sroberto ;# could check for ntp_port - but who cares 25754359Sroberto &debug("-Packet from ",&hostname($from)); 25854359Sroberto 25954359Sroberto ;# stuff packet into ntp mode 6 receive machinery 26054359Sroberto ($ret,$data,$status,$associd,$op,$seq,$auth_keyid) = 26154359Sroberto &ntp'handle_packet($buf,$from); # '; 26254359Sroberto &debug(sprintf("%s uses auth_keyid %d",&hostname($from),$auth_keyid)) if defined($auth_keyid); 26354359Sroberto next unless defined($ret); 26454359Sroberto 26554359Sroberto if ($ret eq "") 26654359Sroberto { 26754359Sroberto ;# handle packet 26854359Sroberto ;# simple trap response messages have neither timeout nor retries 26954359Sroberto &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))) unless $op == 7; 27054359Sroberto delete $RETRY{pack("a4SC",$from,$associd,$op)} unless $op == 7; 27154359Sroberto 27254359Sroberto &process_response($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid); 27354359Sroberto } 27454359Sroberto else 27554359Sroberto { 27654359Sroberto ;# some kind of error 27754359Sroberto &log(sprintf("%50s: %s: %s",(gethostbyaddr($from,&AF_INET))[$[],$ret,$data)); 27854359Sroberto if ($ret ne "TIMEOUT" && $ret ne "ERROR") 27954359Sroberto { 28054359Sroberto &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))); 28154359Sroberto } 28254359Sroberto } 28354359Sroberto } 28454359Sroberto 28554359Sroberto} 28654359Sroberto 28754359Srobertowarn("$0: terminating\n"); 28854359Sroberto&cleanup; 28954359Srobertoexit 0; 29054359Sroberto 29154359Sroberto;################################################## 29254359Sroberto;# timeout support 29354359Sroberto;# 29454359Srobertosub set_timeout 29554359Sroberto{ 29654359Sroberto local($id,$time,$proc) = @_; 29754359Sroberto 29854359Sroberto $TIMEOUTS{$id} = $time; 29954359Sroberto $TIMEOUT_PROCS{$id} = $proc; 30054359Sroberto @TIMEOUTS = sort timeouts keys(%TIMEOUTS); 30154359Sroberto chop($date=&ctime($time)); 30254359Sroberto &debug(sprintf("Schedule timeout \"%s\" for %s", $id, $date)); 30354359Sroberto} 30454359Sroberto 30554359Srobertosub clear_timeout 30654359Sroberto{ 30754359Sroberto local($id) = @_; 30854359Sroberto delete $TIMEOUTS{$id}; 30954359Sroberto delete $TIMEOUT_PROCS{$id}; 31054359Sroberto @TIMEOUTS = sort timeouts keys(%TIMEOUTS); 31154359Sroberto &debug("Clear timeout \"$id\""); 31254359Sroberto} 31354359Sroberto 31454359Sroberto0 && &refresh; 31554359Srobertosub refresh 31654359Sroberto{ 31754359Sroberto local($addr) = @_[$[]; 31854359Sroberto $addr = pack("H*",$addr); 31954359Sroberto &debug(sprintf("Refreshing trap for %s", &hostname($addr))); 32054359Sroberto push(@Requests,pack("a4SC",$addr,0,6)); 32154359Sroberto} 32254359Sroberto 32354359Sroberto0 && &retry; 32454359Srobertosub retry 32554359Sroberto{ 32654359Sroberto local($tag) = @_; 32754359Sroberto $tag = pack("H*",$tag); 32854359Sroberto $RETRY{$tag} = 0 if (!defined($RETRY{$tag})); 32954359Sroberto 33054359Sroberto if (++$RETRY{$tag} > $MAX_TRY) 33154359Sroberto { 33254359Sroberto &debug(sprintf("Retry failed: %s assoc %5d op %d", 33354359Sroberto &hostname(substr($tag,$[,4)), 33454359Sroberto unpack("x4SC",$tag))); 33554359Sroberto return; 33654359Sroberto } 33754359Sroberto &debug(sprintf("Retrying: %s assoc %5d op %d", 33854359Sroberto &hostname(substr($tag,$[,4)), 33954359Sroberto unpack("x4SC",$tag))); 34054359Sroberto push(@Requests,$tag); 34154359Sroberto} 34254359Sroberto 34354359Srobertosub process_response 34454359Sroberto{ 34554359Sroberto local($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid) = @_; 34654359Sroberto 34754359Sroberto $msg=""; 34854359Sroberto if ($op == 7) # trap response 34954359Sroberto { 35054359Sroberto $msg .= sprintf("%40s trap#%-5d", 35154359Sroberto &hostname($from),$seq); 35254359Sroberto &debug (sprintf("\nTrap %d associd %d:\n%s\n===============\n",$seq,$associd,$data)); 35354359Sroberto if ($associd == 0) # system event 35454359Sroberto { 35554359Sroberto $msg .= " SYSTEM "; 35654359Sroberto $evnt = &ntp'SystemEvent($status); #'; 35754359Sroberto $msg .= "$evnt "; 35854359Sroberto ;# for special cases add additional info 35954359Sroberto ($stratum) = ($data =~ /stratum=(\d+)/); 36054359Sroberto ($refid) = ($data =~ /refid=([\w\.]+)/); 36154359Sroberto $msg .= "stratum=$stratum refid=$refid"; 36254359Sroberto if ($refid =~ /\[?(\d+)\.(\d+)\.(\d+)\.(\d+)/) 36354359Sroberto { 36454359Sroberto local($x) = (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET)); 36554359Sroberto $msg .= " " . $x if defined($x) 36654359Sroberto } 36754359Sroberto if ($evnt eq "event_sync_chg") 36854359Sroberto { 36954359Sroberto $msg .= sprintf("%s %s ", 37054359Sroberto &ntp'LI($status), #', 37154359Sroberto &ntp'ClockSource($status) #' 37254359Sroberto ); 37354359Sroberto } 37454359Sroberto elsif ($evnt eq "event_sync/strat_chg") 37554359Sroberto { 37654359Sroberto ($peer) = ($data =~ /peer=([0-9]+)/); 37754359Sroberto $msg .= " peer=$peer"; 37854359Sroberto } 37954359Sroberto elsif ($evnt eq "event_clock_excptn") 38054359Sroberto { 38154359Sroberto if (($device) = ($data =~ /device=\"([^\"]+)\"/)) 38254359Sroberto { 38354359Sroberto ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/); 38454359Sroberto $Cstatus = hex($cstatus); 38554359Sroberto $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #'); 38654359Sroberto ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/); 38754359Sroberto $msg .= " \"$device\" \"$timecode\""; 38854359Sroberto } 38954359Sroberto else 39054359Sroberto { 39154359Sroberto push(@Requests,pack("a4SC",$from, $associd, 4)); 39254359Sroberto } 39354359Sroberto } 39454359Sroberto } 39554359Sroberto else # peer event 39654359Sroberto { 39754359Sroberto $msg .= sprintf("peer %5d ",$associd); 39854359Sroberto ($srcadr) = ($data =~ /srcadr=\[?([\d\.]+)/); 39954359Sroberto $msg .= sprintf("%-18s %40s ", "[$srcadr]", 40054359Sroberto &hostname(pack("C4",split(/\./,$srcadr)))); 40154359Sroberto $evnt = &ntp'PeerEvent($status); #'; 40254359Sroberto $msg .= "$evnt "; 40354359Sroberto ;# for special cases include additional info 40454359Sroberto if ($evnt eq "event_clock_excptn") 40554359Sroberto { 40654359Sroberto if (($device) = ($data =~ /device=\"([^\"]+)\"/)) 40754359Sroberto { 40854359Sroberto ;#&debug("----\n$data\n====\n"); 40954359Sroberto ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/); 41054359Sroberto $Cstatus = hex($cstatus); 41154359Sroberto $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #'); 41254359Sroberto ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/); 41354359Sroberto $msg .= " \"$device\" \"$timecode\""; 41454359Sroberto } 41554359Sroberto else 41654359Sroberto { 41754359Sroberto ;# no clockvars included - post a cv request 41854359Sroberto push(@Requests,pack("a4SC",$from, $associd, 4)); 41954359Sroberto } 42054359Sroberto } 42154359Sroberto elsif ($evnt eq "event_stratum_chg") 42254359Sroberto { 42354359Sroberto ($stratum) = ($data =~ /stratum=(\d+)/); 42454359Sroberto $msg .= "new stratum $stratum"; 42554359Sroberto } 42654359Sroberto } 42754359Sroberto } 42854359Sroberto elsif ($op == 6) # set trap resonse 42954359Sroberto { 43054359Sroberto &debug("Set trap ok from ",&hostname($from)); 43154359Sroberto &set_timeout("refresh-".unpack("H*",$from),time+$REFRESH_TIME, 43254359Sroberto sprintf("&refresh(\"%s\");",unpack("H*",$from))); 43354359Sroberto return; 43454359Sroberto } 43554359Sroberto elsif ($op == 4) # read clock variables response 43654359Sroberto { 43754359Sroberto ;# status of clock 43854359Sroberto $msg .= sprintf(" %40s ", &hostname($from)); 43954359Sroberto if ($associd == 0) 44054359Sroberto { 44154359Sroberto $msg .= "system clock status: "; 44254359Sroberto } 44354359Sroberto else 44454359Sroberto { 44554359Sroberto $msg .= sprintf("peer %5d clock",$associd); 44654359Sroberto } 44754359Sroberto $msg .= sprintf("%-32s",&ntp'clock_status($status)); #'); 44854359Sroberto ($device) = ($data =~ /device=\"([^\"]+)\"/); 44954359Sroberto ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/); 45054359Sroberto $msg .= " \"$device\" \"$timecode\""; 45154359Sroberto } 45254359Sroberto elsif ($op == 31) # unset trap response (UNOFFICIAL op) 45354359Sroberto { 45454359Sroberto ;# clear timeout 45554359Sroberto &debug("Clear Trap ok from ",&hostname($from)); 45654359Sroberto &clear_timeout("refresh-".unpack("H*",$from)); 45754359Sroberto return; 45854359Sroberto } 45954359Sroberto else # unexpected response 46054359Sroberto { 46154359Sroberto $msg .= "unexpected response to op $op assoc=$associd"; 46254359Sroberto $msg .= sprintf(" status=%04x",$status); 46354359Sroberto } 46454359Sroberto &log($msg); 46554359Sroberto} 466