依赖的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;
}
