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

# サーバー稼動監視チェックPerlスクリプトその１(Socketモジュール使用例)
# SOCKETsvrchk1.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
#■□■ URLの設定終わり ■□■


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

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

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

sub svrchk {
	my ($url) = @_;
	$url =~ /(http:)?(\/\/)?([^:\/]*)?(:([0-9]+))?(\/.*)?/;	# 引数0:URI、引数1:HTTPプロトコルのバージョン
	my $host = $3; if ($host eq "") {$host = 'localhost';}
	my $port = $5; if ($port eq "") {$port = 80;}		# HTTPプロトコルgetservbyname('http','tcp')は80。

	my $ip_addr = inet_aton($host) || die "$hostは存在しないホストです。\n";# ホスト名をIPアドレスの構造体に変換
	my $socket_addr = pack_sockaddr_in($port, $ip_addr);	# ポート番号とIP アドレスを構造体に変換
	my $protocol = getprotobyname('tcp');			# プロトコル番号
	socket(SOCKET_HANDLE, PF_INET, SOCK_STREAM, $protocol) || die "ソケットを生成できません。\n";# ソケット生成
	connect(SOCKET_HANDLE, $socket_addr) || die "$hostのポート$portに接続できません。\n";# 指定のホストの指定のポートに接続

	select(SOCKET_HANDLE); $|=1; select(STDOUT);		# ファイルハンドルSOCKET_HANDLEをバッファリングしない
#	autoflush SOCKET_HANDLE (1);				# 同上。使用時は、use IO::Socket;かuse FileHandle;を宣言。
	print SOCKET_HANDLE "OPTIONS * HTTP/1.0\r\n";		# WWWサーバにOPTIONSメソッドを送る
	print SOCKET_HANDLE "\r\n";

#	while (<SOCKET_HANDLE>){ m/^\r\n$/ and last; }		# ヘッダ部分を除去する(改行のみの行ならループを抜ける)
#	print <SOCKET_HANDLE>;					# HTTP応答を（ヘッダも含めて）受信して表示
	if(<SOCKET_HANDLE> =~ /^HTTP\//){
		print "正常な応答です。";
	} else {
		print "応答は、ありましたが内容が不正です。";
	}
	close (SOCKET_HANDLE);					# 切断
}