IPv6接続用DTCPクライアントをNet::POP3をベースに作ってみた

IPv6でのDTCP接続をする時に参考にさせて頂いたsetup-dtcp.plはNet::POP3の関数を呼び出すように設計されています。 自分で使うのに手を入れずらかったので、実験を兼ねてNet::POP3を継承したDTCPクライアントを作成してみました。

実際に使っているものは、もう少し手を加えていますが、最低限の機能を実現するバージョンを載せておきます。

Perlでの差分プログラミング

Net::POP3はpackageを使ったPerlクラスとして設計されています。 そこでAPOPのコードをベースにDTCP用のコードを追加してみました。

結果として、この範囲の機能だとかなり冗長な感じになってしまいました。 ただ自分で使う分には見通しが良くなったので、もう少し手を加えて使っています。

スクリプトの内容

 #!/usr/bin/perl

package YADtcpc;
use vars qw(@ISA $VERSION $debug);
use Net::POP3;
use Net::Cmd;
use Carp;
@ISA = qw(Net::POP3);

sub logit {
    my ($self, $msg) = @_;
    printf(STDERR "debug: %s\n", $msg);
}

## based on the 'sub apop'
sub _DTCP { shift->command('tunnel', @_)->response() == CMD_OK; }
sub dtcp {
    @_ >= 1 && @_ <= 3 or croak 'usage: $dtcp->dtcp( USER, PASS )';
    my($me,$user,$pass) = @_;
    my $banner;
    my $md;

    if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
	$md = Digest::MD5->new();
    } elsif (eval { local $SIG{__DIE__}; require MD5 }) {
	$md = MD5->new();
    } else {
	carp "You need to install Digest::MD5 or MD5 to use the DTCP command";
	return undef;
    }

    my $msg = ${*$me}{'net_pop3_banner'};
    return undef
	unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /^([0-9A-z]+)\s+/)[0] );

    if (@_ <= 2) {
	($user, $pass) = $me->_lookup_credentials($user);
    }

    $md->add($user,$banner,$pass);

    $me->_DTCP($user, $md->hexdigest, 'network');

    $me->get_remote_link_addr();
}
sub get_remote_link_addr {
    my ($self) = @_;

    if ($self->message =~ /^(\d+[\.\d]+)\s+(\d+[\.\d]+)\s+([\d\:a-f]+)\/(\d+)/i) {
	return ($1, $2, $3, $4);
    } else {
	$self->logit("I couldn't get the correct response, then aborting now...");
	$self->quit();
	exit 1;
    }
}
sub _PING { shift->command('PING')->response() == CMD_OK }
sub ping {
    @_ == 1 or croak 'usage: $dtcp->ping()';
    my $me = shift;

    return () unless $me->_PING() && $me->message =~ /^([0-9A-z]+)/i;
    ($1 || 0);
}

##########
## main ##
##########
my $host = "dtcp.feel6.jp";
my $port = 20200;
my $user = "xxxxxx";
my $pass = "xxxxxx";

my $dtcpc = YADtcpc->new($host, Port=>$port);
my ($local,$remote,$prefix,$mask) = $dtcpc->dtcp($user, $pass);
printf("local=%s,remote=%s,prefix=%s,mask=%s\n", $local, $remote, $prefix, $mask);

while ($dtcpc->ping() =~ /pong/i) {
    printf("send ping message\n");
    sleep 60;
}

$dtcpc->logit("exit from while(1) loop because we ditn't receive the 'pong' message.");
$dtcpc->quit();

__END__

応用について

一応モジュールなので## main ##行より前半部分はYADtcp.pmとして使う事もできます。ただ、ここで分割する利点はないので一つの.plファイルとしてまとめています。

コード内部にパスワードを書くのは良いマナーとはいえないので、実際には別ファイルに分割していましょう。

バックグラウンドで動かすためには$ sudo -b ./yadtcpc.plみたいに動かす事ができますが、prefixなどの情報をファイルに書き出すようにしないとですね。 それに数回コネクションが切断してしまう経験もしたので、再接続のループは追加した方が良いでしょう。

だいたいこんな感じでしょうか。