#!/usr/local/bin/perl

###############################################################################
#
# NetGenesis4 接続・切断・状態確認・時刻設定 ＣＧＩ (1999.07.31)
#    nwg4con2.cgi
#	Copyright(C) 1999 M.Okamura (anb@y7.net)
#	http://hp.vector.co.jp/authors/VA008536/
#
# 動作確認（通信プロトコルは独自解析のものです。）
#   Firmware Version : 2.313  (PS1)
#   Perl for Win32
#   ActivePerl
#   Linuxの Perl5
#   Macの Perl5
#
# 改変は自由です。もっと使いやすくしてください。
# CGIな処理（引数とか）の部分をカットすればコマンドライン版にもできますね。
# マルチアカウント機能に対応しました。
# Firmware 2.313以前での動作も考慮してあります。
#
# NetGenesis4は株式会社マイクロ総合研究所(http://www.mrl.co.jp/)の製品です。
#
###############################################################################


# NetGenesis4のIPアドレスとシリアルポート（各自の環境で書き換えてください）####
$them   = '192.168.0.1';
$serial = 1;
$cgi    = 'nwg4con2.cgi';
$debug  = 0;


# for test（一つだけコメントアウトすると、コマンドラインから確認できます） ####
#$ENV{'QUERY_STRING'} = 'connect=1&default=0&isp=0';
#$ENV{'QUERY_STRING'} = 'disconnect=1';
#$ENV{'QUERY_STRING'} = 'time=1';
#$ENV{'QUERY_STRING'} = 'status=1';
#$ENV{'QUERY_STRING'} = 'set=1';


# コマンド固有バイト列 ########################################################
$time = "\x41\x0B";
$set  = "\x41\x04";
if( $serial == 1 ) {
	$connect    = "\x01\x6A";	# SERIAL 1
	$disconnect = "\x01\x68";	# SERIAL 1
	$status     = "\x01\x64";	# SERIAL 1
	$dial       = "\x01\x6E";	# SERIAL 1
} else {
	$connect    = "\x01\x6B";	# SERIAL 2
	$disconnect = "\x01\x69";	# SERIAL 2
	$status     = "\x01\x65";	# SERIAL 2
	$dial       = "\x01\x6F";	# SERIAL 2
}


# CGI引数解析 #################################################################
if ($ENV{'REQUEST_METHOD'} eq "POST") {
	read( STDIN , $buffer , $ENV{'CONTENT_LENGTH'} );
}
else {
	$buffer = $ENV{'QUERY_STRING'};
}

@pairs = split( /&/ , $buffer );
foreach $pair ( @pairs ) {
	( $name , $value ) = split( /=/ , $pair);
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$form{$name} = $value;
}


# 引数から使用するコマンド決定 ################################################
$cmd = '';
$cmd = $dial            if( $form{'isp'} ne '' );
$cmd = $connect		if( $form{'connect'} ne '' );
$cmd = $disconnect	if( $form{'disconnect'} ne '' );
$cmd = $time		if( $form{'time'} ne '' );
$cmd = $status		if( $form{'status'} ne '' );
$cmd = $set		if( $form{'set'} ne '' );


# ヘッダ出力 ##################################################################
print "Content-type: text/html\n\n";
print "\n";


# 通信初期化 ##################################################################
use Socket;

# IPアドレスをバイト列に変換
#$ipaddress = inet_aton($them);
if( $them =~ /^(\d+).(\d+).(\d+).(\d+)$/ ) {
	$ipaddress = pack( "C4",$1,$2,$3,$4 );
} else {
	&error("ＩＰアドレス $them");
}

$proto = getprotobyname('udp');
socket(S, AF_INET, SOCK_DGRAM, $proto) || &error("ソケット生成");

binmode S;


# コマンドが未定義の場合は、メニュー表示 ######################################
&menu( $ipaddress )  if( $cmd eq '' );


# 通信処理 ####################################################################

# 時刻設定の場合の時刻データ
if( $cmd eq $time ) {
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
	$cmd2 = pack( "n3", $hour, $min, $sec );
} elsif ( $cmd eq $status ) {
	$cmd2 = "\x00\x00\x00\x00";
} else {
	$cmd2 = '';
}

# 接続コマンドで現在と違うアカウントの場合、接続先設定コマンド送信
if( $cmd eq $dial || ($cmd eq $connect && $form{'default'} ne $form{'isp'}) ) {
	$data = &nwg( $ipaddress, $dial, pack( "n", $form{'isp'} ) );
	$stat = unpack( "n", substr( $data, 0x10, 2 ) );
	print "エラー：接続先設定<BR>\n"  if($stat);
	&menu( $ipaddress )  if($cmd eq $dial);
	exit(1)  if($stat);
	print "接続先設定コマンドを送信しました。<BR>\n";
}

# コマンド送信、データ受信
$data = &nwg( $ipaddress, $cmd, $cmd2 );


# 結果処理 ####################################################################
if( $cmd eq $connect ) {
	print "接続コマンドを送信しました。<BR>\n";
	&check( $ipaddress );

}elsif( $cmd eq $disconnect ) {
	print "切断コマンドを送信しました。<BR>\n";
	&check( $ipaddress );

}elsif( $cmd eq $time ) {
	printf("時刻設定コマンドを送信しました。%02d:%02d:%02d<BR>\n",
		$hour, $min, $sec );

}elsif( $cmd eq $status ) {
	if( unpack( "n", substr( $data, 0x06, 2 ) ) < 0x164 ) {
		$stat = unpack( "n", substr( $data, 0x14, 2 ) );
		print "切断<BR>\n"	if( $stat == 3 );
		print "処理中<BR>\n"	if( $stat == 4 );
		print "接続<BR>\n"	if( $stat == 5 );
	}else {
		$stat = unpack( "n", substr( $data, 0x22, 2 ) );
		print "切断<BR>\n"	if( $stat == 3 );
		print "処理中<BR>\n"	if( $stat == 4 );
		printf( "接続 My IP=%d.%d.%d.%d<BR>\n",
			unpack( "C", substr( $data, 0x13c , 1) ),
			unpack( "C", substr( $data, 0x13d , 1) ),
			unpack( "C", substr( $data, 0x13e , 1) ),
			unpack( "C", substr( $data, 0x13f , 1) )
		)			if( $stat == 5 )
	}
}elsif( $cmd eq $set ) {
}else {
	&error("応答無し");
}

&menu( $ipaddress );

exit(0);


# メニュー ####################################################################
sub menu
{
	my $ipaddr = $_[0];
	# 状態確認コマンド
	my $data = &nwg( $ipaddr, $status, "\x00\x00\x00\x00" );
	# データ長
	my $len  = unpack( "n", substr( $data, 0x06, 2 ) );
	my $condition = "無効";
	my $stat;
	if( $len < 0x164 ) {
		$stat = unpack( "n", substr( $data, 0x14, 2 ) );
		$condition = "切断"	if( $stat == 3 );
		$condition = "処理中"	if( $stat == 4 );
		$condition = "接続"	if( $stat == 5 );
	} else {
		$stat = unpack( "n", substr( $data, 0x22, 2 ) );
		$condition = "切断"	if( $stat == 3 );
		$condition = "処理中"	if( $stat == 4 );
		$condition = sprintf( "接続 My IP=%d.%d.%d.%d",
			unpack( "C", substr( $data, 0x13c , 1) ),
			unpack( "C", substr( $data, 0x13d , 1) ),
			unpack( "C", substr( $data, 0x13e , 1) ),
			unpack( "C", substr( $data, 0x13f , 1) )
		)			if( $stat == 5 );
	}

	my $default;
	my @isp;
	my @name;
	if( $len < 0xA8 ) {
		# データが足りないので、マルチアカウントは無効
		$default = 0;
		$isp[0] = 1;
		$isp[1] = 0;
		$isp[2] = 0;
		$isp[3] = 0;
		$name[0] = "ISP";
	} elsif( $len < 0x164 ) {
		# 現在の接続先番号
		$default = unpack( "n", substr( $data, 0x1C, 2 ) );
	
		# 接続先有効フラグ
		$isp[0] = unpack( "n", substr( $data, 0x30, 2 ) );
		$isp[1] = unpack( "n", substr( $data, 0x32, 2 ) );
		$isp[2] = unpack( "n", substr( $data, 0x34, 2 ) );
		$isp[3] = unpack( "n", substr( $data, 0x36, 2 ) );
	
		# 接続先名
		($name[0]) = split( /\x00/, substr( $data, 0x38, 32 ) );
		($name[1]) = split( /\x00/, substr( $data, 0x58, 32 ) );
		($name[2]) = split( /\x00/, substr( $data, 0x78, 32 ) );
		($name[3]) = split( /\x00/, substr( $data, 0x98, 32 ) );
	} else {
		# 現在の接続先番号
		$default = unpack( "n", substr( $data, 0x2A, 2 ) );
	
		# 接続先有効フラグ
		$isp[0] = unpack( "n", substr( $data, 0x2C, 2 ) );
		$isp[1] = unpack( "n", substr( $data, 0x2E, 2 ) );
		$isp[2] = unpack( "n", substr( $data, 0x30, 2 ) );
		$isp[3] = unpack( "n", substr( $data, 0x32, 2 ) );
	
		# 接続先名
		($name[0]) = split( /\x00/, substr( $data, 0x34, 32 ) );
		($name[1]) = split( /\x00/, substr( $data, 0x54, 32 ) );
		($name[2]) = split( /\x00/, substr( $data, 0x74, 32 ) );
		($name[3]) = split( /\x00/, substr( $data, 0x94, 32 ) );
	}


	my $hidden = '';
	$hidden = '<INPUT TYPE="submit" NAME="set" VALUE=" ">'  if($debug);

	print <<"_MENU1_";
<HTML>
<HEAD>
<TITLE>NWGset lite</TITLE>
</HEAD>
<BODY>
<CENTER>
<H2>NetGenesis4</H2>($them) $condition
<P>
<FORM ACTION="$cgi" METHOD="POST" NAME="menu">
<SELECT NAME="isp" onChange="document.menu.submit();">
_MENU1_

	for( $i = 0; $i < 4; $i++ ) {
		if( $isp[$i] != 0 ) {
			print "<OPTION VALUE=\"$i\"";
			print " SELECTED"  if( $i == $default );
			print ">$name[$i]\n";
		}
	}

	print <<"_MENU2_";
</SELECT>
<INPUT TYPE="hidden" NAME="default" VALUE="$default"><P>
<INPUT TYPE="submit" NAME="connect" VALUE="　接続　"><P>
<INPUT TYPE="submit" NAME="disconnect" VALUE="　切断　"><P>
<INPUT TYPE="submit" NAME="time" VALUE="時刻設定"><P>
<INPUT TYPE="submit" NAME="status" VALUE="状態確認">$hidden<P>
<P>
</FORM>
</CENTER>
</BODY>
</HTML>
_MENU2_

	exit(0);
}


# 接続・切断処理完了待ち ######################################################
sub check
{
	my $ipaddr = $_[0];
	my $data;
	my $stat;

	do {
		sleep(2);
		$data = &nwg( $ipaddr, $status, "\x00\x00\x00\x00" );
		if( unpack( "n", substr( $data, 0x06, 2 ) ) < 0x164 ) {
			$stat = unpack( "n", substr( $data, 0x14, 2 ) );
		} else {
			$stat = unpack( "n", substr( $data, 0x22, 2 ) );
		}
	} while( $stat == 4 );

	return $stat;
}


# エラー ######################################################################
sub error
{
	print "エラー：$_[0]<BR>\n";
	exit(1);
}


# ＵＤＰ通信処理 ##############################################################
sub nwg
{
	my $packetno = "\x00\x02";
	my $NULL2    = "\x00\x00";
	my $NULL8    = "\x00\x00\x00\x00\x00\x00\x00\x00";
	my $ipaddr   = $_[0];
	my $command  = $_[1];
	my $command2 = $_[2];
	my $size;
	my $packet;
	my $data;

	$data   = "$ipaddr$command2";
	$data   = "$command2"  if( $command eq $dial );
	$size   = pack("n", length($data) );
	$packet = "$packetno$NULL2$command$size$NULL8$data";

	# NetGenesis4で使用するUDPポート
	my $port = 4449;
	my $that = sockaddr_in($port, $ipaddr);

	# データ送信
	send(S, $packet, 0, $that) || &error("送信");
	print "<XMP>send\n" . &dump($packet) . "</XMP>\n"  if($debug);

	# データ受信
	recv(S, $data, 1024, 0) || &error("受信");
	print "<XMP>recv\n" . &dump($data) . "</XMP>\n"  if($debug);

	return $data;
}


# ダンプ出力 ##################################################################
sub dump
{
	my @data = unpack( "C*", $_[0] );
	my $line;
	my $i = 0;
	my $msg = '';

	foreach ( @data ) {
		if( ($i % 0x10)==0 ) {
			$msg = $msg . sprintf( "%05X : " , $i );
			$line = '';
		}
		$msg = $msg . "- "  if( ($i % 0x10) && ($i % 0x08)==0 );
		$msg = $msg . sprintf( "%02X ", $_ );
		if( $_ >= 0x20 && $_ <= 0x7E ) {
			$line = sprintf( "%s%c", $line, $_ );
		} else {
			$line = "$line.";
		}
		$i++;
		$msg = $msg . "  $line\n"  if( ($i % 0x10)==0 );
	}

	if( $i % 0x10 ) {
		$msg = $msg . ' 'x ( (16-($i % 0x10)) * 3);
		$msg = $msg . '  '  if( ($i % 0x10) < 9 );
		$msg = $msg . "  $line\n";
	}
	return $msg;
}