home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / tutorial / eg / statmon < prev    next >
Encoding:
Text File  |  1990-03-10  |  9.4 KB  |  447 lines
  1. #!/usr/bin/perl
  2. #
  3. # statmon - check for hosts going up and down, or with bad clocks
  4. # tom christiansen <tchrist@convex.com> on 3/8/90
  5. #
  6.  
  7. RESTART:              # shouldn't really need this...
  8.  
  9. ($program = $0) =~ s%.*/%%;
  10. $version = 0.3;
  11.  
  12. $| = 1;
  13.  
  14. &bad_usage unless $#ARGV >= 0;
  15.  
  16. printf "%s v%3.1g; ", $program, $version;
  17.  
  18. if ($compiled) {
  19.     print "quick start.... ";
  20. } else {
  21.     print "initializing... ";
  22.     
  23.     # some useful constants
  24.     $sockaddr_t    = 'S n a4 x8';
  25.     $inetaddr_t = 'C4';
  26.     $sgttyb_t   = 'C4 S';            
  27.  
  28.     $SINCE_1970 = 2208988800;
  29.  
  30.     $def_timeout  = 5;      # how long we give a host to answer us
  31.     $def_timewarp = 10;     # how far time may vary until we complain
  32.     $def_retries  = 5;        # he gets this many tries to answer us
  33.     $def_sleep    = 5;      # between send loops
  34.  
  35.     $retries      = $def_retries;
  36.     $timeout      = $def_timeout;
  37.     $timewarp     = $def_timewarp;
  38.     $sleep        = $def_sleep;
  39.  
  40.     $OOPS = ", can't continue";
  41.  
  42.     $dashes = ('-' x 75) . "\n";
  43.  
  44.     %cmds = (
  45.     'q',    'quit',
  46.     'x',    'quit',
  47.     'h',    'help',
  48.     '?',    'help',
  49.     't',    'timers',
  50.     'd',    'downers',
  51.     'u',    'uppers' ,
  52.     'm',    'missing',
  53.     'U',    'usage' 
  54.     );
  55.  
  56.     &source('sys/errno.h');
  57.     &source('sys/socket.h');
  58.     &source('sizeof.h');
  59.     &source('sys/ioctl.h');
  60.     &source('ctime.pl');
  61.     &source('getopts.pl');
  62. } 
  63.  
  64.  
  65. &Getopts('udmt:r:c:s:') || &bad_usage;
  66.  
  67. $debug = $opt_d;
  68.  
  69.  
  70. $retries  = $opt_r if defined $opt_r;
  71. $timeout  = $opt_t if defined $opt_t;
  72. $timewarp = $opt_c if defined $opt_c;
  73. $sleep    = $opt_s if defined $opt_s;
  74.  
  75. DUMP: {
  76.     if ($opt_u) {  # dump this puppy
  77.     if ($compiled++) {
  78.         warn "already dumped, ignoring -u\n";
  79.         last DUMP;
  80.     } 
  81.     print "dumping\n";
  82.     reset 'o';        # so the opt_* vars (especially $opt_u!) go away
  83.     dump RESTART;
  84.     # not reached
  85.     } 
  86. }
  87.  
  88. $SIG{'INT'}  = $SIG{'HUP'} = $SIG{'TERM'} = $SIG{'QUIT'} = 'quit';
  89. $SIG{'CONT'} = 'continue';
  90.  
  91. # if they say -m, then they want to take stuff from /usr/adm/MACHINES
  92. #
  93. # which is of the general form:
  94. #
  95. #    NAME    features
  96. #
  97. #    spool   vax bsd
  98. #    coyote    sunos4 diskserver
  99. #    pokey    sunos4 diskless slow
  100. #    gort     convex bsd 
  101. #
  102. if ($opt_m) {
  103.     # try very hard to find a machines file
  104.     $MACHINES = $ENV{'GHOSTS'};
  105.     $MACHINES = $ENV{'MACHINES'}         unless $MACHINES;        
  106.     $MACHINES = $ENV{'HOME'} . '/.ghosts'   unless $MACHINES;
  107.     $MACHINES = $ENV{'HOME'} . '/.machines' unless -f $MACHINES;
  108.     $MACHINES = '/usr/adm/MACHINES'         unless -f $MACHINES;
  109.  
  110.     die "Can't find any MACHINES file"      unless -f $MACHINES;
  111.  
  112.     open MACHINES ||                        die "can't open $MACHINES: $!";
  113.  
  114.     print "opened $MACHINES\n"            if $debug;
  115.     @hosts = <MACHINES>;
  116.     close MACHINES;
  117.  
  118.     @hosts = grep(/^\w+\s/, @hosts);
  119.  
  120.     while ($criterion = shift) {
  121.     @hosts = grep(/\b$criterion\b/, @hosts);
  122.     } 
  123.  
  124.     for (@hosts) {
  125.     chop;
  126.     s/^(\w+).*/$1/;
  127.     } 
  128. } else {
  129.     @hosts = @ARGV;
  130. } 
  131.  
  132. if ($#hosts < 0) {
  133.     print "No hosts\n";
  134.     &bad_usage;
  135. } 
  136.  
  137. print "hosts are @hosts\n" if $debug;
  138.  
  139. #
  140. # ok, now create our socket we want everyone to talk to us at
  141. #
  142.  
  143. chop ($localhost = `hostname`);
  144.  
  145. (($name, $aliases, $type, $len, $thisaddr) = gethostbyname($localhost))
  146.     || die "no localhost \"$localhost\"$OOPS";
  147.  
  148. (($name, $aliases, $port, $proto) = getservbyname('time', 'udp'))
  149.     || die "no udp service for \"time\"$OOPS";
  150.  
  151. print "service is $name, port is $port\n" 
  152.     if $debug;
  153.  
  154.  
  155. (($name, $aliases, $proto) = getprotobyname('udp'))
  156.     || die "can't get udp proto$OOPS" ;
  157.  
  158.  
  159. socket(SOCKET, &AF_INET, &SOCK_DGRAM, $proto) 
  160.     || die "can't get socket$OOPS";
  161.  
  162. $this = &sockaddr(&AF_INET, 0, $thisaddr);
  163.  
  164. bind(SOCKET, $this) 
  165.     || die "can't bind socket: $!$OOPS";
  166.  
  167. #
  168. # now go find all of our hosts' addresses, storing
  169. # these in %hosts keyed on $name
  170. #
  171.  
  172.  
  173. print "fetching addrs... ";
  174.  
  175. for $host (@hosts) {
  176.     (($name, $aliases, $type, $len, @addrs) = gethostbyname($host))
  177.     || die "no remote \"$host\"\n";
  178.  
  179.     $name =~ s/\.convex\.com$//;
  180.  
  181.     $hosts{$name} = $addrs[0];
  182. }
  183.  
  184. print "done.\nType 'h' for help.\n";
  185.  
  186. $rin = $win = $ein = '';
  187. vec($rin,fileno(SOCKET),1) = 1;
  188. vec($ttyin,fileno(STDIN),1) = 1;
  189. $rin |= $ttyin;
  190.  
  191.  
  192.  
  193. # now keep interrogating forever
  194. for (;;) {
  195.     %sent = ();  # haven't sent anybody anything yet
  196.     $sent = 0;
  197.  
  198.     &cbreak;
  199.  
  200.     print $dashes, "entering send loop\n" if $debug;
  201.  
  202.     while (($name, $addr) = each %hosts) {
  203.     $that = &sockaddr(&AF_INET, $port, $addr);
  204.  
  205.     if (!send(SOCKET,0,0,$that)) {
  206.         printf STDERR "couldn't send to %-12s %-16s\n", $name, &fmtaddr($addr);
  207.         next;
  208.     }
  209.  
  210.     $sent{$name}++;
  211.     $sent++;
  212.  
  213.     #printf "sent to %-12s %s\n", $name, &fmtaddr($addr) if $debug;
  214.     }
  215.  
  216.     print $dashes, "entering recv loop\n" if $debug;
  217.  
  218.     $ntimeout = $timeout;
  219.  
  220.     while ($sent > 0) {
  221.         $then = time;
  222.         last unless $nfound = select($rout=$rin, $wout=$win, $eout=$ein, $ntimeout);
  223.         if ($nfound < 0) {
  224.         warn "select failed: $!\n" unless $! == &EINTR;
  225.         redo;
  226.         } 
  227.         $took = (time - $then);
  228.         $ntimeout -= $took; 
  229.  
  230.         &readsock if vec($rout,fileno(SOCKET),1); 
  231.         &readtty if vec($rout,fileno(STDIN),1); 
  232.     }
  233.  
  234.     for $name (sort keys %sent) {
  235.     $missed{$name}++;
  236.     printf "%-12s missed %d times\n", $name, $missed{$name} if $debug;
  237.     if (! $down{$name}) {
  238.         next unless $missed{$name} > $retries;
  239.         next if $down{$name};
  240.         $down{$name} = time;
  241.         printf "%-12s %-16s down at %s", 
  242.         $name, &fmtaddr($hosts{$name}), &ctime($down{$name});
  243.     }
  244.     } 
  245.  
  246.     print "sleeping $sleep -- hit any key to interrupt\n" if $debug;
  247.     select($ttyout = $ttyin, $wout=$win, $eout = $ein, $sleep);
  248.     &readtty if vec($ttyout,fileno(STDIN),1); 
  249. }
  250.  
  251. sub sockaddr {
  252.     if (wantarray) {
  253.         unpack($sockaddr_t, $_[0]);
  254.     } else {
  255.         pack($sockaddr_t, $_[0], $_[1], $_[2]);
  256.     } 
  257. } 
  258.  
  259. sub inetaddr {
  260.     if (wantarray) {
  261.         unpack($inetaddr_t, $_[0]);
  262.     } else {
  263.         pack($inetaddr_t, $_[0], $_[1], $_[2]);
  264.     }
  265. } 
  266.  
  267. sub source {
  268.     local($file) = @_;
  269.     local($return) = 0;
  270.  
  271.     $return = do $file;
  272.     die "couldn't do \"$file\": $!" unless defined $return;
  273.     die "couldn't parse \"$file\": $@" if $@;
  274.     die "couldn't run \"$file\"" unless $return;
  275. }
  276.  
  277. sub usage {
  278.     print STDERR <<EOM;
  279. usage: $program [switches] host ...
  280.    or: $program [switches] -m [criterion ...]
  281.  
  282. switches are:
  283.     -m  look in MACHINES file for hosts matching criteria
  284.  
  285.     -t    timeout for responses (default $def_timeout)
  286.     -r    retries until timed-out host considered down (default $def_retries)
  287.     -c  clock drift tolerance (default $def_timewarp)
  288.     -s  sleep interval between send loops (default $def_sleep)
  289.  
  290.     -d  print out debugging information
  291.     -u  dump state to disk for faster init
  292. EOM
  293. } 
  294.  
  295. sub bad_usage {
  296.     &usage;
  297.     exit(1);
  298. } 
  299.  
  300. sub fmtaddr {
  301.     sprintf("[%d.%d.%d.%d]", &inetaddr(@_[0]));
  302. } 
  303.  
  304.  
  305. sub readsock {
  306.     ($hisaddr = recv(SOCKET,$histime='',4,0))
  307.     || (warn "couldn't recv: $!$OOPS", return);
  308.  
  309.     $sent--;
  310.  
  311.     ($addrtype, $port, $iaddr) = &sockaddr($hisaddr);
  312.  
  313.     $histime = unpack('L',$histime);
  314.     $histime -= $SINCE_1970;
  315.  
  316.     unless (($name,$aliases,$addrtype,$length,@addrs) =
  317.         gethostbyaddr($iaddr,$addrtype)) 
  318.     {
  319.     printf STDERR "received reply from unknown address %sn",
  320.                 &fmtaddr($iaddr);
  321.     next;
  322.     } 
  323.     $name =~ s/\.convex\.com$//;
  324.  
  325.     printf "%-12s %-16s thinks it's %s", 
  326.         $name, &fmtaddr($iaddr), &ctime($histime) if $debug;
  327.  
  328.     $delta = ($histime - time);
  329.     $delta = -$delta if $delta < 0;
  330.     $delta{$name} = $delta;
  331.  
  332.     delete $missed{$name};
  333.  
  334.     if ($down{$name}) {
  335.     printf "%-12s %-16s back at %s",
  336.         $name, &fmtaddr($iaddr), &ctime(time);
  337.     delete $down{$name};
  338.     } 
  339.  
  340.     printf "funny, i didn't send $name anything\n" unless $hosts{$name};
  341.     delete $sent{$name};
  342. }
  343.  
  344. sub readtty {
  345.     local($cmd) = getc;
  346.     local($routine) = '';
  347.  
  348.     $cmd = sprintf ("%c", ord($cmd) & 0x7f);
  349.  
  350.     if (defined $cmds{$cmd}) {
  351.     $routine = $cmds{$cmd};
  352.     print "\n",$dashes unless $routine eq 'quit';
  353.     &$routine;
  354.     print $dashes;
  355.     } else {
  356.     printf " -- unknown command: `%s' (0x%02x)\n", $cmd, ord($cmd);
  357.     } 
  358. } 
  359.  
  360. sub quit {
  361.     $SIG{'TTOU'} = "IGNORE";
  362.     &cooked;
  363.     exit 0;
  364. } 
  365.  
  366. sub help {
  367.     local($cmd);
  368.     print "Key\tCommand\n";
  369.     for $cmd (sort keys %cmds) {
  370.     printf "%s\t%s\n", $cmd, $cmds{$cmd};
  371.     } 
  372. } 
  373.  
  374. sub timers {
  375.     local($name);
  376.     print "Bad Clocks exceeding $timewarp seconds\n";
  377.     for $name (sort keys %delta) {
  378.     next unless $delta{$name} > $timewarp;
  379.     printf "%-12s %-16s has a clock that's %4d seconds off\n", 
  380.         $name, &fmtaddr($hosts{$name}), $delta{$name};
  381.     }
  382. }
  383.  
  384.  
  385. sub missing {
  386.     local($name);
  387.     print "Missing Hosts\n";
  388.     for $name (sort keys %missed) {
  389.     printf "%-12s %-16s has missed %d timeout%s of %d seconds\n",
  390.         $name, &fmtaddr($hosts{$name}), $missed{$name},
  391.         ($missed{$name} == 1) ? " " : "s", $timeout;
  392.     }
  393. } 
  394.  
  395. sub downers {
  396.     local($name);
  397.     print "Down Hosts\n";
  398.     for $name (sort keys %down) {
  399.     printf "%-12s %-16s down since %s", 
  400.         $name, &fmtaddr($hosts{$name}), &ctime($down{$name});
  401.     } 
  402. } 
  403.  
  404. sub uppers {
  405.     local ($name);
  406.  
  407.     print "Up Hosts\n";
  408.  
  409.     for $name (sort keys %hosts) {
  410.     next if $down{$name};
  411.     printf "%-12s up\n", $name;
  412.     } 
  413. } 
  414.  
  415. sub continue { 
  416.     print "continuing...\n";
  417.     &cbreak; 
  418. }
  419.  
  420. sub cbreak {
  421.     &set_cbreak(1);
  422. } 
  423.  
  424. sub cooked {
  425.     &set_cbreak(0);
  426. } 
  427.  
  428. sub set_cbreak {
  429.     local($on) = @_;
  430.  
  431.     ioctl(STDIN,&TIOCGETP,$sgttyb) 
  432.     || die "Can't ioctl TIOCGETP: $!";
  433.  
  434.     @ary = unpack($sgttyb_t,$sgttyb);
  435.     if ($on) {
  436.     $ary[4] |= &CBREAK;
  437.     $ary[4] &= ~&ECHO;
  438.     } else {
  439.     $ary[4] &= ~&CBREAK;
  440.     $ary[4] |= &ECHO;
  441.     }
  442.     $sgttyb = pack($sgttyb_t,@ary);
  443.     ioctl(STDIN,&TIOCSETP,$sgttyb)
  444.         || die "Can't ioctl TIOCSETP: $!";
  445.  
  446. }
  447.