前へ << DNS クライアントを作ってみよう (2) | 低水準ファイル入出力関数を使おう >> 次へ |
今回作成するプログラムのインタフェースは以下の通りです。
% ./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 =========================================
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 という関数を定義します。 これで
また、DNS サーバから渡された QR の値が 0 ならば「質問」、1 ならば「応答」と表示するため、 QR::getName というメソッドを作ります。
例えば $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 というメソッドを持ちます。 これは、引数で指定した照会タイプを数値に変換するもので、
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: }
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: }以下のように引数解析を行います。
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);
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: }
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 数値にしたもの) を追加しておしまいです。
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;
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」となります (& がない)。
先頭の & を削るような規則があるようだが、それが何なのかはわからなかった。
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ビットが立っていなかったら、 通常のカウンタとして扱います。
やはり perl でバイナリデータを扱うのは面倒ですね。pack だの unpack だの、 非常にうっとおしい。
そしてなりよりプロトコルがバイナリだと、デバッグするのも一苦労です。 非公開のプロトコル (ICQ とか) をキャプチャして解析する人がいるけど、 信じられませんな。
前へ << DNS クライアントを作ってみよう (2) | 低水準ファイル入出力関数を使おう >> 次へ |
ご意見・ご指摘は Twitter: @68user までお願いします。