【求助】如何用Perl做一个DNS代理服务器 [已解决]

hhs66317

我的构想是这样的：
1、在本地用Perl模块 Net:NS::Nameserver 建立一个DNS服务器，监听本地TCP、UDP的53端口
2、接收到本地应用程序对DNS的UDP请求时，服务器通过 ReplyHandler => \&reply_handler 进行处理
3、在&reply_handler中，获取具体请求的 name 和 type
4、用Perl模块 Net:NS::Resolver 根据请求的 name 和 type 用TCP协议发送DNS请求到 8.8.8.8、8.8.4.4
5、得到正确的DNS相应后，将该相应用UDP协议发送给本地应用程序，从而完成DNS的代理

不知道我的想法是否正确，另外我在实际操作中遇到了问题，我不知道如何完成上述第五步

下面是一些零碎的代码，基础太差，没办法组装起来，请各位路过的perler指点斧正

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use warnings;
   
5. use Net::DNS::Nameserver;
   
6. 
   
7. my $ns = new Net::DNS::Nameserver(
   
8.     LocalAddr    => ['::1' , '127.0.0.1' ],
   
9.     LocalPort    => 53,
   
10.     ReplyHandler => \&reply_handler,
    
11.     Verbose      => 1,
    
12.     Truncate     => 0
    
13.     ) || die "couldn't create nameserver object\n";
    
14. 
    
15. $ns->main_loop;
    
16. 
    
17. sub reply_handler {
    
18.     my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
    
19.     ....
    
20. }
    

复制代码

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use warnings;
   
5. use Net::DNS;
   
6. 
   
7. my $res = Net::DNS::Resolver->new(
   
8.     nameservers => [qw(8.8.8.8 8.8.4.4)],
   
9.     usevc       => 1,
   
10. #    debug       => 1,
    
11. );
    
12. my $packet = $res->query('www.google.com','A');
    
13. 
    

复制代码

hhs66317

为什么这么多路过的神仙一句话也不说呢，随便说两句，给点思路也成啊

shijiang1130

帅哥，我刚才看了cpan上有了，你的这个题目太大了，别人几分钟内是没法帮你完成的。
http://search.cpan.org/~maja/Net ... script/dns-proxy.pl

hhs66317

回复 3# shijiang1130

感谢帅帅哥的回复，我在windows上工作，因为dns污染的缘故，有了做本地dns代理的需求，目前使用的是python版本的一个实现，就一直琢磨着要搞一个perl的。基础太差，看了半天也就整理出这么点东西，才跑来请教的。
我这就循着你指点的链接过去看看，在这之前，必须先跟你说声谢谢。若还有疑问，再来讨教。

hhs66317

根据你的提示，我安装了模块Net:NS:ynamic:roxyserver
这个模块不能在windows上正常运行，我强制安装后，写了个demo：

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use warnings;
   
5. use Net::DNS::Dynamic::Proxyserver;
   
6. my $proxy = Net::DNS::Dynamic::Proxyserver->new(
   
7.     debug => 1,
   
8.     host => '*',
   
9.     port => 53,
   
10.     uid => 65534,
    
11.     gid => 65534,
    
12.     nameservers      => [ '8.8.8.8', '8.8.4.4' ],
    
13.     nameservers_port => 53,
    
14. );
    
15. 
    
16. $proxy->run();
    

复制代码

但是这个demo不能正常运行，出现下面的提示：

1. 
   
2. Attribute (nameserver) does not pass the type constraint because: Validation failed for 'Net::DNS::Nameserver' with value undef at accessor Net::DNS::Dynamic::Proxyserver::nam
   
3. eserver (defined at D:/Strawberry/perl/site/lib/Net/DNS/Dynamic/Proxyserver.pm line 231) line 4
   
4.         Net::DNS::Dynamic::Proxyserver::nameserver('Net::DNS::Dynamic::Proxyserver=HASH(0x130e67c)', undef) called at D:/Strawberry/perl/site/lib/Net/DNS/Dynamic/Proxyserver.p
   
5. m line 259
   
6.         Net::DNS::Dynamic::Proxyserver::BUILD('Net::DNS::Dynamic::Proxyserver=HASH(0x130e67c)', 'HASH(0x2dbe94)') called at constructor Net::DNS::Dynamic::Proxyserver::new (de
   
7. fined at D:/Strawberry/perl/site/lib/Net/DNS/Dynamic/Proxyserver.pm line 542) line 116
   
8.         Net::DNS::Dynamic::Proxyserver::new('Net::DNS::Dynamic::Proxyserver', 'debug', 1, 'host', '*', 'port', 53, 'uid', 65534, 'gid', 65534, 'nameservers', 'ARRAY(0x2dbba4)'
   
9. , 'nameservers_port', 53) called at D:\Desktop\dns-proxy.pl line 5
   
10. shell returned 2
    
11. Hit any key to close this window...
    

复制代码

前后查看了半天，也没找到啥原因导致的

hhs66317

真折腾啊！
那个新模块用不来，就按原来的思路，组装起来一个，勉强能用，但是用了一会儿，就不能正常工作了，劳烦各位老师指点下，看看问题出在哪里

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. use Net::DNS;
   
5. use Net::DNS::Nameserver;
   
6. 
   
7. my $res = Net::DNS::Resolver->new(
   
8.     nameservers => [qw(114.114.114.114 8.8.8.8 8.8.4.4)],
   
9.     usevc       => 1,
   
10.     persistent_tcp => 1,
    
11. );
    
12. 
    
13. 
    
14. my $ns = new Net::DNS::Nameserver(
    
15.     LocalAddr    => [ '127.0.0.1' ],
    
16.     LocalPort    => 53,
    
17.     ReplyHandler => \&reply_handler,
    
18.     Truncate     => 0
    
19.     ) || die "couldn't create nameserver object\n";
    
20. 
    
21. $ns->main_loop;
    
22. 
    
23. sub reply_handler {
    
24.     my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
    
25.     print "$peerhost => $qname , $qclass , $qtype\n";
    
26.     my ($rcode, @ans, @auth, @add);
    
27. 
    
28.     my $answer = $res->send($qname, $qtype, $qclass);
    
29. 
    
30.     if ($answer) {
    
31.            $rcode = $answer->header->rcode;
    
32.            @ans   = $answer->answer;
    
33.            @auth  = $answer->authority;
    
34.            @add   = $answer->additional;
    
35.         return ($rcode, \@ans, \@auth, \@add);
    
36.     }
    
37.     else {
    
38.         $rcode = "NXDOMAIN";
    
39.         return ($rcode, \@ans, \@auth, \@add, { aa => 1, ra => 1 });
    
40.     }
    
41. }

复制代码

现在的情况是，我用ping测试，能正常解析，但是一打开网页，很快就挂了，也不知道问题出在那里，哎

shijiang1130

回复 6# hhs66317
把你的程序再组装一下是能用的。

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. use Net::DNS;
   
5. use Net::DNS::Nameserver;
   
6. 
   
7. my $ns = new Net::DNS::Nameserver(
   
8.     LocalAddr    => [ '127.0.0.1' ],
   
9.     LocalPort    => 53,
   
10.     ReplyHandler => \&reply_handler,
    
11.     Truncate     => 0,
    
12. #  Verbose      => 1
    
13.     ) || die "couldn't create nameserver object\n";
    
14. 
    
15. $ns->main_loop;
    
16. 
    
17. sub reply_handler {
    
18.     my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
    
19.     print "$peerhost => $qname , $qclass , $qtype\n";
    
20.     my ($rcode, @ans, @auth, @add);
    
21. 
    
22. my $res = Net::DNS::Resolver->new(
    
23.     nameservers => [qw(8.8.8.8 8.8.4.4)],
    
24.     usevc       => 1,
    
25.     persistent_tcp => 1,
    
26. );
    
27. 
    
28. #$res->tcp_timeout(10);
    
29. #$res->retry(10);       
    
30.        
    
31.     my $answer = $res->send($qname, $qtype, $qclass);
    
32.        
    
33. #        print "#####################################\n";
    
34. #    print $res->print;
    
35. #        print "#####################################\n";
    
36.     if ($answer) {
    
37.            $rcode = $answer->header->rcode;
    
38.            @ans   = $answer->answer;
    
39.            @auth  = $answer->authority;
    
40.            @add   = $answer->additional;
    
41.         return ($rcode, \@ans, \@auth, \@add);
    
42.     }
    
43.     else {
    
44.         $rcode = "NXDOMAIN";
    
45.         return ($rcode, \@ans, \@auth, \@add, { aa => 1, ra => 1 });
    
46.     }
    
47. }

复制代码

hhs66317

感谢 shijiang1130 的持续关注！！！

奇怪了，果然这么写确实能保证正常解析不出问题了
这是什么原因呢？，我对比了下，不同的地方就是把创建DNS解析对象放在回掉函数里边去了
另外这个代理服务器，刚开始解析的时候好慢，不过现在是可用的，除了有以下两个返回的信息比较碍眼：

1. Maximum reply length as advertised in EDNS from 127.0.0.1:59007: 512

复制代码

和

1. the Peer host and sock host appear to be undefined: bailing out of handling the UDP connectionWaiting for connections...

复制代码

hhs66317

保暖思淫欲，刚刚不死心又跑去尝试模块 Net:NS:ynamic:roxyserver

瞎折腾半天，还是原来的错误提示 。。。。

困死了，晚上没睡好。。。

shijiang1130

hhs66317 发表于 2013-04-05 15:00
保暖思淫欲，刚刚不死心又跑去尝试模块 Net:NS:ynamic:roxyserver

瞎折腾半天，还是原来的错误提示 ...

I like that !
我也装了那个模块，现在可以工作。把我的步骤说一下吧，看你能不能也设置好。

1. OS Name:                   Microsoft Windows 7 Professional
   
2. OS Version:                6.1.7601 Service Pack 1 Build 7601
   
3. OS Manufacturer:           Microsoft Corporation
   
4. C:\Users\test>perl -v
   
5. 
   
6. This is perl 5, version 16, subversion 3 (v5.16.3) built for MSWin32-x64-multi-t
   
7. hread
   
8. (with 1 registered patch, see perl -V for more detail)
   
9. 
   
10. Copyright 1987-2012, Larry Wall
    
11. 
    
12. Binary build 1603 [296746] provided by ActiveState http://www.ActiveState.com
    
13. Built Mar 13 2013 13:31:10
    
14. 
    
15. Perl may be copied only under the terms of either the Artistic License or the
    
16. GNU General Public License, which may be found in the Perl 5 source kit.
    
17. 
    
18. Complete documentation for Perl, including FAQ lists, should be found on
    
19. this system using "man perl" or "perldoc perl".  If you have access to the
    
20. Internet, point your browser at http://www.perl.org/, the Perl Home Page.
    

复制代码