Value-Domain用のDDNS更新スクリプト

Linux版DiCEの設定が今一不便なので、Perlの練習がてらに自作の更新スクリプトを書いてみた。Value-Domain専用。

/usr/local/bin/vdddns

use strict;
use LWP::UserAgent;
use File::Slurp;
use Sys::Syslog;

# settings
my $interval = 3000; # seconds
my $working_directory = "/var/vdddns";
my $ip_check_uri = "http://dyn2.value-domain.com/cgi-bin/dyn.fcg?ip";
my $update_uri_template = 'http://dyn2.value-domain.com/cgi-bin/dyn.fcg?d=@DOMAIN@&p=@PASSWORD@&h=@HOST@&i=@IP_ADDRESS@';
my $conf_file = "/etc/vdddns.conf";
my ($log_stdout, $log_syslog, $log_file) = (1, 1, 1);


# settings 2
my $save_file = $working_directory . "/ip";
my $log_file = $working_directory . "/log";

# command line params
my $mode = 0;
if ($ARGV[0] eq "-c") {$mode = 1};
if ($ARGV[0] eq "-f") {$mode = 2};

# load saved ip address
my $ip = read_file($save_file, err_mode => 'quiet');
unless ($ip) {
    # the first running
    $ip = "UNSET"; # dummy ip
}


# HTTP requset
my $ua = LWP::UserAgent->new;
my $ip_req = HTTP::Request->new(GET => $ip_check_uri);


# start observation
if ($mode eq 0) {
    print_log("VDDDNS has been started. Saved IP address: $ip")
};
while (1) {
    my $ip_res = $ua->request($ip_req);
    if ($ip_res->is_success) {
        my $new_ip =  $ip_res->content;
        if ($new_ip ne $ip || $mode eq 2) {
            # IP address changed or force to update
            if ($mode eq 2) {
                print_log("IP address: $new_ip");
            } else {
                print_log("IP address changed: $ip -> $new_ip");
            }

            $ip = $new_ip;

            unless (write_file($save_file, $ip)) { # save to the file
                print_log( "Could not write the ip address: $save_file");
            }

            # load conf list
            my @entries = ();
            my $conf_list = read_file($conf_file, err_mode => 'quiet');
            unless ($conf_list) {
                print_log("Could not load the configration file: $conf_file");
            } else {
                my @lines = split /\n/, $conf_list;
                foreach my $line (@lines) {
                    my @values = split /\s+/, $line;
                    if (@values ne 0) { # remove empty line
                        push(@entries, [@values]);
                    }
                }
            }

            foreach my $entry (@entries) {
                # make uri for updating
                my ($account, $password, $domain, $host) = @{$entry};
                my $update_uri = $update_uri_template;
                $update_uri =~ s/\@ACCOUNT\@/$account/g;
                $update_uri =~ s/\@PASSWORD\@/$password/g;
                $update_uri =~ s/\@DOMAIN\@/$domain/g;
                $update_uri =~ s/\@HOST\@/$host/g;
                $update_uri =~ s/\@IP_ADDRESS\@/$ip/g;

                # request to update
                my $update_req = HTTP::Request->new(GET => $update_uri);
                my $update_res = $ua->request($update_req);
                if ($update_res->is_success) {
                    # parse result
                    my ($status_code_line, $status_message) = split /\n/, $update_res->content;
                    $status_code_line =~ /^status=(.*)$/;
                    my $status_code = $1;

                    # print result
                    if ($status_code eq "0") {
                        print_log("Updating success: $host.$domain");
                    } else {
                        print_log("Updating error: $host.$domain $status_message");
                    }
                } else {
                    print_log("Updating HTTP error: $update_uri " . $update_res->status_line);
                }
            }

        }
    } else {
        print_log ("IP adress lookup error: " . $ip_res->status_line);
    }

    if ($mode ne 0) { last; }
    sleep $interval;
}

sub print_log {
    my ($message) = @_;

    my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
    $mon++;
    $year += 1900;

    my $full_message = sprintf "[%s-%s-%sT%s:%s:%s] %s\n", $year, $mon, $mday, $hour, $min, $sec, $message;

    if ($log_stdout) {
        print $full_message;
    }

    if ($log_file) {
        write_file($log_file, {append => 1}, $full_message)
    }

    if ($log_syslog) {
        openlog('VDDDNS', 'cons,pid', 'user');
        syslog('info', $message);
        closelog();
    }
}

/etc/vdddns.conf

account   foo  example.com  www
account   foo  example.com  home

account2  bar  example.jp   www

使い方は次のような感じ。

# 引数無しだとデーモンとして起動する。
# プロセスが常駐して、指定時間毎にチェックを行い、
# IPが変更されていた場合は更新を行う。
perl /usr/local/bin/vdddns

# cronで起動する時は-cを付ける。
# 前回起動時のIPと比較して、変更があった場合のみ更新を行う。
perl /usr/local/bin/vddns -c

# 強制的に更新を行いたい場合は-fを付ける。
# 起動時のIPで更新を行う。
perl /usr/local/bin/vddns -f

設定ファイルは次のフォーマットで書く。各項目をタブか半角スペースで区切って並べる。空白文字の数は任意でかまわない。空行は無視される。

アカウント名 DDNS用パスワード ドメイン名 ホスト名

実はアカウント名は更新時には使わないのだが、気にしない方向で。

なお、IPアドレスを保持するファイルを/var/vdddnsに作るので、あらかじめmkdir -p /var/vdddnsしておく必要がある。

cronで定期的に起動する場合は適当な設定ファイル（crontab -eで開く）に次の行を足しておくと良い。

0-59/10 * * * * perl /usr/local/bin/vdddns -c

この設定で10分ごとにIPが変更されていないかがチェックされる。確認の間隔を余り短くしすぎると、DDNSのサーバに負荷が掛かりすぎてしまうので注意。

デーモンとして起動する場合は適当にinit.dスクリプトを書けばいいのだろうが、調べるのが面倒なので今日の所はとりあえずここまでにしておく。それにしても、cron版と強制更新版を完成後に足したせいで、ソースが汚くなってしまった。最初から思いついていればもう少しまともな設計が出来たのだが。