DNS クライアントを作ってみよう (3)

TOP >> ネットワークプログラミングの基礎知識 >> DNS クライアントを作ってみよう (3)

インタフェース

概要がわかったところで、実際に DNS クライアントを作ってみましょう。

今回作成するプログラムのインタフェースは以下の通りです。

% ./resolver-1.pl DNSサーバ名 名前解決ホスト名 [照会タイプ] [照会クラス]

照会タイプは A, NS, CNAME, MX, TXT, AAAA などを指定することができ、省略時は A が指定されたものとみなします。照会クラスは Internet, CHAOS などを指定することができ、省略時は Internet が指定されたものとみなします。照会タイプを省略し、照会クラスを引数で指定することはできません。

いくつか実行例を示します。

% ./resolver-1.pl ns.jp.freebsd.org www.jp.freebsd.org
   (www.jp.freebsd.org の正引きを行う)
% ./resolver-1.pl ns.jp.freebsd.org www.jp.freebsd.org a
   (上と同じ)
% ./resolver-1.pl ns.jp.freebsd.org www.jp.freebsd.org aaaa
   (www.jp.freebsd.org の AAAA レコードを取得)
% ./resolver-1.pl ns.jp.freebsd.org jp.freebsd.org mx
   (jp.freebsd.org の MX レコードを取得)
% ./resolver-1.pl ns.jp.freebsd.org 132.121.139.203.in-addr.arpa ptr
   (203.139.121.132 の逆引きを行う)
% ./resolver-1.pl ns.jp.freebsd.org www.jp.freebsd.org any
   (www.jp.freebsd.org ならなんでも取得)

結果は以下のようになります。

% ./resolver-1.pl ns.jp.freebsd.org www.jp.freebsd.org
識別子(Id): 0x0000
フラグ: 0x8580
    QR (Query/Response): 1 (応答)
    OPCODE: 0 (標準照会)
    AA (Authoritative Answer): 1 (権威のある回答)
    TC (TrunCation): 0 (非分割)
    RD (Recursion Desired): 1 (再帰要求)
    RA (Recursion Available): 1 (再帰不可能)
    RCODE (Response code): 0 (エラーなし)
質問数: 1
回答数: 1
権威数: 3
追加情報数: 2
=========================================
質問: ドメイン名: www.jp.freebsd.org
質問: タイプ: 1 (A)
質問: クラス: 1 (INTERNET)
=========================================
回答(1): ドメイン名: www.jp.freebsd.org
回答(1): タイプ: 1 (A)
回答(1): クラス: 1 (INTERNET)
回答(1): 生存時間(TTL): 3600 (秒)
回答(1): リソースデータ長: 4 (バイト)
回答(1): リソースデータ: 203.139.121.132
=========================================
権威(1): ドメイン名: jp.freebsd.org
権威(1): タイプ: 2 (NS)
権威(1): クラス: 1 (INTERNET)
権威(1): 生存時間(TTL): 3600 (秒)
権威(1): リソースデータ長: 17 (バイト)
権威(1): リソースデータ: ns2.spnet.ne.jp
=========================================
権威(2): ドメイン名: jp.freebsd.org
権威(2): タイプ: 2 (NS)
権威(2): クラス: 1 (INTERNET)
権威(2): 生存時間(TTL): 3600 (秒)
権威(2): リソースデータ長: 9 (バイト)
権威(2): リソースデータ: castle.jp.freebsd.org
=========================================
権威(3): ドメイン名: jp.freebsd.org
権威(3): タイプ: 2 (NS)
権威(3): クラス: 1 (INTERNET)
権威(3): 生存時間(TTL): 3600 (秒)
権威(3): リソースデータ長: 15 (バイト)
権威(3): リソースデータ: ns.isoternet.org
=========================================
追加情報(1): ドメイン名: castle.jp.freebsd.org
追加情報(1): タイプ: 1 (A)
追加情報(1): クラス: 1 (INTERNET)
追加情報(1): 生存時間(TTL): 3600 (秒)
追加情報(1): リソースデータ長: 4 (バイト)
追加情報(1): リソースデータ: 210.226.20.15
=========================================
追加情報(2): ドメイン名: castle.jp.freebsd.org
追加情報(2): タイプ: 28 (AAAA)
追加情報(2): クラス: 1 (INTERNET)
追加情報(2): 生存時間(TTL): 3600 (秒)
追加情報(2): リソースデータ長: 16 (バイト)
追加情報(2): リソースデータ: 2001:218:422:1::15
=========================================

定数管理

DNS はそれなりに複雑なので、定数管理をしっかりすることにしましょう。

resolver-1.pl

    1: #!/usr/local/bin/perl -w
    2: 
    3: # $Id: resolver-1.pl,v 1.2 2003/10/04 15:23:24 68user Exp $
    4: 
    5: #-------------------------------------------------------------
    6: package QR;
    7: 
    8: sub Query    { 0 }
    9: sub Response { 1 }
   10: 
   11: my %qr_table = (0 => '質問',
   12:                 1 => '応答'
   13:                 );
   14: 
   15: sub getName {
   16:     my ($code) = @_;
   17:     defined $qr_table{$code} ? $qr_table{$code} : '??';
   18: }

package QR というパッケージを宣言し、その中で Query、Response という関数を定義します。これで

QR::Query は 1
QR::Response は 2

という定数 (のようなもの) になります。

また、DNS サーバから渡された QR の値が 0 ならば「質問」、1 ならば「応答」と表示するため、 QR::getName というメソッドを作ります。

QR::getName(0) は '質問' を返す
QR::getName(1) は '応答' を返す
QR::getName(2) は '??' を返す (0 と 1 以外は全て ?? を返す)

perl における定数管理についてはかなり試行錯誤してきました。 C だとやり方が一つしかありませんが、perl はいろいろ方法があるので悩みます。

例えば $QR::Query というふうに変数を使う方法もあります。メリットは print "...$QR::Query.." などと変数展開が楽なこと。デメリットは、package QR 内で my $Query などと my 宣言できないこと。また、定数でありながら書き換えが可能なこと。

sub Query { 0 } のような関数にする方法は use strict 宣言が可能です。また、メリットとして QR::Query と書くべきところを、間違えて QR::Queru と書いてしまったら、 (use strict していれば) perl がスクリプト parse 時にはじいてくれます。これは大きなメリットです。しかし、デメリットもあります。

sub Query    { 0 }
sub Response { 1 }
my %qr_table = (0 => '質問', 1 => '応答');

それは定数を二重管理していること。定数が追加・変更・削除された場合、絶対に忘れずに両方とも書き換えられるでしょうか? (そんなの不可能に決まっています)

一元管理したいなら、値→名前、名前→値のいずれも全て関数化して、同じテーブルを見にいくようにすればいいです。

my %qr_code2name = (0 => '質問', 1 => '応答');
my %qr_name2code;
foreach my $code (keys %qr_code2name){
    my ($name) = $qr_code2name{$code};
    $qr_name2coode{$name} = $code;
}
sub getName { return $qr_table{$_[0]} }
sub getCode { return $qr_name2code{$_[0]} }

つまり QR::getName(0)、QR::getCode('応答') というふうに使うわけです。このやり方で恐いのはタイプミスで、 QR::getCode('応答') を QR::getCode('回答') と書き間違ったところで、undef が返ってくるだけです。これでは定数に関わる部分すべてにおいてエラーチェックをしなければいけないわけですが、それは現実的ではありません。

タイプミス対策として、

sub getName {
    if ( defined $qr_table{$_[0]} ){
        return $qr_table{$_[0]};
    } else {
        die "$_[0] は不正です";
    }
}

などと、不正な名前や値が渡されたら die する手もあります。これが一番の欠点は、どこで不正な名前や値が使用されたのかわからないこと。数千〜数万行をしらみつぶしにチェックしなければいけません。この解決策としては、Carp モジュールを使う手があります。

use Carp;
sub getName {
    if ( defined $qr_table{$_[0]} ){
        return $qr_table{$_[0]};
    } else {
        croak "$_[0] は不正です";
    }
}

これなら、getName を呼び出したパッケージ名や行数までわかります。 croak ではなく confess を使えば、関数をどんどんさかのぼっていくスタックトレースのような表示もできます。

しかし、DNS サーバから知らない値が送られてきたら die してしまうようでは、まともな DNS クライアントとは言えません。そしてなによりも、これらの定数を一元管理する方法は、すべて実行時にならないとエラーを捕捉できません。

QR::Query の関数を使うやり方には、依然として「スクリプト parse 時にエラーがわかる」というアドバンテージが存在します。これが今回関数方式を採用した理由です。

てゆーか、なんかいい方法があったら教えてください。

脱線おしまい。

これと同様に、package OPCODE・AA・TC・RD・RA・RCODE を実装します。

   21: package OPCODE;
   22: 
   23: sub StandardQuery       { 0 };
   24: sub InverseQuery        { 1 };
   25: sub ServerStatusRequest { 2 };
   26: 
   27: my %opcode_table = (0 => '標準照会',
   28:                     1 => '逆照会',
   29:                     2 => 'サーバステータス照会',
   30:                     );
   31: 
   32: sub getName {
   33:     my ($code) = @_;
   34:     defined $opcode_table{$code} ? $opcode_table{$code} : '??';
   35: }
   36: 
   37: #-------------------------------------------------------------
   38: package AA;
   39: 
   40: my %aa_table = (0 => '権威のない回答',
   41:                 1 => '権威のある回答',
   42:                 );
   43: 
   44: sub getName {
   45:     my ($code) = @_;
   46:     defined $aa_table{$code} ? $aa_table{$code} : '??';
   47: }
   48: 
   49: #-------------------------------------------------------------
   50: package TC;
   51: 
   52: sub NotTruncated { 0 }
   53: sub Truncated    { 1 }
   54: 
   55: my %tc_table = (0 => '非分割',
   56:                 1 => '分割',
   57:                 );
   58: 
   59: sub getName {
   60:     my ($code) = @_;
   61:     defined $tc_table{$code} ? $tc_table{$code} : '??';
   62: }
   63: 
   64: #-------------------------------------------------------------
   65: package RD;
   66: 
   67: sub RecursionNotDesire { 0 }
   68: sub RecursionDesire    { 1 }
   69: 
   70: my %rd_table = (0 => '非再帰要求',
   71:                 1 => '再帰要求',
   72:                 );
   73: 
   74: sub getName {
   75:     my ($code) = @_;
   76:     defined $rd_table{$code} ? $rd_table{$code} : '??';
   77: }
   78: 
   79: 
   80: #-------------------------------------------------------------
   81: package RA;
   82: 
   83: my %ra_table = (0 => '再帰可能',
   84:                 1 => '再帰不可能',
   85: );
   86: 
   87: sub getName {
   88:     my ($code) = @_;
   89:     defined $ra_table{$code} ? $ra_table{$code} : '??';
   90: }
   91: 
   92: #-------------------------------------------------------------
   93: package RCODE;
   94: 
   95: my %rcode_table = (0 => 'エラーなし',
   96:                    1 => 'フォーマットエラー',
   97:                    2 => 'サーバ側エラー',
   98:                    3 => 'ネームエラー',
   99:                    4 => '未実装',
  100:                    5 => '拒否',
  101: );
  102: 
  103: sub getName {
  104:     my ($code) = @_;
  105:     defined $rcode_table{$code} ? $rcode_table{$code} : "??";
  106: }

次に、package TYPE です。

  109: package TYPE;
  110: 
  111: sub A     { 1  }
  112: sub NS    { 2  }
  113: sub CNAME { 5  }
  114: sub SOA   { 6  }
  115: sub MB    { 7  }
  116: sub MG    { 8  }
  117: sub MR    { 9  }
  118: sub NULL  { 10 }
  119: sub WKS   { 11 }
  120: sub PTR   { 12 }
  121: sub HINFO { 13 }
  122: sub MINFO { 14 }
  123: sub MX    { 15 }
  124: sub TXT   { 16 }
  125: sub AAAA  { 28 }
  126: sub ANY   { 255 }
  127: 
  128: my %type_table = (1   => 'A',
  129:                   2   => 'NS',
  130:                   5   => 'CNAME',
  131:                   6   => 'SOA',
  132:                   7   => 'MB',
  133:                   8   => 'MG',
  134:                   9   => 'MR',
  135:                   10  => 'NULL',
  136:                   11  => 'WKS',
  137:                   12  => 'PTR',
  138:                   13  => 'HINFO',
  139:                   14  => 'MINFO',
  140:                   15  => 'MX',
  141:                   16  => 'TXT',
  142:                   28  => 'AAAA',
  143:                   255 => 'ANY',
  144:                   );
  145: 
  146: my %type_code2name;
  147: my %type_name2code;
  148: foreach my $code (keys %type_table){
  149:     my ($name) = $type_table{$code};
  150:     $type_code2name{$code} = $name;
  151:     $type_name2code{$name} = $code;
  152: }
  153: 
  154: sub getName {
  155:     my ($code) = @_;
  156:     return $type_code2name{$code};
  157: }
  158: 
  159: sub getCode {
  160:     my ($name) = @_;
  161:     $name =~ tr/a-z/A-Z/;
  162:     return $type_name2code{$name};
  163: }

基本的には package QR などと同じ構成ですが、それに加えて TYPE::getCode というメソッドを持ちます。これは、引数で指定した照会タイプを数値に変換するもので、

TYPE::getCode('A') は 1 を返す
TYPE::getCode('CNAME') は 5 を返す

というような機能を持ちます。

package TYPE と同様の機能を持つ、package CLASS は以下の通りです。

  167: package CLASS;
  168: 
  169: sub Internet { 1 }
  170: sub CSNET    { 2 }
  171: sub CHAOS    { 3 }
  172: sub Hesiod   { 4 }
  173: sub Any      { 5 }
  174: 
  175: my %class_table = (1 => 'INTERNET',
  176:                    2 => 'CSNET',
  177:                    3 => 'CHAOS',
  178:                    4 => 'HESIOD',
  179:                    5 => 'ANY',
  180:                    );
  181: 
  182: my %class_name2code;
  183: foreach my $code (keys %class_table){
  184:     my ($name) = $class_table{$code};
  185:     $class_name2code{$name} = $code;
  186: }
  187: 
  188: sub getName {
  189:     my ($code) = @_;
  190:     return $class_table{$code};
  191: }
  192: 
  193: sub getCode {
  194:     my ($name) = @_;
  195:     $name =~ tr/a-z/A-Z/;
  196:     return $class_name2code{$name};
  197: }

main 部分

次に package main です。

  203: package main;
  204: 
  205: use strict;
  206: use Socket;
  207: 
  208: if ( @ARGV < 2 || 4 < @ARGV ){
  209:     print "お手製リゾルバ\n";
  210:     print "書式: DNSサーバ名 名前解決ホスト名 [照会タイプ] [照会クラス]\n";
  211:     print "    照会タイプ: A, NS, CNAME, MX, TXT, AAAA など。省略時は A。\n";
  212:     print "    照会クラス: Internet, CHAOS など。省略時は Internet。\n";
  213:     exit;
  214: }
  215: 
  216:                 # 接続先ホスト名を取得
  217: my $dns_host = shift @ARGV;
  218: 
  219:                 # 名前解決を行うホスト名を取得
  220: my $query_host = shift @ARGV;
  221: 
  222: my $type_arg  = shift @ARGV || 'A';
  223: my $class_arg = shift @ARGV || 'INTERNET';
  224: 
  225: my $type  = TYPE::getCode($type_arg);
  226: if ( ! defined $type ){
  227:     print "タイプ $type_arg は不正です。\n";
  228:     exit 1;
  229: }
  230: my $class = CLASS::getCode($class_arg);
  231: if ( ! defined $class ){
  232:     print "クラス $class_arg は不正です。\n";
  233:     exit 1;
  234: }

以下のように引数解析を行います。

第一引数は、DNS サーバの IP アドレスまたはホスト名
第二引数は、名前解決を行いたいホスト名または IP アドレス
第三引数は、照会タイプ。省略時は A。
第四引数は、照会クラス。省略時は Internet。

照会タイプや照会クラスで不正な文字列が渡された場合は、エラーを表示して終了します。

  236:                 # 接続先ポート番号を取得
  237: my $dns_port =  getservbyname('domain', 'udp') || 53;
  238: 
  239:                 # ホスト名を、IP アドレスの構造体に変換
  240: my $iaddr = inet_aton($dns_host)
  241:         or die "$dns_host は存在しないホストです。\n";
  242: 
  243:                 # ポート番号と IP アドレスを構造体に変換
  244: my $sock_addr = pack_sockaddr_in($dns_port, $iaddr);
  245: 
  246:                 # ソケット生成
  247: socket(SOCKET, PF_INET, SOCK_DGRAM, 0)
  248:         or die "ソケットを生成できません。$!";
  249: 
  250: my $query = make_query($type, $class);

getservbyname で /etc/services から UDP の domain に対応するポート番号を取得します。期待している値は 53 ですが、もし何らかの理由で取得に失敗した場合は、53 を決め打ちします。
inet_aton で DNS サーバの IP アドレスを取得します。第一引数で DNS サーバの (IP アドレスでなく) 名前を指定した場合は、ここで OS 標準リゾルバを使った名前解決が行われます。別にそれはそれで構わないのですが、このプログラムを動かしながらパケットキャプチャする場合は DNS サーバとの通信が 2回行われてしまい混乱してしまうのでしょうから、第一引数には DNS サーバの (名前でなく) IP アドレスを指定した方がよいでしょう。
pack_sockaddr_in でポート番号と IP アドレスを構造体に変換します。
socket でソケットを生成します。UDP なので SOCK_DGRAM を指定します。
make_query で、DNS サーバに送信するデータを生成します。

送信データ生成部分

make_query は、DNS サーバに送信する質問データを生成します。

  268: sub make_query {
  269:     my ($type, $class) = @_;
  270: 
  271:     # 識別子設定
  272:     my $id = pack('B16', '0000000000000000');
  273: 
  274:     # フラグを構成する各要素を設定
  275:     my $qr     = QR::Query;             # 0:質問
  276:     my $opcode = OPCODE::StandardQuery; # 0:標準照会
  277:     my $aa     = 0;                     # Authoritative Answer (応答時にセット)
  278:     my $tc     = TC::NotTruncated;      # 0:非分割
  279:     my $rd     = RD::RecursionDesire;   # 1:再帰照会
  280:     my $ra     = 0;                     # Recursion Available (応答時にセット)
  281:     my $rcode  = 0;                     # Response Code (応答時にセット)
  282: 
  283:     # フラグ (0 と 1 の文字列)
  284:     my $flg_binary = sprintf("%d%04d%d%d%d%d%03d%d",
  285:                              $qr,
  286:                              $opcode,
  287:                              $aa,
  288:                              $tc,
  289:                              $rd,
  290:                              $ra,
  291:                              0,
  292:                              $rcode);
  293: 
  294:     # フラグ (2バイトのバイナリ)
  295:     my $flg = pack("B16", $flg_binary);

引数にタイプ (A・NS・CNAME・PTR など) とクラス (Internet・CHAOS など) を受け取ります。

そして、フラグを作成します。クライアント側でセットする必要のない部分は 0 にセットしておきます。ビット単位で操作する場合は、まず 0 と 1 からなる文字列を作って、 pack('B16', 文字列) としています。

  297:     # 質問数のみ 1。回答数、権威数、追加情報数はいずれも 0。
  298:     my $question_count = pack('n', 1);
  299:     my $response_count  = pack('n', 0);
  300:     my $auth_count = pack('n', 0);
  301:     my $ext_count = pack('n', 0);
  302: 
  303:     # foo.example.com というホスト名を 3foo7example3com という形に変換。
  304:     my $query_name = &make_domain($query_host);
  305: 
  306:     # 照会タイプ・照会クラスを設定
  307:     my $query_type  = pack('n', $type);
  308:     my $query_class = pack('n', $class);
  309: 
  310:     # 質問は「照会名+照会タイプ+照会クラス」からなる。
  311:     my $question = $query_name.$query_type.$query_class;
  312: 
  313:     # リクエストは「識別子+フラグ+質問数+回答数+権威数+追加情報数+質問」からなる。
  314:     my $request = $id.$flg.$question_count.$response_count.$auth_count.$ext_count.$question;
  315: 
  316:     return $request;
  317: }

質問数を 1、回答数を 0、権威数を 0、追加情報数を 0 にセットします。それぞれ pack('n', 数) で 16bit のネットワークバイトオーダの数値に変換しています。
ホスト名を make_domain 関数でホスト名を www.example.com → 3www7example3com という形に変換します。
引数で受け取った照会タイプ・照会クラスを 16bit ネットワークバイトオーダに変換します。
最後にぜーんぶくっつけておしまいです。作ったリクエストデータを return で返します。

  463: sub make_domain {
  464:     my ($org_host) = @_;
  465:     my $host = '';
  466:     foreach ( split(/\./, $org_host) ){
  467:         $host .= pack('C', length($_)) . $_;
  468:     }
  469:     $host .= pack('C', 0);
  470:     return $host;
  471: }

ドメイン部を作成する関数です。 foo.example.com をドットで分割することで ('foo', 'example', 'com') という配列になります。そして、それぞれの要素について「要素の長さ(を 8bit 数値にしたもの)＋要素」を求め、$host に追加していきます。最後に終端を示す 0 (を 8bit 数値にしたもの) を追加しておしまいです。

再び main 部分

  250: my $query = make_query($type, $class);
  251: 
  252: if ( ! send(SOCKET, $query, 0, $sock_addr) ){
  253:     die "send に失敗しました $!";
  254: }
  255: 
  256: my $rcv_data;
  257: recv(SOCKET, $rcv_data, 10000, 0) || die "$!";
  258: 
  259: parse_response($rcv_data);
  260: 
  261: exit 0;

make_query 関数で作成したデータを、send で DNS サーバに送ります。
recv で DNS サーバからの応答を受け取ります。。
parse_response 関数で DNS サーバから受け取った UDP データグラムを解析します。

受信データ解析部分

  325: sub parse_response {
  326:     my ($org_dgram) = @_;
  327: 
  328:     my $hr_line = "=========================================\n";
  329: 
  330:     # 識別子・フラグ・質問数・回答数・権威数・追加情報数を表示
  331: 
  332:     my ($id, $flg, $question_count, $response_count, $auth_count, $ext_count, $rest)
  333:       = unpack('nnnnnna*', $org_dgram);
  334: 
  335:     # フラグを各ビットに分解
  336:     my $qr     = ($flg >>15) & 0x01; # 最上位  1ビット目から 1ビット取得
  337:     my $opcode = ($flg >>11) & 0x07; # 最上位  2ビット目から 3ビット取得
  338:     my $aa     = ($flg >>10) & 0x01; # 最上位  5ビット目から 1ビット取得
  339:     my $tc     = ($flg >> 9) & 0x01; # 最上位  6ビット目から 1ビット取得
  340:     my $rd     = ($flg >> 8) & 0x01; # 最上位  7ビット目から 1ビット取得
  341:     my $ra     = ($flg >> 7) & 0x01; # 最上位  8ビット目から 1ビット取得
  342:     my $rcode  =  $flg       & 0x0f; # 最上位 12ビット目から 4ビット取得

DNS サーバから受信したデータの先頭部分を、識別子・フラグ・質問数・回答数・権威数・追加情報数に分けます (いずれも2バイト)。残りの部分は $rest に代入します。

そしてフラグを分解して、各ビットを取得します。

  344:     printf "識別子(Id): 0x%04lx\n", $id;
  345:     printf "フラグ: 0x%04lx\n", $flg;
  346:     printf "    QR (Query/Response): %s (%s)\n", $qr, QR::getName($qr);
  347:     printf "    OPCODE: %s (%s)\n", $opcode, OPCODE::getName($opcode);
  348:     printf "    AA (Authoritative Answer): %s (%s)\n", $aa, AA::getName($aa);
  349:     printf "    TC (TrunCation): %s (%s)\n", $tc, TC::getName($tc);
  350:     printf "    RD (Recursion Desired): %s (%s)\n", $rd, RD::getName($rd);
  351:     printf "    RA (Recursion Available): %s (%s)\n", $ra, RA::getName($ra);
  352:     printf "    RCODE (Response code): %s (%s)\n", $rcode, RCODE::getName($rcode);
  353:     printf "質問数: $question_count\n";
  354:     printf "回答数: $response_count\n";
  355:     printf "権威数: $auth_count\n";
  356:     printf "追加情報数: $ext_count\n";
  357:     print $hr_line;

そして識別子、フラグなどを表示します。ここで楽するためにわざわざいくつも package を作ったわけです。

ここから $rest を先頭から順に解析します。

  361:     foreach my $count ($question_count){
  362:         my $domain;
  363:         ($domain, $rest) = get_domain($rest, $org_dgram);
  364:         my ($type, $class) = unpack('nn', $rest);
  365:         substr($rest, 0, 4) = '';
  366: 
  367:         printf "質問: ドメイン名: %s\n", $domain;
  368:         printf "質問: タイプ: %d (%s)\n", $type, TYPE::getName($type);
  369:         printf "質問: クラス: %d (%s)\n", $class, CLASS::getName($class);
  370:         print $hr_line;
  371:     }

質問数の数だけループをまわし、先頭から順にドメイン・タイプ・クラスを取得します。

  363:         ($domain, $rest) = get_domain($rest, $org_dgram);

get_domain の第一引数 $rest は DNS サーバから取得した未解析のデータ、第二引数 $org_dgram は DNS サーバから取得したデータ全体です。

get_domain は $rest を受け取り、戻り値で先頭のドメイン部分を削ったものを返します。つまり get_domain を呼ぶたびに $rest のサイズはどんどん減っていきます。

一方、$org_dgram はこのプログラムの実行中に内容は変化しません。メッセージ圧縮に対応するため、既に解析を終えた部分も保存しておかなければならないからです。

  364:         my ($type, $class) = unpack('nn', $rest);
  365:         substr($rest, 0, 4) = '';

次にタイプとクラスを取り出し、取り出した合計 4バイトを $rest の先頭から削ります。ここから先は、unpack してその部分を substr で削る、という処理は何度も出てきます。

  373:     my @rrs = (
  374:                ['回答', $response_count],
  375:                ['権威', $auth_count],
  376:                ['追加情報', $ext_count],
  377:               );
  378: 
  379:     foreach my $ref_array (@rrs){
  380:         my ($desc, $count) = @$ref_array;
  381: 
  382:         foreach (1 .. $count){
  383:             my $domain;
  384: 
  385:             ($domain, $rest) = get_domain($rest, $org_dgram);
  386:             my ($type, $class, $ttl, $rdata_length) = unpack('nnNn', $rest);
  387:             substr($rest, 0, 10) = '';
  388: 
  389:             printf "$desc($_): ドメイン名: %s\n", $domain;
  390:             printf "$desc($_): タイプ: %d (%s)\n", $type, TYPE::getName($type);
  391:             printf "$desc($_): クラス: %d (%s)\n", $class, CLASS::getName($class);
  392:             printf "$desc($_): 生存時間(TTL): $ttl (秒)\n";
  393:             printf "$desc($_): リソースデータ長: $rdata_length (バイト)\n";
  394:         
  395:             # リソースデータ取得
  396:             my ($rdata) = substr($rest, 0, $rdata_length);
  397:             substr($rest, 0, $rdata_length) = '';

回答・権威・追加情報を、先に取得した回答数・権威数・追加情報数の数だけ解析します。

  386:             my ($type, $class, $ttl, $rdata_length) = unpack('nnNn', $rest);
  387:             substr($rest, 0, 10) = '';

これはタイプ (2バイト)・クラス (2バイト)・生存時間 (4バイト)・リソースデータ長 (2バイト) を取得し、取得した合計 10 バイトを $rest の先頭から削っている部分です。

  396:             my ($rdata) = substr($rest, 0, $rdata_length);
  397:             substr($rest, 0, $rdata_length) = '';

最後にリソースデータ長の分だけリソースデータを取得し、取得した部分を $rest から削ります。

  401:             my $rdata_for_print;
  402: 
  403:             if ( $type == TYPE::A ){
  404:                 # A レコード (IPv4 用 IP アドレス)
  405:                 $rdata_for_print = inet_ntoa($rdata);
  406: 
  407:             } elsif ( $type == TYPE::AAAA ){
  408:                 # AAAA レコード (IPv6 用 IP アドレス)
  409:                 my @couple_of_bytes = map { $_ = sprintf("%02lX", unpack('C', $_)) } split(//, $rdata);
  410:                 my @hexs;
  411:                 while (@couple_of_bytes>0){
  412:                     push(@hexs, "$couple_of_bytes[0]$couple_of_bytes[1]");
  413:                     shift @couple_of_bytes;
  414:                     shift @couple_of_bytes;
  415:                 }
  416:                 $rdata_for_print = join(':', @hexs);
  417:                 $rdata_for_print =~ s/0000:/:/g;
  418:                 $rdata_for_print =~ s/:::+/::/g;
  419:                 $rdata_for_print =~ s/:0+([1-9A-F])/:$1/g;
  420: 
  421:             } elsif ( $type == TYPE::MX ){
  422:                 # MX レコード
  423:                 my ($preference, $mx) = unpack('na*', $rdata);
  424:                 my ($mx_domain) = get_domain($mx, $org_dgram);
  425:                 $rdata_for_print = "Preference: $preference  MX: $mx_domain";
  426: 
  427:             } elsif ( $type == TYPE::NS ){
  428:                 # 権威あるネームサーバ
  429:                 my ($ns_domain) = get_domain($rdata, $org_dgram);
  430:                 $rdata_for_print = $ns_domain;
  431: 
  432:             } elsif ( $type == TYPE::PTR ){
  433:                 # 逆引き
  434:                 my ($ptr_domain) = get_domain($rdata, $org_dgram);
  435:                 $rdata_for_print = $ptr_domain;
  436: 
  437:             } elsif ( $type == TYPE::CNAME ){
  438:                 # 別名
  439:                 my ($cname_domain) = get_domain($rdata, $org_dgram);
  440:                 $rdata_for_print = $cname_domain;
  441: 
  442:             } elsif ( $type == TYPE::TXT ){
  443:                 # テキスト
  444:                 $rdata_for_print = $rdata;
  445: 
  446:             } else {
  447:                 $rdata_for_print = 'このタイプのリソース解析は未実装です';
  448:             }
  449: 
  450:             printf "$desc($_): リソースデータ: %s\n", $rdata_for_print;

リソースデータ $rdata のデータ形式は、タイプによって異なりますので、タイプに応じて解析方法を変えます。最終目的は、表示用変数 $rdata_for_print に適切な文字列をセットすることです。

  403:             if ( $type == TYPE::A ){
  404:                 # A レコード (IPv4 用 IP アドレス)
  405:                 $rdata_for_print = inet_ntoa($rdata);

タイプが A なら、inet_ntoa で IP アドレスを取得します。

  407:             } elsif ( $type == TYPE::AAAA ){
  408:                 # AAAA レコード (IPv6 用 IP アドレス)
  409:                 my @couple_of_bytes = map { $_ = sprintf("%02lX", unpack('C', $_)) } split(//, $rdata);
  410:                 my @hexs;
  411:                 while (@couple_of_bytes>0){
  412:                     push(@hexs, "$couple_of_bytes[0]$couple_of_bytes[1]");
  413:                     shift @couple_of_bytes;
  414:                     shift @couple_of_bytes;
  415:                 }
  416:                 $rdata_for_print = join(':', @hexs);
  417:                 $rdata_for_print =~ s/0000:/:/g;
  418:                 $rdata_for_print =~ s/:::+/::/g;
  419:                 $rdata_for_print =~ s/:0+([1-9A-F])/:$1/g;

タイプが AAAA なら、IPv6 アドレスを取得します。 $rdata_for_print には 3FFE:501:185B:101:2A0:24FF:FE57:E561 や 2001:218:422:1::15 などの文字列が入ります。

ここでは愚かにも自前で解析を行っていますが、本来は Socket6 モジュールを使うべきところでしょう。ただ、別途インストールが必要なので今回は自作することにしました。

  421:             } elsif ( $type == TYPE::MX ){
  422:                 # MX レコード
  423:                 my ($preference, $mx) = unpack('na*', $rdata);
  424:                 my ($mx_domain) = get_domain($mx, $org_dgram);
  425:                 $rdata_for_print = "Preference: $preference  MX: $mx_domain";

タイプが MX なら、先頭 2バイトを優先度 (preference)、残りをドメインとして解析します。

  427:             } elsif ( $type == TYPE::NS ){
  428:                 # 権威あるネームサーバ
  429:                 my ($ns_domain) = get_domain($rdata, $org_dgram);
  430:                 $rdata_for_print = $ns_domain;
  431: 
  432:             } elsif ( $type == TYPE::PTR ){
  433:                 # 逆引き
  434:                 my ($ptr_domain) = get_domain($rdata, $org_dgram);
  435:                 $rdata_for_print = $ptr_domain;
  436: 
  437:             } elsif ( $type == TYPE::CNAME ){
  438:                 # 別名
  439:                 my ($cname_domain) = get_domain($rdata, $org_dgram);
  440:                 $rdata_for_print = $cname_domain;

タイプが NS・CNAMR・PTR なら、いずれもドメイン名が入っています。

  442:             } elsif ( $type == TYPE::TXT ){
  443:                 # テキスト
  444:                 $rdata_for_print = $rdata;

タイプが TXT なら、そのまま表示します。

これは多分間違い。

% ./resolver-1.pl www.jp.freebsd.org version.bind txt chaos

とすると、リソースデータは「&Sorry, no version string is available」と表示されるが、 dig や nslookup は「Sorry, no version string is available」となります (& がない)。

先頭の & を削るような規則があるようだが、それが何なのかはわからなかった。

それ以外のタイプ、たとえば SOA や HINFO の場合は、

  446:             } else {
  447:                 $rdata_for_print = 'このタイプのリソース解析は未実装です';
  448:             }

となります。

ドメイン解析部分

  486: sub get_domain {
  487:     my ($data, $org_data) = @_;
  488:     my @domains = ();
  489: 
  490:     while (1){
  491:         my $len = unpack('C', $data);
  492: 
  493:         if ( ( $len & 0xc0 ) ==  0xc0 ){
  494:             # 上位 2ビットが立っていたら、もう 1バイト読みこむ (合計 16ビット)。
  495:             # そして上位 2ビットを落とし、残り 14ビットを DNS サーバから
  496:             # 返された UDP データグラム先頭からのオフセットとして再帰する。
  497: 
  498:             my $offset = unpack('n', $data) ^ 0xc000;
  499:             my $new_data = substr($org_data, $offset);
  500:             substr($data, 0, 2) = '';
  501: 
  502:             my ($domain_part)  = get_domain($new_data, $org_data);
  503:             push(@domains, $domain_part);
  504:             last;
  505: 
  506:         } else {
  507:             # 上位 2ビットが立っていないので、カウンタとして扱う。
  508:             substr($data, 0, 1) = '';
  509:         }
  510: 
  511:         if ( $len == 0 ){
  512:             last;
  513:         } else {
  514:             push(@domains, unpack("a$len", $data));
  515:             substr($data, 0, $len) = '';
  516:         }
  517:     }
  518: 
  519:     # この時点で @domains = ('foo', 'example', 'com') のようになっている。
  520:     my $ret_domain = join('.', @domains);
  521:     return ($ret_domain, $data);
  522: }

まず 1バイトのカウンタを取得し、上位 2ビットが立っていたらポインタ (＝圧縮されている) と解釈し、ポインタが指す領域を解析するため再帰します。上位 2ビットが立っていなかったら、通常のカウンタとして扱います。

感想

これで DNS クライアントの解説はおわりです。

やはり perl でバイナリデータを扱うのは面倒ですね。pack だの unpack だの、非常にうっとおしい。

そしてなりよりプロトコルがバイナリだと、デバッグするのも一苦労です。非公開のプロトコル (ICQ とか) をキャプチャして解析する人がいるけど、信じられませんな。

前へ << DNS クライアントを作ってみよう (2)

低水準ファイル入出力関数を使おう >> 次へ

TOP >> ネットワークプログラミングの基礎知識 >> DNS クライアントを作ってみよう (3)

ご意見・ご指摘は Twitter: @68user までお願いします。