背景は昨日のエントリから

管理とか運用しているWebSiteが落ちていたりすると、良くないので、自動で生存確認するモジュールを作った。このDeadOrAlive.pmを使うスクリプトをcronで回して結果をメールするように書いておけば、もしサーバが落ちてたときにも早く対処ができるようになる。

WebSiteの生存確認モジュール(DeadOrAlive.pm)を作った – 週記くらい

id:perlcodesampleさん、id:tokuhiromさんにアドバイスや添削して頂いて、WebSiteの生存確認モジュール(DeadOrAlive.pm)を修正しました。

あと、POSTの確認機能も追加しました。POSTの確認は、パラメータを送って、正しいURLにリダイレクトしているかを確認する程度の機能。POSTの機能は確認不足かもしれない。

POSTのテストとリダイレクトのテストの例としてtinyurl.comのテストを書いています。

http_test.pl

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use FindBin;
use lib "$FindBin::Bin/lib"; #libの下にDeadOrAlive.pmを配置した場合
use DeadOrAlive;
use Data::Dumper;
#チェック対象のサイト定義
my $sites = [
{
name => 'www.example.com',
tests => [
{
url => 'http://www.example.com/',
test => '<TITLE>Example Web Page</TITLE>'
},
]
},
{
name => 'tinyurl.com',
tests => [
{
url => 'http://tinyurl.com/',
test => 'Welcome to TinyURL!'
},
{ #POSTのテスト
url => 'http://tinyurl.com/create.php',
post_param => 'url=http%3A%2F%2Fwww.google.co.jp%2F',
test => 'TinyURL was created!'
},
{ #リダイレクトのテスト
url => 'http://tinyurl.com/1awl',
code => 301,
location => 'http://www.google.co.jp/'
}
]
},
];
#期待するテスト結果を__DATA__の下から取得
my $result_expected = do {local $/;<DATA>};
#WebSiteの生存確認を行なう。
DeadOrAlive::check_sites($sites, $result_expected);
# vim: set sw=2 st=2 ts=2 expandtab:
__DATA__
ok 1 - http://www.example.com/ status code.
ok 2 - http://www.example.com/
ok 3 - http://tinyurl.com/ status code.
ok 4 - http://tinyurl.com/
ok 5 - http://tinyurl.com/create.php status code.
ok 6 - http://tinyurl.com/create.php
ok 7 - http://tinyurl.com/1awl status code.
ok 8 - http://tinyurl.com/1awl location header.

DeadOrAlive.pm

use strict;
use warnings;
use utf8;
package DeadOrAlive;
=head1 WebSiteの生存確認モジュール
=cut
use Encode;
use Data::Dumper;
use Exporter;
use base qw(Exporter);
our @EXPORT_OK = qw(check_sites);
our @EXPORT_FAIL = qw(get_http_response);
use File::Temp;
use Test::More qw(no_plan);
BEGIN {
# see http://d.hatena.ne.jp/tokuhirom/20090409/1239275277
binmode(Test::More->builder->$_, ':utf8') for qw{failure_output output todo_output};
}
use LWP;
my $ua = LWP::UserAgent->new(timeout => 2, requests_redirectable => 0);
$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)');
sub check_sites {
my ($sites, $result_expected) = @_;
#cookieを使う
$ua->cookie_jar({autosave => 1});
#出力結果をバッファする一時ファイル
my $file_temp = File::Temp->new(UNLINK => 1);
Test::More->builder->$_($file_temp) for qw{failure_output output todo_output};
foreach my $site (@$sites) {
foreach my $test (@{$site->{tests}}) {
my $url = $test->{url};
my $res = get_http_response($test, $site->{charset});
#status code test.
my $code = $test->{code} || 200;
is($res->{code}, $code, $url . ' status code.');
#location header test.
my $location = $test->{location};
if ($location) {
ok($res->{headers}->{location} eq $location, $url . ' location header.');
}
#html test.
my $test_string = $test->{test};
if ($test_string) {
ok($res->{html} =~ m{$test_string}, $url);
}
}
}
$ua->cookie_jar->clear;
#出力したテスト結果を取得する。
my $out = do {local $/; seek $file_temp, 0, 0; <$file_temp>;};
print 'HTTP test for servers.';
if ($out =~ m{^not ok}m) { # 10/7 複数行のマッチを行なうmオプションを追加した。
print ' [TEST ERROR]';
}
if (defined $result_expected and $out ne $result_expected) {
print ' [RESULT ERROR]';
}
print "\n\n";
print $out;
}
sub get_http_response {
my $test = shift;
my $host;
my $url = $test->{url};
if ($url =~ m{https?://([^/]*)/}) {
$host = $1;
}
my $post_param = $test->{post_param};
my $req = $post_param
? HTTP::Request->new(POST => $url)
: HTTP::Request->new(GET => $url);
$req->header('Host' => $host);
if ($post_param) {
$req->content_type('application/x-www-form-urlencoded');
$req->content($post_param);
}
my $res = $ua->request($req);
my $content = $res->decoded_content();
#print Dumper($res->headers);
return {
headers => $res->headers,
code => $res->code,
html => $content
};
}
1;
# vim: set sw=2 st=2 ts=2 expandtab:

実行結果

$ ./http_test.pl
HTTP test for servers.
ok 1 - http://www.example.com/ status code.
ok 2 - http://www.example.com/
ok 3 - http://tinyurl.com/ status code.
ok 4 - http://tinyurl.com/
ok 5 - http://tinyurl.com/create.php status code.
ok 6 - http://tinyurl.com/create.php
ok 7 - http://tinyurl.com/1awl status code.
ok 8 - http://tinyurl.com/1awl location header.