Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
#!/usr/local/bin/perl -w
# $Id: resolver-1.pl,v 1.2 2003/10/04 15:23:24 68user Exp $
#-------------------------------------------------------------
package QR;
sub Query { 0 }
sub Response { 1 }
my %qr_table = (0 => '質問',
1 => '応答'
);
sub getName {
my ($code) = @_;
defined $qr_table{$code} ? $qr_table{$code} : '??';
}
#-------------------------------------------------------------
package OPCODE;
sub StandardQuery { 0 };
sub InverseQuery { 1 };
sub ServerStatusRequest { 2 };
my %opcode_table = (0 => '標準照会',
1 => '逆照会',
2 => 'サーバステータス照会',
);
sub getName {
my ($code) = @_;
defined $opcode_table{$code} ? $opcode_table{$code} : '??';
}
#-------------------------------------------------------------
package AA;
my %aa_table = (0 => '権威のない回答',
1 => '権威のある回答',
);
sub getName {
my ($code) = @_;
defined $aa_table{$code} ? $aa_table{$code} : '??';
}
#-------------------------------------------------------------
package TC;
sub NotTruncated { 0 }
sub Truncated { 1 }
my %tc_table = (0 => '非分割',
1 => '分割',
);
sub getName {
my ($code) = @_;
defined $tc_table{$code} ? $tc_table{$code} : '??';
}
#-------------------------------------------------------------
package RD;
sub RecursionNotDesire { 0 }
sub RecursionDesire { 1 }
my %rd_table = (0 => '非再帰要求',
1 => '再帰要求',
);
sub getName {
my ($code) = @_;
defined $rd_table{$code} ? $rd_table{$code} : '??';
}
#-------------------------------------------------------------
package RA;
my %ra_table = (0 => '再帰可能',
1 => '再帰不可能',
);
sub getName {
my ($code) = @_;
defined $ra_table{$code} ? $ra_table{$code} : '??';
}
#-------------------------------------------------------------
package RCODE;
my %rcode_table = (0 => 'エラーなし',
1 => 'フォーマットエラー',
2 => 'サーバ側エラー',
3 => 'ネームエラー',
4 => '未実装',
5 => '拒否',
);
sub getName {
my ($code) = @_;
defined $rcode_table{$code} ? $rcode_table{$code} : "??";
}
#-------------------------------------------------------------
package TYPE;
sub A { 1 }
sub NS { 2 }
sub CNAME { 5 }
sub SOA { 6 }
sub MB { 7 }
sub MG { 8 }
sub MR { 9 }
sub NULL { 10 }
sub WKS { 11 }
sub PTR { 12 }
sub HINFO { 13 }
sub MINFO { 14 }
sub MX { 15 }
sub TXT { 16 }
sub AAAA { 28 }
sub ANY { 255 }
my %type_table = (1 => 'A',
2 => 'NS',
5 => 'CNAME',
6 => 'SOA',
7 => 'MB',
8 => 'MG',
9 => 'MR',
10 => 'NULL',
11 => 'WKS',
12 => 'PTR',
13 => 'HINFO',
14 => 'MINFO',
15 => 'MX',
16 => 'TXT',
28 => 'AAAA',
255 => 'ANY',
);
my %type_code2name;
my %type_name2code;
foreach my $code (keys %type_table){
my ($name) = $type_table{$code};
$type_code2name{$code} = $name;
$type_name2code{$name} = $code;
}
sub getName {
my ($code) = @_;
return $type_code2name{$code};
}
sub getCode {
my ($name) = @_;
$name =~ tr/a-z/A-Z/;
return $type_name2code{$name};
}
#-------------------------------------------------------------
package CLASS;
sub Internet { 1 }
sub CSNET { 2 }
sub CHAOS { 3 }
sub Hesiod { 4 }
sub Any { 5 }
my %class_table = (1 => 'INTERNET',
2 => 'CSNET',
3 => 'CHAOS',
4 => 'HESIOD',
5 => 'ANY',
);
my %class_name2code;
foreach my $code (keys %class_table){
my ($name) = $class_table{$code};
$class_name2code{$name} = $code;
}
sub getName {
my ($code) = @_;
return $class_table{$code};
}
sub getCode {
my ($name) = @_;
$name =~ tr/a-z/A-Z/;
return $class_name2code{$name};
}
#-------------------------------------------------------------
package main;
use strict;
use Socket;
if ( @ARGV < 2 || 4 < @ARGV ){
print "お手製リゾルバ\n";
print "書式: DNSサーバ名 名前解決ホスト名 [照会タイプ] [照会クラス]\n";
print " 照会タイプ: A, NS, CNAME, MX, TXT, AAAA など。省略時は A。\n";
print " 照会クラス: Internet, CHAOS など。省略時は Internet。\n";
exit;
}
# 接続先ホスト名を取得
my $dns_host = shift @ARGV;
# 名前解決を行うホスト名を取得
my $query_host = shift @ARGV;
my $type_arg = shift @ARGV || 'A';
my $class_arg = shift @ARGV || 'INTERNET';
my $type = TYPE::getCode($type_arg);
if ( ! defined $type ){
print "タイプ $type_arg は不正です。\n";
exit 1;
}
my $class = CLASS::getCode($class_arg);
if ( ! defined $class ){
print "クラス $class_arg は不正です。\n";
exit 1;
}
# 接続先ポート番号を取得
my $dns_port = getservbyname('domain', 'udp') || 53;
# ホスト名を、IP アドレスの構造体に変換
my $iaddr = inet_aton($dns_host)
or die "$dns_host は存在しないホストです。\n";
# ポート番号と IP アドレスを構造体に変換
my $sock_addr = pack_sockaddr_in($dns_port, $iaddr);
# ソケット生成
socket(SOCKET, PF_INET, SOCK_DGRAM, 0)
or die "ソケットを生成できません。$!";
my $query = make_query($type, $class);
if ( ! send(SOCKET, $query, 0, $sock_addr) ){
die "send に失敗しました $!";
}
my $rcv_data;
recv(SOCKET, $rcv_data, 10000, 0) || die "$!";
parse_response($rcv_data);
exit 0;
#-------------------------------------------------------------
# DNS サーバに送る query を作成し、返す。
sub make_query {
my ($type, $class) = @_;
# 識別子設定
my $id = pack('B16', '0000000000000000');
# フラグを構成する各要素を設定
my $qr = QR::Query; # 0:質問
my $opcode = OPCODE::StandardQuery; # 0:標準照会
my $aa = 0; # Authoritative Answer (応答時にセット)
my $tc = TC::NotTruncated; # 0:非分割
my $rd = RD::RecursionDesire; # 1:再帰照会
my $ra = 0; # Recursion Available (応答時にセット)
my $rcode = 0; # Response Code (応答時にセット)
# フラグ (0 と 1 の文字列)
my $flg_binary = sprintf("%d%04d%d%d%d%d%03d%d",
$qr,
$opcode,
$aa,
$tc,
$rd,
$ra,
0,
$rcode);
# フラグ (2バイトのバイナリ)
my $flg = pack("B16", $flg_binary);
# 質問数のみ 1。回答数、権威数、追加情報数はいずれも 0。
my $question_count = pack('n', 1);
my $response_count = pack('n', 0);
my $auth_count = pack('n', 0);
my $ext_count = pack('n', 0);
# foo.example.com というホスト名を 3foo7example3com という形に変換。
my $query_name = &make_domain($query_host);
# 照会タイプ・照会クラスを設定
my $query_type = pack('n', $type);
my $query_class = pack('n', $class);
# 質問は「照会名+照会タイプ+照会クラス」からなる。
my $question = $query_name.$query_type.$query_class;
# リクエストは「識別子+フラグ+質問数+回答数+権威数+追加情報数+質問」からなる。
my $request = $id.$flg.$question_count.$response_count.$auth_count.$ext_count.$question;
return $request;
}
#-------------------------------------------------------------
# DNS サーバから返されたデータを解析し、表示。
sub parse_response {
my ($org_dgram) = @_;
my $hr_line = "=========================================\n";
# 識別子・フラグ・質問数・回答数・権威数・追加情報数を表示
my ($id, $flg, $question_count, $response_count, $auth_count, $ext_count, $rest)
= unpack('nnnnnna*', $org_dgram);
# フラグを各ビットに分解
my $qr = ($flg >>15) & 0x01; # 最上位 1ビット目から 1ビット取得
my $opcode = ($flg >>11) & 0x07; # 最上位 2ビット目から 3ビット取得
my $aa = ($flg >>10) & 0x01; # 最上位 5ビット目から 1ビット取得
my $tc = ($flg >> 9) & 0x01; # 最上位 6ビット目から 1ビット取得
my $rd = ($flg >> 8) & 0x01; # 最上位 7ビット目から 1ビット取得
my $ra = ($flg >> 7) & 0x01; # 最上位 8ビット目から 1ビット取得
my $rcode = $flg & 0x0f; # 最上位 12ビット目から 4ビット取得
printf "識別子(Id): 0x%04lx\n", $id;
printf "フラグ: 0x%04lx\n", $flg;
printf " QR (Query/Response): %s (%s)\n", $qr, QR::getName($qr);
printf " OPCODE: %s (%s)\n", $opcode, OPCODE::getName($opcode);
printf " AA (Authoritative Answer): %s (%s)\n", $aa, AA::getName($aa);
printf " TC (TrunCation): %s (%s)\n", $tc, TC::getName($tc);
printf " RD (Recursion Desired): %s (%s)\n", $rd, RD::getName($rd);
printf " RA (Recursion Available): %s (%s)\n", $ra, RA::getName($ra);
printf " RCODE (Response code): %s (%s)\n", $rcode, RCODE::getName($rcode);
printf "質問数: $question_count\n";
printf "回答数: $response_count\n";
printf "権威数: $auth_count\n";
printf "追加情報数: $ext_count\n";
print $hr_line;
# 質問の数だけ質問を解析し、表示
foreach my $count ($question_count){
my $domain;
($domain, $rest) = get_domain($rest, $org_dgram);
my ($type, $class) = unpack('nn', $rest);
substr($rest, 0, 4) = '';
printf "質問: ドメイン名: %s\n", $domain;
printf "質問: タイプ: %d (%s)\n", $type, TYPE::getName($type);
printf "質問: クラス: %d (%s)\n", $class, CLASS::getName($class);
print $hr_line;
}
my @rrs = (
['回答', $response_count],
['権威', $auth_count],
['追加情報', $ext_count],
);
foreach my $ref_array (@rrs){
my ($desc, $count) = @$ref_array;
foreach (1 .. $count){
my $domain;
($domain, $rest) = get_domain($rest, $org_dgram);
my ($type, $class, $ttl, $rdata_length) = unpack('nnNn', $rest);
substr($rest, 0, 10) = '';
printf "$desc($_): ドメイン名: %s\n", $domain;
printf "$desc($_): タイプ: %d (%s)\n", $type, TYPE::getName($type);
printf "$desc($_): クラス: %d (%s)\n", $class, CLASS::getName($class);
printf "$desc($_): 生存時間(TTL): $ttl (秒)\n";
printf "$desc($_): リソースデータ長: $rdata_length (バイト)\n";
# リソースデータ取得
my ($rdata) = substr($rest, 0, $rdata_length);
substr($rest, 0, $rdata_length) = '';
# タイプに応じてリソースデータの解析方法を変える
my $rdata_for_print;
if ( $type == TYPE::A ){
# A レコード (IPv4 用 IP アドレス)
$rdata_for_print = inet_ntoa($rdata);
} elsif ( $type == TYPE::AAAA ){
# AAAA レコード (IPv6 用 IP アドレス)
my @couple_of_bytes = map { $_ = sprintf("%02lX", unpack('C', $_)) } split(//, $rdata);
my @hexs;
while (@couple_of_bytes>0){
push(@hexs, "$couple_of_bytes[0]$couple_of_bytes[1]");
shift @couple_of_bytes;
shift @couple_of_bytes;
}
$rdata_for_print = join(':', @hexs);
$rdata_for_print =~ s/0000:/:/g;
$rdata_for_print =~ s/:::+/::/g;
$rdata_for_print =~ s/:0+([1-9A-F])/:$1/g;
} elsif ( $type == TYPE::MX ){
# MX レコード
my ($preference, $mx) = unpack('na*', $rdata);
my ($mx_domain) = get_domain($mx, $org_dgram);
$rdata_for_print = "Preference: $preference MX: $mx_domain";
} elsif ( $type == TYPE::NS ){
# 権威あるネームサーバ
my ($ns_domain) = get_domain($rdata, $org_dgram);
$rdata_for_print = $ns_domain;
} elsif ( $type == TYPE::PTR ){
# 逆引き
my ($ptr_domain) = get_domain($rdata, $org_dgram);
$rdata_for_print = $ptr_domain;
} elsif ( $type == TYPE::CNAME ){
# 別名
my ($cname_domain) = get_domain($rdata, $org_dgram);
$rdata_for_print = $cname_domain;
} elsif ( $type == TYPE::TXT ){
# テキスト
$rdata_for_print = $rdata;
} else {
$rdata_for_print = 'このタイプのリソース解析は未実装です';
}
printf "$desc($_): リソースデータ: %s\n", $rdata_for_print;
print $hr_line;
}
}
}
#-------------------------------------------------------------
# foo.example.com のようなホスト名を 3foo7example3com0 という
# 形に変換し、返す。
sub make_domain {
my ($org_host) = @_;
my $host = '';
foreach ( split(/\./, $org_host) ){
$host .= pack('C', length($_)) . $_;
}
$host .= pack('C', 0);
return $host;
}
#-------------------------------------------------------------
# 3foo7example3com0 というようなデータを foo.example.com の
# ようなホスト名に変換し、返す。
#
# 引数 $data は 3foo7example3com0 というデータを指す。
# 引数 $org_data は DNS サーバから返された UDP データグラム全体。
#
# 戻り値は 2つ。
# 1. 解析したホスト名
# 2. $data から先頭の 3foo7example3com0 を取り除いた残りの部分
sub get_domain {
my ($data, $org_data) = @_;
my @domains = ();
while (1){
my $len = unpack('C', $data);
if ( ( $len & 0xc0 ) == 0xc0 ){
# 上位 2ビットが立っていたら、もう 1バイト読みこむ (合計 16ビット)。
# そして上位 2ビットを落とし、残り 14ビットを DNS サーバから
# 返された UDP データグラム先頭からのオフセットとして再帰する。
my $offset = unpack('n', $data) ^ 0xc000;
my $new_data = substr($org_data, $offset);
substr($data, 0, 2) = '';
my ($domain_part) = get_domain($new_data, $org_data);
push(@domains, $domain_part);
last;
} else {
# 上位 2ビットが立っていないので、カウンタとして扱う。
substr($data, 0, 1) = '';
}
if ( $len == 0 ){
last;
} else {
push(@domains, unpack("a$len", $data));
substr($data, 0, $len) = '';
}
}
# この時点で @domains = ('foo', 'example', 'com') のようになっている。
my $ret_domain = join('.', @domains);
return ($ret_domain, $data);
}