依赖的Perl第三方库在Ubuntu上安装：
- libnet-pcap-perl
- libnet-dns-perl
如果还需要其他Perl第三方库，可以通过apt-file（Ubuntu Lucid默认没有安装）来检索所需要的pm文件在哪个deb包。
例如：
$ apt-file search Net::DNS::Packet libnet-dns-perl: /usr/share/man/man3/Net::DNS::Packet.3pm.gz
$ apt-file search Net::Pcap libnet-pcap-perl: /usr/share/man/man3/Net::Pcap.3pm.gz
Wireshark虽然也可以抓包分析，但是用可编程的脚本语言来辅助分析可以省去很多肉眼比对的工作。
下面直接上代码：
#!/usr/bin/perl -w # # Copyright 2003, Brian Hatch, released under the GPL # # watch_dns: # A program to watch for inbound DNS queries, and print the # source, destination, and requested domain name of the queries. # # You'll need to fill this in with your actual IP address # (If we didn't restrict the destination IP address, we'd # catch all our outbound queries too.) # # Original Downloaded from: # http://www.hackinglinuxexposed.com/articles/20030730.html # # Modified by huangwei.me 2010-08-02 # 本机IP地址定义 my $MY_IP_ADDRESS='10.2.1.83'; # 非特权权限的uid/gid，可以用id命令查看当前用户的uid和gid my $UNPRIV="1001"; # 自行指定监听网卡,留空将使用系统默认探测到的网卡 my $MY_DEV="vmnet8"; # # No changes required hereafter # use Net::Pcap; use Net::DNS::RR; use FileHandle; use English; # $UID等价于$<, $EUID等价于$> use strict; STDOUT->autoflush(1); while ( 1 ) { my $pid = fork(); if ( ! defined $pid ) { die "Unable to fork. Yikes." }; if ( $pid ) { # Parent process (running as root) will wait for # child. If child exits, we'll create another one. wait(); sleep(1); # To keep us from respawning too fast if necessary. } else { print "Child starting\n"; # Child process will do actual sniffing. # First, create our packet capturing device my($pcap_t) = create_pcap(); unless ( $pcap_t ) { die "Unable to create pcap"; } # Let's stop running as root. Since we already # have our pcap descriptor, we can still use it. $EGID="$UNPRIV $UNPRIV"; # setgid and setgroups() $GID=$UNPRIV; $UID=$UNPRIV; $EUID=$UNPRIV; # Capture packets forever. Net::Pcap::loop($pcap_t, -1, \&process_pkt, 0); # Technically, we shouldn't get here since the loop # is infinite (-1), but just in case, close and exit. Net::Pcap::close($pcap_t); exit 1; } } sub create_pcap { my $promisc = 1; # enter promiscuous mode or not. my $snaplen = 1500; # the maximum number of bytes to capture from each packet my $to_ms = 0; # timeout my $opt=1; # Sure, optimisation is good... my($err,$net,$mask,$dev,$filter_t); my $filter = "udp dst port 53 or udp src port 53"; # pcap capture filter # Look up an appropriate device (eth0 usually) $dev = $MY_DEV || Net::Pcap::lookupdev(\$err); print "sniffing on ", $dev, "\n"; $dev or die "Net::Pcap::lookupdev failed. Error was $err"; if ( (Net::Pcap::lookupnet($dev, \$net, \$mask, \$err) ) == -1 ) { die "Net::Pcap::lookupnet failed. Error was $err"; } # Actually open up our descriptor my $pcap_t = Net::Pcap::open_live($dev, $snaplen, $promisc, $to_ms, \$err); $pcap_t || die "Can't create packet descriptor. Error was $err"; if ( Net::Pcap::compile($pcap_t, \$filter_t, $filter, $opt, $net) == -1 ) { die "Unable to compile filter string '$filter'\n"; } # Make sure our sniffer only captures those bytes we want in # our filter. Net::Pcap::setfilter($pcap_t, $filter_t); # Return our pcap descriptor $pcap_t; } # Routine to process the packet -- called by Net::Pcap::loop() # every time an appropriate packet is snagged. sub process_pkt { my($user_data, $hdr, $pkt) = @_; my($src_ip) = 26; # start of the source IP in the packet my($dst_ip) = 30; # start of the dest IP in the packet my($udp) = 42; # start of UDP pkt payload my($domain_start) = 55; # start of the domain in the packet my($data); # extract the source IP addr into dotted quad form. my($source) = sprintf("%d.%d.%d.%d", ord( substr($pkt, $src_ip, 1) ), ord( substr($pkt, $src_ip+1, 1) ), ord( substr($pkt, $src_ip+2, 1) ), ord( substr($pkt, $src_ip+3, 1) )); # extract the destination IP addr into dotted quad form. my($destination) = sprintf("%d.%d.%d.%d", ord( substr($pkt, $dst_ip, 1) ), ord( substr($pkt, $dst_ip+1, 1) ), ord( substr($pkt, $dst_ip+2, 1) ), ord( substr($pkt, $dst_ip+3, 1) )); $data = substr($pkt, $domain_start); $data =~ s/0.*//g; # strip off everything after the domain $data =~ s/[^-a-zA-Z0-9]/./g; # change the domain component separators # back int to dots. print "$source -> $destination: $data\n" if ( $source and $destination and $data); dump_dns(parse_dns($pkt, $udp)); } # dump dns query & response in details sub dump_dns { my $dns = $_; $dns->print; } sub parse_dns { my($pkt, $udp) = @_; my $udp_payload = substr($pkt, $udp); my $dns = Net::DNS::Packet->new(\$udp_payload); return $dns; }
