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

管理とか運用している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/perluse strict;use warnings;use utf8;useFindBin;use lib "$FindBin::Bin/lib"; #libの下にDeadOrAlive.pmを配置した場合useDeadOrAlive;useData::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.phpok 7 - http://tinyurl.com/1awl status code.ok 8 - http://tinyurl.com/1awl location header.

DeadOrAlive.pm

use strict;use warnings;use utf8;packageDeadOrAlive;=head1WebSiteの生存確認モジュール=cutuseEncode;useData::Dumper;useExporter;use base qw(Exporter);our @EXPORT_OK = qw(check_sites);our @EXPORT_FAIL = qw(get_http_response);useFile::Temp;useTest::More qw(no_plan);BEGIN {# see http://d.hatena.ne.jp/tokuhirom/20090409/1239275277binmode(Test::More->builder->$_, ':utf8') for qw{failure_output output todo_output};
}useLWP;my $ua = LWP::UserAgent->new(timeout=> 2, requests_redirectable=> 0);$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)');subcheck_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;
}subget_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.