"Webmaster's Domain: A Perl Script for Monitoring Apache Server Status"
by Lincoln D. Stein
Web Techniques, January 1999

Web Techniques grants permission to use these listings (and code) for 
private or commercial use provided that credit to Web Techniques and 
the author is maintained within the comments of the source. For 
questions, contact editors@web-techniques.com. 


NOTE: Remove line numbers!


[LISTING ONE]


0  #!/usr/local/bin/perl
1  # file: check_servers
2  # author: Lincoln Stein
3  
4  use strict;
5  use IO::File;
6  use LWP::Simple;
7  use Net::SMTP;
8  use POSIX 'strftime';
9  use Getopt::Long;
10  
11  use constant DEFAULT_LOG    => '/var/log/www/stats';
12  use constant DEFAULT_URL    => '/status?auto';
13  
14  my ($SRVR_LIST,$ALERT,$LOG,$URL,%STATUS);
15  my $TIME = strftime("%d-%b-%Y %H:%M",localtime);
16  
17  GetOptions (
18              'servers=s' => \$SRVR_LIST,
19              'alert=s'   => \$ALERT,
20              'log=s'     => \$LOG,
21              'url=s'     => \$URL,
22              ) || die <<USAGE;
23  Usage: $0 [options] [servers...]
24    Check the status of a list of Web servers.
25  Options:
26    -servers <path>     File containing list of servers
27    -alert   <address>  E-mail address for server down warnings
28    -log     <path>     Directory to log status reports to
29    -url     <url>      URL to fetch to check status
30  USAGE
31      ;
32  
33  # set up defaults
34  $LOG   ||=  DEFAULT_LOG;
35  $ALERT ||=  $ENV{USER};
36  $URL   ||=  DEFAULT_URL;
37  
38  # get list of servers to fetch
39  my @SERVERS = @ARGV;
40  
41  # if -servers was specified, read server names from a file
42  if ($SRVR_LIST) {
43      my $fh = IO::File->new($SRVR_LIST) || die "Can't open $SRVR_LIST: $!";
44      chomp(my @servers = <$fh>);
45      push(@SERVERS,@servers);
46  }
47  
48  foreach my $server (@SERVERS) {
49      my $content = get("http://$server$URL");
50      %STATUS = $content =~ /^(.+): ([\d.Ee-]+)$/mg;
51      write_log($server);
52      send_alert($server) unless exists $STATUS{'Total Accesses'};
53  }
54  
55  sub write_log {
56      my ($server) = @_;
57      my $logfile =  "$LOG/$server";
58      my $exists = -e $logfile;
59      my $fh = IO::File->new(">>$logfile");
60      die "can't open $logfile for appending: $!" unless $fh;
61      unless (exists $STATUS{'Total Accesses'}) {
62          print $fh $TIME,"\t** SERVER UNREACHABLE **\n";
63          return;
64      }
65      # these lines control the format production.
66      select $fh;               # select the log file
67      $^ = 'LOG_TOP';           # set the top of form text
68      $~ = 'LOG';               # set the format for the body
69      $- = 100 if $exists;      # inhibit header except for first time called
70      write;
71      $fh->close;
72  }
73  
74  sub send_alert {
75      my $server = shift; 
76      chomp(my $hostname = `hostname -d`);
77      my $smtp = Net::SMTP->new('localhost',Hello=>$hostname);
78      $smtp->mail($ENV{USER});
79      $smtp->to($ALERT);
80      $smtp->data();
81      $smtp->datasend(<<END);
82  From: "check servers program" <$ENV{USER}\@$hostname>
83  To: $ALERT
84  Subject: $server is unreachable
85  
86  At $TIME the check_servers program tried to contact the
87  Web server named "$server", but there was no response.
88  
89  Yours truly,
90  The check_servers program
91  END
92      $smtp->dataend;
93      $smtp->quit;
94  }
95  
96  format LOG_TOP=
97      Date  Requests  kB  Load  Uptime  R/sec  B/sec  B/req  Busy  Idle
98  .
99  format LOG=
100  @<<<<<<<<<<<<<<<< @###### @####### @#.## @####### @#.## @###.# @#### @## @###
101  { $TIME,@STATUS{'Total Accesses','Total kBytes',
102                  'CPULoad','Uptime','ReqPerSec',
103                  'BytesPerSec','BytesPerReq',
104                  'BusyServers','IdleServers'}
105  }
106  .