DDNS を自動で更新する - はちゅにっき

DDNS を自動で更新してくれるスクリプトは沢山あるけれど
自分が要求するようなモノを、見つけることができなかったので作ってみた。
要求事項はこんな感じ

Linux で動く
ieServer を利用しているので ieServer に対応している
Value Domain を利用しているので Value Domain に対応している
- Value Domain ではホスト名を指定する必要があるのでホスト毎に更新してくれる
こんな機能が1つのスクリプトで動く

つまり、ieServer と Value Domain の両方を、1つのスクリプトで更新したいだけなのですが
せっかくだったら、指定されたページを GET するだけで更新できる系のシステムなら
すべてに対応できるってゆーのが理想的だよね。
それも、スクリプトをいじるんじゃなくて
設定ファイル書き換えるだけで自動でやってくれたら嬉しいよね。
とゆーわけで、こんなの Perl で書いてみました。

#!/usr/bin/perl -w

use warnings;
use strict;
use utf8;

use LWP::UserAgent;
use HTTP::Request::Common;
use YAML::Syck;
use Date::Format;
use IO::All;
use FindBin;
use Cwd qw( chdir );

our $VERSION = 0.01;

# 出力文字文字コード (気にする必要なさそうだけどー)
binmode(STDOUT, ':utf8');
binmode(STDERR, ':utf8');

chdir $FindBin::Bin;

# 読み込む設定ファイル
my $FILE = 'ddns.yml';


## ---


# yaml 取得
my $yaml = LoadFile($FILE);

# 時刻取得
my $date = time2str("%y/%m/%d %H:%M:%S", time, '+0900');

# ua の設定
my $ua = LWP::UserAgent->new;
$ua->timeout(30);
$ua->agent("DdnsUpdater/$VERSION");

# global ip 取得
my $uri = $yaml->{ipcheck} || 'http://ieserver.net/ipcheck.shtml';
my $res = $ua->request(GET $uri);

# 取得に失敗したら終了
die $res->status_line unless $res->is_success;
my $ip = $res->content;

# 改行文字があったら消す
$ip =~ tr/\x{202D}\x{202E}//d;


# 更新作業開始
foreach my $entry ( @{$yaml->{update_list}} ) {
    # ip アドレスに変化がないなら更新しない
    next if $ip eq $entry->{current};

    # uri 生成
    $uri = $entry->{uri}.'?';
    map { $uri .= '&'.$_.'='.$entry->{param}->{$_} } keys %{$entry->{param}};

    # 更新
    $res = $ua->request(GET $uri);

    # 失敗したら次行ってみよう
    unless ( $res->is_success ) {
        # 出力
        write_msg( sprintf("[%s] %s: Aborted %s\n",
                       $date, $entry->{name}, $res->status_line)
        );
        next;
    }

    # 出力
    write_log( sprintf("[%s] %s: Update IP Address %s to %s\n",
                   $date, $entry->{name}, $entry->{current}, $ip)
    );

    # yaml の IP アドレス更新
    $entry->{current} = $ip;
}


# yaml 出力
DumpFile($FILE, $yaml);


sub write_log
{
    my $str = shift;

    print $str;

    # log 出力 ON ならログに記録
    $str >> io($yaml->{log}) if defined $yaml->{log};
}

で、設定はファイルはYAML形式で、これを元に更新を行ないます。
ファイルは ddns.yml という名前で保存。

---
ipcheck: http://dyn.value-domain.com/cgi-bin/dyn.fcg?ip  # ip チェックに使う uri
log: ddns.log  # logfile の名前。コメントアウトするとログをとらない
update_list:   # ここから下が更新の対象となるドメインの設定
  -
    current: 0.0.0.0
    name: domain
    param:
      d: mydomain.jp
      h: "@"
      p: password
    uri: http://dyn.value-domain.com/cgi-bin/dyn.fcg
  -
    current: 0.0.0.0
    name: mail
    param:
      d: mydomain.jp
      h: mx
      p: password
    uri: http://dyn.value-domain.com/cgi-bin/dyn.fcg
  -
    current: 0.0.0.0
    name: ieServer
    param:
      domain: fam.cx
      password: password
      updatehost: 1
      username: mydomain
    uri: https://ieserver.net/cgi-bin/dip.cgi

↓が設定の1パーツ

  -
    name: ieServer   # 名前 (好き勝手につけれる)
    current: 0.0.0.0 # 今DDNS登録されてる IP。  IP が変わったときだけ更新をする
    uri: https://ieserver.net/cgi-bin/dip.cgi # 更新に使う uri
    param: # uri?domain=fam.cx&password=password… ←このパラメータ部分を列挙する
      domain: fam.cx
      password: password
      updatehost: 1
      username: mydomain

これを contab に登録しておけば、後は勝手に ieServer も Value Domain も
両方更新してくれるようになりました。
ただし、LWP で SSL 通信をする場合、別途 Crypt::SSLeay が必要になりました。
debian では

aptitude install libcrypt-ssleay-perl

で、インストールすると楽でした。
他にも CPAN から必要なモジュールをインストールする必要があります。

# perl -MCPAN -e 'install IO::All'
# perl -MCPAN -e 'install YAML::Syck'