#!/usr/bin/perl

# このスクリプトは絶対に root でしか読めないようにパーミッションを設定すべし !!!

# Dynamic DNS client for Value-Domain
#
#   Copyright (C) 2003 Seiichi Yamazaki. All rights reserved.
#   http://yamachan.org/

$version = '0.1.1';



##### 設定ここから ##########################################

# IP アドレスのキャッシュと、スクリプトの動作ログ
$ip = '/PATH/TO/ddns_vd.ip';
$log = '/PATH/TO/ddns_vd.log';

# TA のグローバル IP アドレス表示ページ
$ta_uri = 'http://web.setup/info_main.html';

# TA のグローバル IP アドレスの正規表現 ($1 を IP アドレスと見なす)
$ta_pattern = 'WAN.. IP........</LABEL></TD>\\s*<TD>([0-9.]+)';

# TA のログイン認証に用いるユーザ名とパスワード
$ta_user = 'admin';
$ta_passwd = 'TA_PASSWORD';

# 対象となるドメイン
$domain = 'example.com';

# 対象となるサブドメイン
$subdomain = 'www';

# DDNS 用のパスワード
$vd_passwd = 'VD_PASSWORD';

##### 設定ここまで ##########################################



$| = 1;

use Socket;
use MIME::Base64;

# TA にアクセスするための認証情報を作成
$ta_auth = encode_base64 ("$ta_user:$ta_passwd");

# TA に IP アドレスの入ったデータを取りに行く
($status, $http_status, @data) = &gethttp ($ta_uri);
&error ("Access to TA is failed : $status") if $status ne '';

# IP アドレスを検出
$data = join ('', @data);
if ($data =~ /$ta_pattern/) {
	$wan_ip = $1;
}
else {
	&error ("Can't find grobal IP address in TA's data");
}

# キャッシュ済みの IP アドレスと比較
(open IN, $ip) || &error ("Can't open IP address cache file to read.");
($cache_ip, $cache_time) = split (':', <IN>);
close IN;

# IP アドレス変更なし
if ($cache_ip eq $wan_ip) {
	exit;
}
# IP アドレス変更あり
else {
	# VD アクセス用の URI を生成
	$vd_uri = "http://dyn.value-domain.com/cgi-bin/dyn.fcg?d=$domain&p=$vd_passwd&h=$subdomain&i=$wan_ip";
	# VD に IP アドレスを投げる
	($status, $http_status, @data) = &gethttp ($vd_uri);
	&error ("Access to Value-Domain is failed : $status") if $status ne '';
	$data = join ('', @data);
	if ($data =~ m#status=\s*(\d+)#) {
		$status = $1;
		if ($status == 0) {
			&logging ("Sending grobal IP address is success : $cache_ip -> $wan_ip");
			(open OUT, ">$ip") || &error ("Can't open IP address cache file to write.");
			printf (OUT "%s:%d", $wan_ip, time);
			close OUT;
		}
		else {
			&error ("Sending grobal IP address is failed : $cache_ip -> $wan_ip, status=$status");
		}
	}
	else {
		&error ("Sending grobal IP address is failed : status code is not found in server response.");
	}
}

sub gethttp {

	local ($status, $host, $path, $port, $ipaddr, $sockaddr, $proto, $http_status, $redir, $retry, @data);
	$status = '';
	$redir = '';

	if (defined $_[1]) {
		$retry = $_[1];
	}
	else {
		$retry = 0;
	}

	if ($_[0] =~ m!^http://([^/]+)(/.*)!) {
		$host = $1;
		$path = $2;
	}
	else {
		return ('baduri');
	}

	# ポート番号
	$port = 80;

	# ホスト名 → IP アドレス
	$ipaddr = inet_aton ($host)
		|| return ('badhost');

	# ポート番号, IP アドレス → ソケットアドレス
	$sockaddr = sockaddr_in ($port, $ipaddr);

	# プロトコル番号の取得
	$proto = getprotobyname ('tcp');

	# ソケットを開く
	socket (S, PF_INET, SOCK_STREAM, $proto)
		|| return ('sockopenfailed');

	# ソケットに接続する
	connect (S, $sockaddr)
		|| return ('sockconnfailed');

	# データを要求する
	send (S, "GET $path HTTP/1.1\n", 0);

	# ホスト名を言う
	send (S, "Host: $host\n", 0);

	# 好き嫌いを言ってみる
	send (S, "Accept: text/plain, text/html;q=0.5, */*;q=0.1\n", 0);

	# 名乗ってみる
	send (S, "User-Agent: ddns_vd/$version gethttp/0.1.0\n", 0);

	# パスワードを送る
	if ($_[0] eq $ta_uri) {
		send (S, "Authorization: Basic $ta_auth\n", 0);
	}

	# ヘッダ終わり
	send (S, "\n", 0);

	# 1 行目は HTTP ステータスコード
	$http_status = <S>;

	# データを受け取る
	@data = <S>;

	# ソケットを閉じる
	close (S)
		|| return ('sockclosefailed');

	if ($http_status =~ /\d{3}/) {
		if ($& >= 500) {
			$status = 'http5xx';
		}
		elsif ($& >= 400) {
			$status = 'http4xx';
		}
		# Moved Permanently, Moved Temporarily, See Other に対応
		elsif ($& >= 300) {
			foreach (@data) {
				last if /^$/;
				$redir = $1 if /^Location\s*:\s*(.+)/i;
			}

			# リダイレクト
			if ($redir ne '') {
				if ($retry < 3) {
					($status, $http_status, @data) = &gethttp ($redir, $retry + 1);
				}
				else {
					return ('retrytoomany');
				}
			}
			else {
				$status = 'http3xx';
			}
		}
	}
	else {
		$status = 'nohttpstat';
	}

	return ($status, $http_status, @data);

}

sub logging {
	@nows = localtime (time);
	$now = sprintf ('<%04d/%02d/%02d %02d:%02d:%02d>',
			$nows[5]+1900, $nows[4]+1, $nows[3], $nows[2], $nows[1], $nows[0]);

	open LOG, ">>$log";
	print LOG "$now $_[0]\n";
	close LOG;
}

sub error {
	&logging ("[ERROR] $_[0]");
	exit;
}