Table of Contents

概要

ネットワーク上のサーバの ping による死活監視および WakeOnLan によるリモート起動を行う。
監視するのはスクリプトを呼び出した時１回だけで履歴は取らない。
再度監視したい場合はタイトルがリンクになっているので、そこをクリックする。
Windows/IIS 版を追加。(2012/03/28)
CPAN:Doxygen-Filter-Perl 用タグの書き方が間違っていたのを訂正。(2012/03/28)
Linux/Apache 版で
が閉じていなかったのを修正。(2012/03/28)
関数内で print するのを止め、HTML文字列を返すように変更。(2012/03/29)
NIC が２枚以上ある場合に対応。「/」で連結して書く。(2012/05/30)
Name の先頭に「#」が付いている行はコメントとして無視される。(2012/06/04)

ソース

NetWatcher.zip

index.cgi (Linux/Apache)

#!/usr/bin/perl
##	@mainpage	NetWatcher
# サーバの監視およびリモート起動

use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
use CGI::Pretty qw( -no_xhtml *table );	# //HTML 4.01 Transitional//EN
use Text::xSV::Slurp qw( xsv_slurp );
use Net::Ping::External qw( ping );
use Net::Wake;
use Parallel::ForkManager;
use IPC::Shareable;

$YAML::Syck::ImplicitUnicode = 1;

#my $charsetConsole	= 'CP932';
my $charsetConsole	= 'UTF-8';
my $charsetFile		= 'UTF-8';

binmode( STDIN,  ":encoding($charsetConsole)" );
binmode( STDOUT, ":encoding($charsetConsole)" );
binmode( STDERR, ":encoding($charsetConsole)" );

my $cginame		= 'NetWatcher';			##< CGI名
my $cookiename	= 'NWCookie';			##< 現在は使用していない
my $configfile	= './conf/config.txt';	##< 設定ファイル
my $csvoption	= { sep_char => "\t" };	##< 設定ファイルを読み込むためのオプション
my $maxchildren	= 10;					##< 子プロセスの最大数
my $markignore	= '#';					##< 行頭がこの文字列で始まっている行は無視する。

my @Targets = readXSV( $configfile, $csvoption );
my %Targets = map{ $_->{'Name'} => $_; } @Targets;

#print Dump( \%Targets ) . "\n";
#exit;

my %results = pingTargets( \@Targets );

my $q = new CGI;
$q->charset( $charsetFile );
my $scripturl = $q->url(  );

my @paramnames = $q->param();

printHeader();

if ( @paramnames ){
	action();
}
printForm();

printFooter();

exit;

##	@function readXSV( $fname, %$opt )
#	CSV(TSV)ファイルを読み込んでヘッダ行をキーとしたハッシュの配列を返す。
#	@param	fname	[in] ファイル名
#	@param	opt		[in] Text::CSV_XS に渡されるオプション
#	@return	CSVを配列化したもの
sub readXSV
{
	my( $fname, $opt ) = @_;
	$opt = { binary => 1, %{$opt} };
	open( my $fhin, "<:encoding($charsetFile)", encode( $charsetConsole, $fname ) )
		or die( "$fname: $!" );
	my @body = <$fhin>;
	close( $fhin );
	my $ret = xsv_slurp( 
		string => join( "", @body ), 
		text_csv => $opt, 
	);
	return ( ref( $ret ) eq 'ARRAY' ) 
		? @{ $ret } 
		: $ret ;
}

##	@function pingTargets( @$targets_ref )
#	ターゲット情報に従い、各ターゲット宛に ping を打ち、結果をハッシュにして返す。
#	@param	targets_ref	[in] ターゲット情報の配列のリファレンス
#	@return	ping 結果のハッシュ
sub pingTargets
{
	my( $targets_ref ) = @_;

	my $handle = tie my %results, 'IPC::Shareable', undef, { destroy => 1 };
	%results = ();

	my $pm = Parallel::ForkManager->new( $maxchildren );

#	$pm->run_on_start(
#		sub {
#			my( $pid, $ident ) = @_;
#			print "** $ident started, pid: $pid\n";
#		}
#	);

	foreach my $target ( @{$targets_ref} ){
		my $name	= $target->{ 'Name' } || '';
		if ( substr( $name, 0, length($markignore) ) eq $markignore ){
			next;
		}
		my $ip		= $target->{ 'IP' } || '';
		$pm->start( $name ) and next;
		my $status	= ping( host => $ip, timeout => 1 );
		$handle->shlock;
		$results{ $name } = $status;
		$handle->shunlock;
		$pm->finish( $name );
	}
	$pm->wait_all_children;

	my %ret = %results;
	$handle->remove();

	return %ret;
}

##	@function printHeader()
#	HTTP ヘッダおよび HTML ヘッダを出力する。
sub printHeader
{
	my $cookieval = decode( 'utf8', 
		$q->cookie( encode( 'utf8', $cookiename ) ) || '' 
	);
#	$cookieval .= 'あ';
	my $cookie = $q->cookie( 
		'-name'		=> encode( 'utf8', $cookiename ), 
		'-value'	=> encode( 'utf8', $cookieval ),
	);
	print $q->header( '-cookie' => [ $cookie ] );
	print $q->start_html( 
		'-title'	=> $cginame, 
		'-lang'		=> 'ja-JP', 
		'-head'		=> [ 
			$q->meta( { '-http_equiv'	=> 'Content-style-type',	'-content'	=> 'text/css' } ),
			$q->meta( { '-http_equiv'	=> 'Content-script-type',	'-content'	=> 'text/javascript' } ), 
		], 
		'-style'	=> [ { 'src' => 'NetWatcher.css' }, ], 
	);
	print $q->h1( $q->a( { -href => $scripturl }, $cginame ) );
}

##	@function printFooter()
#	HTML フッタを出力する。
sub printFooter
{
	print $q->end_html . "\n";
}

##	@function action()
#	フォームから送信されたコマンドを処理する。
sub action
{
	print $q->h2( 'Command' );
	print $q->start_table( { '-summary' => 'Servers', '-border' => 1 } );
	foreach my $key ( @paramnames ){
		print $q->Tr( 
			{ -class => 'even' }, 
			$q->th( { -class => 'title' }, $key ), $q->td( $q->param( $key ) ) 
		);
	}
	print $q->end_table();
	my $target = $q->param( 'Wake' ) || '';
	if ( $target && $Targets{$target} ){
		foreach my $mac ( split( /\//, $Targets{$target}{'MAC'} ) ){
			Net::Wake::by_udp( undef, $mac );
		}
	}
}

##	@function printForm()
#	フォームを出力する。
sub printForm
{
	print $q->h2( 'ステータス' );
	print $q->start_form( 
		'-action' => $scripturl, 
		'-enctype' => ( 'multipart/form-data' ), 
	);
	print $q->start_table( { '-summary' => 'Statuses', '-border' => 1 } );
	print $q->Tr( $q->th( { -class => 'title' }, [ 'Name', 'Type', 'IP', 'Status', 'Wake', '備考' ] ) );
	for( my $i=0; $i<@Targets; ++$i ){
		my $name	= $Targets[ $i ]{'Name'} || '';
		if ( substr( $name, 0, length($markignore) ) eq $markignore ){
			next;
		}
		my $type	= $Targets[ $i ]{'Type'} || '';
		my $ip		= $Targets[ $i ]{'IP'} || '';
		my $status	= ( $results{ $name } ) 
			? $q->td( { -class => 'state_up' }, 'Up' ) 
			: $q->td( { -class => 'state_down' }, 'Down' );
		my $comment	= $Targets[ $i ]{'Comment'} || '';
		print $q->Tr( 
			{ -class => ( $i % 2 ) ? 'odd' : 'even' }, 
			$q->th( $name ), 
			$q->td( [ $type, $ip ] ), 
			$status, 
			$q->td( [ $q->submit( -name=>'Wake', -value=>$name ), $comment, ] ), 
		);
	}
	print $q->end_table();
	$q->end_form;
}

# EOF

index_IIS.cgi (Windows/IIS)

#!/usr/bin/perl
# NetWatcher (IIS用)
# サーバの監視およびリモート起動

use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
use CGI::Pretty qw( -no_xhtml *table );	# //HTML 4.01 Transitional//EN
use Text::xSV::Slurp qw( xsv_slurp );
use Net::Ping::External qw( ping );
use Net::Wake;
use threads;
use threads::shared;

$YAML::Syck::ImplicitUnicode = 1;

#my $charsetConsole	= 'CP932';
my $charsetConsole	= 'UTF-8';
my $charsetFile		= 'UTF-8';

# Encode モジュールは Thread Safe ではない。
# http://search.cpan.org/dist/Encode/encoding.pm
#binmode( STDIN,  ":encoding($charsetConsole)" );
#binmode( STDOUT, ":encoding($charsetConsole)" );
#binmode( STDERR, ":encoding($charsetConsole)" );

my $encoder = find_encoding( $charsetConsole );

my $cginame		= 'NetWatcher';
my $cookiename	= 'NWCookie';			##< 現在は使用していない
my $configfile	= './conf/config.txt';
my $csvoption	= { sep_char => "\t" };
my $markignore	= '#';					##< 行頭がこの文字列で始まっている行は無視する。

my @Targets = readXSV( $configfile, $csvoption );
my %Targets = map{ $_->{'Name'} => $_; } @Targets;

#print $encoder->encode( Dump( \%Targets ) . "\n" );
#exit;

my %results = pingTargets( \@Targets );

my $q = new CGI;
$q->charset( $charsetConsole );
my $scripturl = $q->url( -path_info=>1 );

my @paramnames = $q->param();

printHeader();

if ( @paramnames ){
	action();
}
printForm();

printFooter();

exit;

##	@function readXSV( $fname, %$opt )
#	CSV(TSV)ファイルを読み込んでヘッダ行をキーとしたハッシュの配列を返す。
#	@param	fname	[in] ファイル名
#	@param	opt		[in] Text::CSV_XS に渡されるオプション
#	@return	CSVを配列化したもの
sub readXSV
{
	my( $fname, $opt ) = @_;
	$opt = { binary => 1, %{$opt} };
	open( my $fhin, "<:encoding($charsetFile)", encode( $charsetConsole, $fname ) )
		or die( "$fname: $!" );
	my @body = <$fhin>;
	close( $fhin );
	my $ret = xsv_slurp( 
		string => join( "", @body ), 
		text_csv => $opt, 
	);
	return ( ref( $ret ) eq 'ARRAY' ) 
		? @{ $ret } 
		: $ret ;
}

##	@function pingTargets( @%targetsref )
#	ターゲット情報に従い、各ターゲット宛に ping を打ち、結果をハッシュにして返す。
#	@param	targets	[in] ターゲット情報の配列
#	@return	ping 結果のハッシュ
sub pingTargets
{
	my( $targets_ref ) = @_;

	my %results;
	my %threads;
	foreach my $target ( @{$targets_ref} ) {
		my $name	= $target->{ 'Name' } || '';
		if ( substr( $name, 0, length($markignore) ) eq $markignore ){
			next;
		}
		my $ip		= $target->{ 'IP' } || '';
		$threads{ $name } = threads->new( 
			sub {
				my( $ip ) = @_;
				return ping( host => $ip, timeout => 1 );
			}, 
			$ip 
		);
	}
	foreach my $t ( keys( %threads ) ){
		$results{ $t } = $threads{ $t }->join();
	}

	return %results;
}

##	@function printHeader()
#	HTTP ヘッダおよび HTML ヘッダを出力する。
sub printHeader
{
	if ( defined( $ENV{PERLXS} ) && $ENV{PERLXS} eq 'PerlIS' ){
		print $encoder->encode( "HTTP/1.0 200 OK\n" );
	}

	my $cookieval = decode( 'utf8', 
		$q->cookie( encode( 'utf8', $cookiename ) ) || '' 
	);
#	$cookieval .= 'あ';
	my $cookie = $q->cookie( 
		'-name'		=> encode( 'utf8', $cookiename ), 
		'-value'	=> encode( 'utf8', $cookieval ),
	);
	print $encoder->encode( $q->header( '-cookie' => [ $cookie ] ) );
	print $encoder->encode( $q->start_html( 
		'-title'	=> $cginame, 
		'-lang'		=> 'ja-JP', 
		'-head'		=> [ 
			$q->meta( { '-http_equiv'	=> 'Content-style-type',	'-content'	=> 'text/css' } ),
			$q->meta( { '-http_equiv'	=> 'Content-script-type',	'-content'	=> 'text/javascript' } ), 
		], 
		'-style'	=> [ { 'src' => 'NetWatcher.css' }, ], 
	) );
	print $encoder->encode( $q->h1( $q->a( { -href => $scripturl }, $cginame ) ) );
}

##	@function printFooter()
#	HTML フッタを出力する。
sub printFooter
{
	print $encoder->encode( $q->end_html . "\n" );
}

##	@function action()
#	フォームから送信されたコマンドを処理する。
sub action
{
	print $encoder->encode( $q->h2( 'Command' ) );
	print $encoder->encode( $q->start_table( { '-summary' => 'Servers', '-border' => 1 } ) );
	foreach my $key ( @paramnames ){
		print $encoder->encode( $q->Tr( 
			{ -class => 'even' }, 
			$q->th( { -class => 'title' }, $key ), $q->td( $q->param( $key ) ) 
		) );
	}
	print $encoder->encode( $q->end_table() );
	my $target = $q->param( 'Wake' ) || '';
	if ( $target && $Targets{$target} ){
		foreach my $mac ( split( /\//, $Targets{$target}{'MAC'} ) ){
			Net::Wake::by_udp( undef, $mac );
		}
	}
}

##	@function printForm()
#	フォームを出力する。
sub printForm
{
	print $encoder->encode( $q->h2( 'ステータス' ) );
	print $encoder->encode( $q->start_form( 
		'-action' => $scripturl, 
		'-enctype' => ( 'multipart/form-data' ), 
	) );
	print $encoder->encode( $q->start_table( { '-summary' => 'Statuses', '-border' => 1 } ) );
	print $encoder->encode( $q->Tr( $q->th( { -class => 'title' }, [ 'Name', 'Type', 'IP', 'Status', 'Wake', '備考' ] ) ) );
	for( my $i=0; $i<@Targets; ++$i ){
		my $name	= $Targets[ $i ]{'Name'} || '';
		if ( substr( $name, 0, length($markignore) ) eq $markignore ){
			next;
		}
		my $type	= $Targets[ $i ]{'Type'} || '';
		my $ip		= $Targets[ $i ]{'IP'} || '';
		my $status	= ( $results{ $name } ) 
			? $q->td( { -class => 'state_up' }, 'Up' ) 
			: $q->td( { -class => 'state_down' }, 'Down' );
		my $comment	= $Targets[ $i ]{'Comment'} || '';
		print $encoder->encode( $q->Tr( 
			{ -class => ( $i % 2 ) ? 'odd' : 'even' }, 
			$q->th( $name ), 
			$q->td( [ $type, $ip ] ), 
			$status, 
			$q->td( [ $q->submit( -name=>'Wake', -value=>$name ), $comment, ] ), 
		) );
	}
	print $encoder->encode( $q->end_table() );
	print $encoder->encode( $q->end_form() );
}

# EOF

config.txt

サーバ情報設定TSVファイル。
MAC は WakeOnLan のパケットを送信する NIC の MAC アドレス。
NIC が２枚以上ある場合は、「/」で連結して書く。

Name の先頭に「#」が付いている行はコメントとして無視される。

"Name"	"Type"	"IP"	"MAC"	"Comment"
"Srv01"	"Win2003"	"192.168.0.10"	"XX:XX:XX:XX:XX:XX"	"Web Hosting"
"Srv02"	"CentOS6"	"192.168.0.11"	"XX:XX:XX:XX:XX:XX/XX:XX:XX:XX:XX:XX"	"Mail, MySQL"
"#Srv03"	"Win2008R2"	"192.168.0.12"	"XX:XX:XX:XX:XX:XX"	"Streaming"
"Srv04"	"MacOSX 10.6"	"192.168.0.13"	"XX:XX:XX:XX:XX:XX"	"FileSrv"

NetWatcher.conf

Apache 用設定ファイル。

.htaccess でも代用可能。

<Directory "/var/www/html/NetWatcher">
	Options ExecCGI Indexes
	DirectoryIndex index.cgi
	Order allow,deny
	Allow from 127.0.0.1
	Allow from 192.168.0.0/24
	Allow from 10.8.0.0/24
</Directory>

<Directory "/var/www/html/NetWatcher/conf">
	Options None
	Order allow,deny
</Directory>

システム設定

パッケージ追加

EPEL, RPMForge リポジトリを追加しておくこと。
リポジトリ追加

# yum install perl-Net-Ping-External perl-Parallel-ForkManager perl-IPC-Shareable

SELinux設定

audit.log を元にポリシーを作成しインストールする。
ログ分析

# semodule -d mypol
# setenforce 0
# service auditd rotate
(NetWatcher実行)
# setenforce 1
# grep "index.cgi\|ping" /var/log/audit/audit.log | audit2allow -M mypol_NetWatcher
# semodule -i mypol_NetWatcher.pp

mypol_NetWatcher.te
こんなポリシーができてるはず。

module mypol_NetWatcher 1.0;

require {
        type httpd_sys_script_t;
        type tmpfs_t;
        class capability { setuid net_raw };
        class sem { unix_read write unix_write read destroy create };
        class shm { write associate read create unix_read getattr unix_write  destroy };
        class file { read write };
        class rawip_socket { write getopt create read setopt };
}

#============= httpd_sys_script_t ==============
allow httpd_sys_script_t self:capability { setuid net_raw };
allow httpd_sys_script_t self:rawip_socket { write getopt create read setopt };
allow httpd_sys_script_t self:sem { unix_read write unix_write read destroy create };
allow httpd_sys_script_t self:shm { unix_read associate read create write getattr unix_write destroy };
allow httpd_sys_script_t tmpfs_t:file { read write };

IIS の場合は、ping.exe の「プロパティ - セキュリティ」を開き、「インターネットゲストアカウント(IUSR_<マシン名>)」に「読み取りと実行」権限を付加する。
- [PRB] [IIS 6.0] 外部アプリケーションを呼び出す CGI コードが失敗する

リンク

Perl/CGI.pm
Perl/readXSV
CPAN:Net-Ping-External
CPAN:Net-Arping
CPAN:Net-Wake
CPAN:Parallel-ForkManager
CPAN:IPC-Shareable
CPAN:threads
CPAN:threads-shared
CPAN:Encode
- CPAN:Encode/encoding.pm
  use encoding ... is not thread-safe.
(Obsolete) Parallel::ForkManager + IPC::Shareable で複数のプロセスで変数を共有する - Yet Another Hackadelic
パターン青の集い: memo::Perlによる複数並列処理プログラム
Forkが気になりつつthread - ito.tetsunosuke/notebook
404 Blog Not Found:perl - Encode 入門
use threads; するときに注意すべきこと - punitan (a.k.a. punytan) のメモ
threads と binmode を同時に使うとクラッシュする。
404 Blog Not Found:perl - 勝手に添削 - Webサイト死活管理
お手軽に死活監視をPerlのCPANモジュールApp::MadEyeで行う @ hirobanex.net
gWakeOnLan
gWakeOnLan is a GTK+ utility to awake turned off machines using the Wake on LAN feature.