#!/usr/local/bin/perl
#!D:/Perl/bin/perl.exe

# サーバー稼動監視チェックPerlスクリプトその２(IO::Socketモジュール使用例)
# SOCKETsvrchk2.pl 2002.08.17 作成：鷹の巣　http://sakaguch.com/
# 参考URL
# http://doppo.no-ip.com/j-serv/s_check/s_check.htm
# http://www.dream-seed.com/linux/svrck.html
# 説明が豊富なURL:http://x68000.q-e-d.net/~68user/net/http-2.html
# 説明が豊富なURL:http://ash.or.jp/perl/socket_http.htm

#■□■ URLの設定 ■□■
$url = 'http://example.com/';					# アクセスするURL
$timeout = 60;							# 接続待ち許容時間（秒） 
#■□■ URLの設定終わり ■□■


use IO::Socket;							# IO::Socketモジュールを使用

&main();							# perlで、URLを閲覧
exit;

sub main {
	$message = &svrchk($url,$timeout);			# $urlに設定したURLのWebページを標準出力(HTTPクライアント)
	print "$message\n";
}

sub svrchk {
	my ($url ,$timeout) = @_;				# 引数0:URI、引数1:接続待ち許容時間（秒）
	$url =~ /(http:)?(\/\/)?([^:\/]*)?(:([0-9]+))?(\/.*)?/;
	my $host = $3; if ($host eq "") {$host = 'localhost';}
	my $port = $5; if ($port eq "") {$port = 80;}		# HTTPプロトコルgetservbyname('http','tcp')は80。
	my $mes = "";						# 戻り値の初期化

	my $SOCKET = IO::Socket::INET	->	new(PeerAddr	=>	$host,	# HTTPプロトコルでWWWサーバーへ接続する
						PeerPort	=>	$port,	# サービスポート番号
						Proto		=>	"tcp",	# プロトコル
						Timeout		=>	$timeout,# 接続待ち許容時間（秒） 
						);
	if ($SOCKET) {
		print $SOCKET "OPTIONS * HTTP/1.0\r\n";		# WWWサーバにOPTIONSメソッドを送る
		print $SOCKET "\r\n";
		$SOCKET	-> flush();				# バッファに溜まっているデータも送る
#		while (<$SOCKET>){ m/^\r\n$/ and last; }	# ヘッダ部分を除去する(改行のみの行ならループを抜ける)
#		print <$SOCKET>;				# HTTP応答を（ヘッダも含めて）受信して表示
		if(<$SOCKET> =~ /^HTTP\//){
			$mes = "正常な応答です。";
		} else {
			$mes = "応答は、ありましたが内容が不正です。";
		}
		$SOCKET -> close();				# WWWサーバーから切断する
	} else {
		$mes = "$hostのポート$portに接続できません。";
	}
	return ($mes);						# 戻り値を格納。
}