Annotation of embedaddon/ntp/scripts/monitoring/ntptrap, revision 1.1.1.1

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>