使用 Perl 监控您的网站性能和正常运行时间。

引言

当您的网站宕机或速度变慢时，会收到通知。

它的功能

这个简单的 Perl 脚本设计为按计划运行。如果您使用 Windows，可以使用 Windows 任务计划程序；如果您使用 Linux，可以将其安排为 Cron 任务。该脚本将检查一个网站，实际上“获取”默认页面，然后记录这需要多长时间。如果页面宕机，或者响应时间超过您设置的值，您就可以收到电子邮件。

工作原理

该脚本包含 3 个文件

• URLS.txt - 此文件包含您希望检查的所有 URL（网站）。每个 URL 占用一行。这样可以轻松更新和更改您的列表，而无需深入 Perl 脚本。
• SMTP_Settings.txt - 此文件包含脚本应使用的 SMTP 设置，以及发送通知的对象。同样，这些设置位于脚本之外的文本文件中，以便更轻松地更改。
• responser.pl - 是执行检查网站和尝试获取默认文件的脚本。您需要在脚本本身中设置可接受的最小响应时间。请记住，如果运行脚本的连接速度较慢，您也可能会达到响应时间限制，从而触发电子邮件。

脚本创建的其他文件

该脚本还会创建一个错误文件，将任何报告的错误写入其中。这对于故障排除非常有用，可以随时删除此文件。

该脚本每次运行时还会创建一个每日日志文件。每日日志文件将追加，因此您每天都会记录发生的事情。

包含readme文件的完整脚本可以从这里免费下载。

日志文件的示例输出

******************************************************
+--------------------------------------------------------------------------------+
|                              Time: 23:26:31                                    |
|          HOST                                  STATUS       RESPONSE           |
+--------------------------------------------------------------------------------+
| http://www.yahoo.com/                          ACCESSED   Response 1 seconds   |
| http://www.hotmail.com/                        ACCESSED   Response 1 seconds   |
| http://www.ebay.com/                           ACCESSED   Response 1 seconds   |
| http://www.example.com/                        ACCESSED   Response 0 seconds   |
| http://www.not/ a real site.com                WRONG       N/A                 |
+--------------------------------------------------------------------------------+
|                              Time: 23:30:17                                    |
|          HOST                                  STATUS       RESPONSE           |
+--------------------------------------------------------------------------------+
| http://www.yahoo.com/                          ACCESSED   Response 0 seconds   |
| http://www.hotmail.com/                        ACCESSED   Response 0 seconds   |
| http://www.ebay.com/                           ACCESSED   Response 1 seconds   |
| http://www.example.com/                        ACCESSED   Response 0 seconds   |
| http://www.not/ a real site.com                WRONG       N/A                 |
+--------------------------------------------------------------------------------+
|                              Time: 23:31:26                                    |
|          HOST                                  STATUS       RESPONSE           |
+--------------------------------------------------------------------------------+
| http://www.yahoo.com/                          ACCESSED   Response 0 seconds   |
| http://www.hotmail.com/                        ACCESSED   Response 1 seconds   |
| http://www.ebay.com/                           ACCESSED   Response 0 seconds   |
| http://www.example.com/                        ACCESSED   Response 0 seconds   |
| http://www.not/ a real site.com                WRONG       N/A                 |

#!/usr/bin/perl
use warnings;
use strict;
use Tie::File;
use Net::SMTP;
use LWP::UserAgent;

#################################################################
#             Program  Settings
#
my $error_log  = 'Responser_errors.txt';# File to store errors of program
my $input_file = 'urls.txt';       # From where program will read WEB Addresses
my $smtp_file  = 'SMTP_Settings.txt';   # File for SMTP Settings
my $response_limit = 12; #In Seconds    # Positively diggit -> SendMail;
                                        #        0 -> will not send mail
my $send_mail  = 1;                # my $send_mail  = 1; ->SMTP option is ON,
                                   # my $send_mail  = 0; ->SMTP option is OFF
##################################################################
#                      END OF SETTINGS
# Do not edit bellow if you dont understand it.
##################################################################
die "File $input_file is not exist\n" unless (-e $input_file);
die "SMTP is ON, but file $smtp_file is not exist\n" unless (-e $smtp_file);
my $localtime     = localtime;
our @errors;
my ($day,$month,$date,$hour,$year) = split /\s+/,scalar localtime;
my $output_file = 'report-'.$date.'.'.$month.'.'.$year.'.txt';
my ($smtp_host,$recipient,$reverse_path, @all_addr) = ();
tie @all_addr, 'Tie::File', 
    $input_file or error("Cant open $input_file to read addresses");
if (-e $output_file) {
   open(OUT,">> $output_file") 
      or error("Cant open exist file $output_file for append");
} else {
   open(OUT,"> $output_file") 
      or error("Cant open new file $output_file for writting");
}
my @smtp_settings;
if ($^O =~ /win/i) {
        tie @smtp_settings, 'Tie::File', $smtp_file,, 
            recsep => "\012" 
            or error("Cant open $smtp_file to read SMTP settings");
} else {
tie @smtp_settings, 'Tie::File', $smtp_file,autochomp => '0' 
    or error("Cant open $smtp_file to read SMTP settings");
}
for (@smtp_settings) {
   chomp;
   next if /^#/;
   #next if /^$/;
 if (/^(\w+)\s=\s'(\S+)'/) {
   $smtp_host     = $2 if ($1 eq 'SMTPHost');
   $recipient     = $2 if ($1 eq 'Recipient');
   $reverse_path  = $2 if ($1 eq 'Reverse');
 }
}
print OUT "\n+" .('-' x 84) . "+\n";
print OUT   "|", ' ' x 30,"Time: $hour",' ' x 40,"|\n";
print OUT   "|",' 'x 10,'HOST',' ' x 37,'STATUS',' ' x 7, 
                               "RESPONSE            |\n";
print OUT   "+" .('-' x 84) . "+\n";
for (0 .. $#all_addr) {
 chop $all_addr[$_] if ($all_addr[$_] =~ /\s+$/);
 next if ($all_addr[$_]  eq "");
 if ($all_addr[$_] =~ /^http:\/\/\S+\.\w{2,4}$/) {  
      #address will beginnig with http://,next some string
      # finish with point and 2 to 4 letters
   check_url($all_addr[$_]);    #call subroutine check_url()
 } else {
   my $out_format = sprintf "| %-50.50s %-10s  %-20s|\n", 
                           $all_addr[$_], "WRONG", "N/A";
   printf OUT $out_format;
   printf $out_format;
         push @errors, "$all_addr[$_] is WRONG Address.";
 }
}

my $err = join "\015\012",@errors;
my $err_num = scalar @errors;  # How match DOWN + WRONG Sites have
$send_mail = 0 unless $err_num;
untie @all_addr or error("Unable to close file $input_file");
if ($send_mail) {
 my $smtp = Net::SMTP->new($smtp_host,
                    -Debug=>1,
                    -Timeout=>20,
                    -Hello=>"$smtp_host") 
                        or error("Cant connect to $smtp_host");
# Begin Compare mail message
my $msg = <<__END_OF_MAIL__;
To: $recipient
Subject: $err_num Error Sites | $localtime .
$localtime
$err

__END_OF_MAIL__
# End Compare

 $smtp->mail("$reverse_path") 
       or error("Failed to specify a reverse-path");#  If all is OK
 $smtp->to($recipient) 
       or error("Failed to specify a recipient");   #  that will
 $smtp->data([$msg]) 
       or error("Failed to send a message");     #  send mail
 $smtp->quit or error("Failed to quit");         #  to You
} else {
  print "Send Mail is OFF\n" if $err_num; # If you do not wish to receive mail
}

close OUT or error("Unable to close file $output_file");
print "\nProcess FINISH\n";

sub check_url {  # subroutine who check given URL
    my $target = $_[0];
        my $ua = LWP::UserAgent->new;
        $ua->agent("$0/0.1 " . $ua->agent);
        my $req = HTTP::Request->new(GET => "$target");
        $req->header('Accept' => 'text/html');          #Accept HTML Page
        # send request
        my $start = time;      # Start timer
        my $res = $ua->request($req);
        # check the outcome
        if ($res->is_success) {
        # Success....all content of page has been received
          my $time = time;     # End timer
          my $out_format;
          $time = ($time - $start); # Result of timer
          if ($response_limit && ($response_limit <= $time)) {
             push(@errors, "Slow response from $target\: $time seconds");
             $out_format = sprintf "| %-50.50s %-10s %-20s |\n", 
                      $target, "SLOW", "Response $time seconds";
          } else {
             $out_format = sprintf "| %-50.50s %-10s %-20s |\n", 
                  $target, "ACCESSED", "Response $time seconds";
          }
          print OUT $out_format; # write to file
          print $out_format;     # print to console
        } else { # Error .... Site is DOWN and script send e-mail to you..
          my $out_format = sprintf "| %-50.50s %-10s %-20s |\n", 
                                          $target, "DOWN", " N/A";
          push(@errors, "$target is DOWN." . $res->status_line) 
                           or error("Cannot push error for DOWN");
          print OUT $out_format; # write to file
          print $out_format;     # print to console
    }
}
sub error {      # subroutine who print in Error Log
  my $error_msg = shift;
  open ERR,">> $error_log" 
       or die "Cannot open log file $error_log : $!\n";
  print ERR "$localtime\: $error_msg : $!\n";
  close ERR or die "Cannot close log file $error_log : $!\n";
}

许可证

本文未附加明确的许可证，但可能在文章文本或下载文件本身中包含使用条款。如有疑问，请通过下面的讨论区联系作者。

作者可能使用的许可证列表可以在此处找到。