home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 1 / 1008 < prev    next >
Internet Message Format  |  1990-12-28  |  14KB
  1. From: tchrist@convex.com (Tom Christiansen)
  2. Newsgroups: comp.lang.perl,alt.sources
  3. Subject: statmon: monitor up/down and time status of hosts
  4. Message-ID: <100508@convex.convex.com>
  5. Date: 10 Mar 90 14:48:06 GMT
  6.  
  7. Here's a little program I hacked up the other night to watch when hosts
  8. went up and down, as well as how their clocks strayed.  To find out
  9. how this thing works, you can do these things:
  10.  
  11.     *    read the following description
  12.     *    call statmon w/o any args for a usage message
  13.     *    type `h' while in the program 
  14.     *   read the source
  15.  
  16. I suggest all in that order.  If nothing else, the source is
  17. a decent example of playing with cbreak and echo mode, using
  18. UDP sockets, using select to multiplex i/o and timeouts, and for
  19. using the dump operator to greatly speed up start up time.  
  20. It probably won't work very well, if at all, for non-BSD(ish) sites.
  21.  
  22. Here's what it does:  given a list of hosts, which can be read in from
  23. a file (a simplified ghosts-type file) it tries to talk to the time/udp
  24. service of their inetd's, and if they go too long without any answer
  25. after repeated attempts, it considers them down and tells you so.  When
  26. they come back up again, you get a message that this has happened.
  27. This is better than mere pings, as it requires a coherent inetd to
  28. answer you and is pretty cheap.  The program will also tell you which
  29. hosts have times that are far astray from your own.  The retry,
  30. timeout, clock tolerance, and sleep interval between sends are all
  31. command-line configurable.  This is all done asynchronously with
  32. select()s, including your keyboard inputs, which are in cbreak mode.
  33.  
  34. Porting notes:  you'll need the following include files, probably in
  35. the perl library directory, which you should have generated from the
  36. corresponding C include files using the makelib program in the perl
  37. source directory:
  38.  
  39.     sys/errno.h
  40.     sys/socket.h
  41.     sys/ioctl.h
  42.  
  43. The last one needs a %sizeof array to work right.  I put mine
  44. in sizeof.h in the perl library.  Mine happens to look like this.
  45. Yours, unless you're on a Convex, will almost surely vary.
  46.  
  47.     $sizeof{'char'} = 1;
  48.     $sizeof{'int'} = 4;
  49.     $sizeof{'long'} = 4;
  50.     $sizeof{'float'} = 4;
  51.     $sizeof{'double'} = 8;
  52.     $sizeof{'long long'} = 8;
  53.     $sizeof{'struct arpreq'} = 36;
  54.     $sizeof{'struct ifconf'} = 8;
  55.     $sizeof{'struct ifreq'} = 32;
  56.     $sizeof{'struct ltchars'} = 6;
  57.     $sizeof{'struct pcntl'} = 116;
  58.     $sizeof{'struct rtentry'} = 52;
  59.     $sizeof{'struct sgttyb'} = 6;
  60.     $sizeof{'struct tchars'} = 6;
  61.     $sizeof{'struct ttychars'} = 14;
  62.     $sizeof{'struct winsize'} = 8;
  63.     $sizeof{'struct system_information'} = 12;
  64.     1;
  65.  
  66. It also wants getopts.pl and ctime.pl.  
  67.  
  68. If you find yourself with copious quantities of unwanted disk
  69. space, you can spare yourself the costs of initialization at
  70. each startup by calling 'statmon -u' to dump the state of the
  71. program.  This will skip all the include files and static init
  72. code when restarted.  I suggest you make sure that the program
  73. actually runs first, though, before you bother to dump it.  Also,
  74. those are big include files, so your dump will be pretty huge.
  75.  
  76. --tom
  77.  
  78. #! /bin/sh
  79. # This is a shell archive, meaning:
  80. # 1. Remove everything above the #! /bin/sh line.
  81. # 2. Save the resulting text in a file.
  82. # 3. Execute the file with /bin/sh (not csh) to create:
  83. #    statmon
  84. # This archive created: Sat Mar 10 08:23:23 1990
  85. export PATH; PATH=/bin:/usr/bin:$PATH
  86. echo shar: "extracting 'statmon'" '(9588 characters)'
  87. if test -f 'statmon'
  88. then
  89.     echo shar: "will not over-write existing file 'statmon'"
  90. else
  91. sed 's/^    X//' << \SHAR_EOF > 'statmon'
  92.     X#!/usr/bin/perl
  93.     X#
  94.     X# statmon - check for hosts going up and down, or with bad clocks
  95.     X# tom christiansen <tchrist@convex.com> on 3/8/90
  96.     X#
  97.     X
  98.     XRESTART:              # shouldn't really need this...
  99.     X
  100.     X($program = $0) =~ s%.*/%%;
  101.     X$version = 0.3;
  102.     X
  103.     X$| = 1;
  104.     X
  105.     X&bad_usage unless $#ARGV >= 0;
  106.     X
  107.     Xprintf "%s v%3.1g; ", $program, $version;
  108.     X
  109.     Xif ($compiled) {
  110.     X    print "quick start.... ";
  111.     X} else {
  112.     X    print "initializing... ";
  113.     X    
  114.     X    # some useful constants
  115.     X    $sockaddr_t    = 'S n a4 x8';
  116.     X    $inetaddr_t = 'C4';
  117.     X    $sgttyb_t   = 'C4 S';            
  118.     X
  119.     X    $SINCE_1970 = 2208988800;
  120.     X
  121.     X    $def_timeout  = 5;      # how long we give a host to answer us
  122.     X    $def_timewarp = 10;     # how far time may vary until we complain
  123.     X    $def_retries  = 5;        # he gets this many tries to answer us
  124.     X    $def_sleep    = 5;      # between send loops
  125.     X
  126.     X    $retries      = $def_retries;
  127.     X    $timeout      = $def_timeout;
  128.     X    $timewarp     = $def_timewarp;
  129.     X    $sleep        = $def_sleep;
  130.     X
  131.     X    $OOPS = ", can't continue";
  132.     X
  133.     X    $dashes = ('-' x 75) . "\n";
  134.     X
  135.     X    %cmds = (
  136.     X    'q',    'quit',
  137.     X    'x',    'quit',
  138.     X    'h',    'help',
  139.     X    '?',    'help',
  140.     X    't',    'timers',
  141.     X    'd',    'downers',
  142.     X    'u',    'uppers' ,
  143.     X    'm',    'missing',
  144.     X    'U',    'usage' 
  145.     X    );
  146.     X
  147.     X    &source('sys/errno.h');
  148.     X    &source('sys/socket.h');
  149.     X    &source('sizeof.h');
  150.     X    &source('sys/ioctl.h');
  151.     X    &source('ctime.pl');
  152.     X    &source('getopts.pl');
  153.     X} 
  154.     X
  155.     X
  156.     X&Getopts('udmt:r:c:s:') || &bad_usage;
  157.     X
  158.     X$debug = $opt_d;
  159.     X
  160.     X
  161.     X$retries  = $opt_r if defined $opt_r;
  162.     X$timeout  = $opt_t if defined $opt_t;
  163.     X$timewarp = $opt_c if defined $opt_c;
  164.     X$sleep    = $opt_s if defined $opt_s;
  165.     X
  166.     X
  167.     Xif ($opt_u) {  # dump this puppy
  168.     X    $compiled = 1;
  169.     X    print "dumping\n";
  170.     X    reset 'o';        # so the opt_* vars (especially $opt_u!) go away
  171.     X    dump RESTART;
  172.     X    # not reached
  173.     X} 
  174.     X
  175.     X@SIG{'INT','HUP','TERM','QUIT'} = ('quit','quit','quit','quit');
  176.     X
  177.     X$SIG{'CONT'} = 'continue';
  178.     X
  179.     X# if they say -m, then they want to take stuff from /usr/adm/MACHINES
  180.     X#
  181.     X# which is of the general form:
  182.     X#
  183.     X#    NAME    features
  184.     X#
  185.     X#    spool   vax bsd
  186.     X#    coyote    sunos4 diskserver
  187.     X#    pokey    sunos4 diskless slow
  188.     X#    gort     convex bsd 
  189.     X#
  190.     Xif ($opt_m) {
  191.     X    # try very hard to find a machines file
  192.     X    $MACHINES = $ENV{'GHOSTS'};
  193.     X    $MACHINES = $ENV{'MACHINES'}         unless $MACHINES;        
  194.     X    $MACHINES = $ENV{'HOME'} . '/.ghosts'   unless $MACHINES;
  195.     X    $MACHINES = $ENV{'HOME'} . '/.machines' unless -f $MACHINES;
  196.     X    $MACHINES = '/usr/adm/MACHINES'         unless -f $MACHINES;
  197.     X
  198.     X    die "Can't find any MACHINES file"      unless -f $MACHINES;
  199.     X
  200.     X    open MACHINES ||                        die "can't open $MACHINES: $!";
  201.     X
  202.     X    print "opened $MACHINES\n"            if $debug;
  203.     X    @hosts = <MACHINES>;
  204.     X    close MACHINES;
  205.     X
  206.     X    @hosts = grep(/^\w+\s/, @hosts);
  207.     X
  208.     X    while ($criterion = shift) {
  209.     X    @hosts = grep(/\b$criterion\b/, @hosts);
  210.     X    } 
  211.     X
  212.     X    for (@hosts) {
  213.     X    chop;
  214.     X    s/^(\w+).*/$1/;
  215.     X    } 
  216.     X} else {
  217.     X    @hosts = @ARGV;
  218.     X} 
  219.     X
  220.     Xif ($#hosts < 0) {
  221.     X    print "No hosts\n";
  222.     X    &bad_usage;
  223.     X} 
  224.     X
  225.     Xprint "hosts are @hosts\n" if $debug;
  226.     X
  227.     X#
  228.     X# ok, now create our socket we want everyone to talk to us at
  229.     X#
  230.     X
  231.     Xchop ($localhost = `hostname`);
  232.     X
  233.     X(($name, $aliases, $type, $len, $thisaddr) = gethostbyname($localhost))
  234.     X    || die "no localhost \"$localhost\"$OOPS";
  235.     X
  236.     X(($name, $aliases, $port, $proto) = getservbyname('time', 'udp'))
  237.     X    || die "no udp service for \"time\"$OOPS";
  238.     X
  239.     Xprint "service is $name, port is $port\n" 
  240.     X    if $debug;
  241.     X
  242.     X
  243.     X(($name, $aliases, $proto) = getprotobyname('udp'))
  244.     X    || die "can't get udp proto$OOPS" ;
  245.     X
  246.     X
  247.     Xsocket(SOCKET, &AF_INET, &SOCK_DGRAM, $proto) 
  248.     X    || die "can't get socket$OOPS";
  249.     X
  250.     X$this = &sockaddr(&AF_INET, 0, $thisaddr);
  251.     X
  252.     Xbind(SOCKET, $this) 
  253.     X    || die "can't bind socket: $!$OOPS";
  254.     X
  255.     X#
  256.     X# now go find all of our hosts' addresses, storing
  257.     X# these in %hosts keyed on $name
  258.     X#
  259.     X
  260.     X
  261.     Xprint "fetching addrs... ";
  262.     X
  263.     for $host (@hosts) {
  264.     X    (($name, $aliases, $type, $len, @addrs) = gethostbyname($host))
  265.     X    || die "no remote \"$host\"\n";
  266.     X
  267.     X    $name =~ s/\.convex\.com$//;
  268.     X
  269.     X    $hosts{$name} = $addrs[0];
  270.     X}
  271.     X
  272.     Xprint "done.\nType 'h' for help.\n";
  273.     X
  274.     X$rin = $win = $ein = '';
  275.     Xvec($rin,fileno(SOCKET),1) = 1;
  276.     Xvec($ttyin,fileno(STDIN),1) = 1;
  277.     X$rin |= $ttyin;
  278.     X
  279.     X
  280.     X
  281.     X# now keep interrogating forever
  282.     Xfor (;;) {
  283.     X    %sent = ();  # haven't sent anybody anything yet
  284.     X    $sent = 0;
  285.     X
  286.     X    &cbreak;
  287.     X
  288.     X    print $dashes, "entering send loop\n" if $debug;
  289.     X
  290.     X    while (($name, $addr) = each %hosts) {
  291.     X    $that = &sockaddr(&AF_INET, $port, $addr);
  292.     X
  293.     X    if (!send(SOCKET,0,0,$that)) {
  294.     X        printf STDERR "couldn't send to %-12s %-16s\n", $name, &fmtaddr($addr);
  295.     X        next;
  296.     X    }
  297.     X
  298.     X    $sent{$name}++;
  299.     X    $sent++;
  300.     X
  301.     X    #printf "sent to %-12s %s\n", $name, &fmtaddr($addr) if $debug;
  302.     X    }
  303.     X
  304.     X    print $dashes, "entering recv loop\n" if $debug;
  305.     X
  306.     X    $ntimeout = $timeout;
  307.     X
  308.     X    while ($sent > 0) {
  309.     X        $then = time;
  310.     X        last unless $nfound = select($rout=$rin, $wout=$win, $eout=$ein, $ntimeout);
  311.     X        if ($nfound < 0) {
  312.     X        warn "select failed: $!\n" unless $! == &EINTR;
  313.     X        redo;
  314.     X        } 
  315.     X        $took = (time - $then);
  316.     X        $ntimeout -= $took; 
  317.     X
  318.     X        &readsock if vec($rout,fileno(SOCKET),1); 
  319.     X        &readtty if vec($rout,fileno(STDIN),1); 
  320.     X    }
  321.     X
  322.     X    for $name (sort keys %sent) {
  323.     X    $missed{$name}++;
  324.     X    printf "%-12s missed %d times\n", $name, $missed{$name} if $debug;
  325.     X    if (! $down{$name}) {
  326.     X        next unless $missed{$name} > $retries;
  327.     X        next if $down{$name};
  328.     X        $down{$name} = time;
  329.     X        printf "%-12s %-16s down at %s", 
  330.     X        $name, &fmtaddr($hosts{$name}), &ctime($down{$name});
  331.     X    }
  332.     X    } 
  333.     X
  334.     X    print "sleeping $sleep -- hit any key to interrupt\n" if $debug;
  335.     X    select($ttyout = $ttyin, $wout=$win, $eout = $ein, $sleep);
  336.     X    &readtty if vec($ttyout,fileno(STDIN),1); 
  337.     X}
  338.     X
  339.     Xsub sockaddr {
  340.     X    if (wantarray) {
  341.     X        unpack($sockaddr_t, $_[0]);
  342.     X    } else {
  343.     X        pack($sockaddr_t, $_[0], $_[1], $_[2]);
  344.     X    } 
  345.     X} 
  346.     X
  347.     Xsub inetaddr {
  348.     X    if (wantarray) {
  349.     X        unpack($inetaddr_t, $_[0]);
  350.     X    } else {
  351.     X        pack($inetaddr_t, $_[0], $_[1], $_[2]);
  352.     X    }
  353.     X} 
  354.     X
  355.     Xsub source {
  356.     X    local($file) = @_;
  357.     X    local($return) = 0;
  358.     X
  359.     X    $return = do $file;
  360.     X    die "couldn't do \"$file\": $!" unless defined $return;
  361.     X    die "couldn't parse \"$file\": $@" if $@;
  362.     X    die "couldn't run \"$file\"" unless $return;
  363.     X}
  364.     X
  365.     Xsub usage {
  366.     X    print STDERR <<EOM;
  367.     Xusage: $program [switches] host ...
  368.     X   or: $program [switches] -m [criterion ...]
  369.     X
  370.     Xswitches are:
  371.     X    -m  look in MACHINES file for hosts matching criteria
  372.     X
  373.     X    -t    timeout for responses (default $def_timeout)
  374.     X    -r    retries until timed-out host considered down (default $def_retries)
  375.     X    -c  clock drift tolerance (default $def_timewarp)
  376.     X    -s  sleep interval between send loops (default $def_sleep)
  377.     X
  378.     X    -d  print out debugging information
  379.     X    -u  dump state to disk for faster init
  380.     XEOM
  381.     X} 
  382.     X
  383.     Xsub bad_usage {
  384.     X    &usage;
  385.     X    exit(1);
  386.     X} 
  387.     X
  388.     Xsub fmtaddr {
  389.     X    sprintf("[%d.%d.%d.%d]", &inetaddr($_[0]));
  390.     X} 
  391.     X
  392.     X
  393.     Xsub readsock {
  394.     X    ($hisaddr = recv(SOCKET,$histime='',4,0))
  395.     X    || (warn "couldn't recv: $!$OOPS", return);
  396.     X
  397.     X    $sent--;
  398.     X
  399.     X    ($addrtype, $port, $iaddr) = &sockaddr($hisaddr);
  400.     X
  401.     X    $histime = unpack('L',$histime);
  402.     X    $histime -= $SINCE_1970;
  403.     X
  404.     X    unless (($name,$aliases,$addrtype,$length,@addrs) =
  405.     X        gethostbyaddr($iaddr,$addrtype)) 
  406.     X    {
  407.     X    printf STDERR "received reply from unknown address %sn",
  408.     X                &fmtaddr($iaddr);
  409.     X    next;
  410.     X    } 
  411.     X    $name =~ s/\.convex\.com$//;
  412.     X
  413.     X    printf "%-12s %-16s thinks it's %s", 
  414.     X        $name, &fmtaddr($iaddr), &ctime($histime) if $debug;
  415.     X
  416.     X    $delta = ($histime - time);
  417.     X    $delta = -$delta if $delta < 0;
  418.     X    $delta{$name} = $delta;
  419.     X
  420.     X    delete $missed{$name};
  421.     X
  422.     X    if ($down{$name}) {
  423.     X    printf "%-12s %-16s back at %s",
  424.     X        $name, &fmtaddr($iaddr), &ctime(time);
  425.     X    delete $down{$name};
  426.     X    } 
  427.     X
  428.     X    printf "funny, i didn't send $name anything\n" unless $hosts{$name};
  429.     X    delete $sent{$name};
  430.     X}
  431.     X
  432.     Xsub readtty {
  433.     X    local($cmd) = getc;
  434.     X    local($routine) = '';
  435.     X
  436.     X    $cmd = sprintf ("%c", ord($cmd) & 0x7f);
  437.     X
  438.     X    if (defined $cmds{$cmd}) {
  439.     X    $routine = $cmds{$cmd};
  440.     X    print "\n",$dashes unless $routine eq 'quit';
  441.     X    &$routine;
  442.     X    print $dashes;
  443.     X    } else {
  444.     X    printf " -- unknown command: `%s' (0x%02x)\n", $cmd, ord($cmd);
  445.     X    } 
  446.     X} 
  447.     X
  448.     Xsub quit {
  449.     X    $SIG{'TTOU'} = "IGNORE";
  450.     X    &cooked;
  451.     X    exit 0;
  452.     X} 
  453.     X
  454.     Xsub help {
  455.     X    local($cmd);
  456.     X    print "Key\tCommand\n";
  457.     X    for $cmd (sort keys %cmds) {
  458.     X    printf "%s\t%s\n", $cmd, $cmds{$cmd};
  459.     X    } 
  460.     X} 
  461.     X
  462.     Xsub timers {
  463.     X    local($name);
  464.     X    print "Bad Clocks exceeding $timewarp seconds\n";
  465.     X    for $name (sort keys %delta) {
  466.     X    next unless $delta{$name} > $timewarp;
  467.     X    printf "%-12s %-16s has a clock that's %4d seconds off\n", 
  468.     X        $name, &fmtaddr($hosts{$name}), $delta{$name};
  469.     X    }
  470.     X}
  471.     X
  472.     X
  473.     Xsub missing {
  474.     X    local($name);
  475.     X    print "Missing Hosts\n";
  476.     X    for $name (sort keys %missed) {
  477.     X    printf "%-12s %-16s has missed %d timeout%s of %d seconds\n",
  478.     X        $name, &fmtaddr($hosts{$name}), $missed{$name},
  479.     X        ($missed{$name} == 1) ? " " : "s", $timeout;
  480.     X    }
  481.     X} 
  482.     X
  483.     Xsub downers {
  484.     X    local($name);
  485.     X    print "Down Hosts\n";
  486.     X    for $name (sort keys %down) {
  487.     X    printf "%-12s %-16s down since %s", 
  488.     X        $name, &fmtaddr($hosts{$name}), &ctime($down{$name});
  489.     X    } 
  490.     X} 
  491.     X
  492.     Xsub uppers {
  493.     X    local ($name);
  494.     X
  495.     X    print "Up Hosts\n";
  496.     X
  497.     X    for $name (sort keys %hosts) {
  498.     X    next if $down{$name};
  499.     X    printf "%-12s up\n", $name;
  500.     X    } 
  501.     X} 
  502.     X
  503.     Xsub continue { 
  504.     X    print "continuing...\n";
  505.     X    &cbreak; 
  506.     X}
  507.     X
  508.     Xsub cbreak {
  509.     X    &set_cbreak(1);
  510.     X} 
  511.     X
  512.     Xsub cooked {
  513.     X    &set_cbreak(0);
  514.     X} 
  515.     X
  516.     Xsub set_cbreak {
  517.     X    local($on) = @_;
  518.     X
  519.     X    ioctl(STDIN,&TIOCGETP,$sgttyb) 
  520.     X    || die "Can't ioctl TIOCGETP: $!";
  521.     X
  522.     X    @ary = unpack($sgttyb_t,$sgttyb);
  523.     X    if ($on) {
  524.     X    $ary[4] |= &CBREAK;
  525.     X    $ary[4] &= ~&ECHO;
  526.     X    } else {
  527.     X    $ary[4] &= ~&CBREAK;
  528.     X    $ary[4] |= &ECHO;
  529.     X    }
  530.     X    $sgttyb = pack($sgttyb_t,@ary);
  531.     X    ioctl(STDIN,&TIOCSETP,$sgttyb)
  532.     X        || die "Can't ioctl TIOCSETP: $!";
  533.     X
  534.     X}
  535. SHAR_EOF
  536. if test 9588 -ne "`wc -c < 'statmon'`"
  537. then
  538.     echo shar: "error transmitting 'statmon'" '(should have been 9588 characters)'
  539. fi
  540. chmod 775 'statmon'
  541. fi
  542. exit 0
  543. #    End of shell archive
  544. --
  545.  
  546.     Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist 
  547.     Convex Computer Corporation                            tchrist@convex.COM
  548.          "EMACS belongs in <sys/errno.h>: Editor too big!"
  549.