[转载]使用Perl编写协议分析脚本

文章作者：r00t (i_am_jojo_at_msn.com)

1、软件环境：Windows、ActiveState Perl 5.8.6、Winpcap 3.1 Beta；
2、所需Perl 模块：Net::Pcap、Net::PcapUtils、NetPacket
  >ppm install NetPacket
  >ppm install http://www.bribes.org/perl/ppm/Net-Pcap.ppd
  >ppm install http://www.bribes.org/perl/ppm/Net-PcapUtils.ppd
其中Net::Pcap是Winpcap的接口，Net::PcapUtils提供常用的抓包函数，NetPacket用来解析各种协议结构；
3、仅分析ICMP和TCP协议结构，且把Header结构用文本表格的方式打印下来；
4、提供源地址、目的地址、源端口、目的端口组合的过滤方式；
5、如果需要Dump ARP协议的数据包，则需要按照额外的模块，NetPacket当前不支持ARP协议的解析；
6、可使用perl2exe工具将其转化到exe文件格式；

(0)、C:\Perl\scripts\iSniffer>packetDump.pl -h

  #Please set the width of CMD window to 100 ＃为了格式化显示请将窗口长度设置到100
  > C:\Perl\scripts\iSniffer\packetDump.pl [hvd:p:i:s:t:u::x:y:z:]
   -h   print this help
   -v   print more information   ＃显示更多的信息
   -d   choice device, [1,2,3...] ＃指定设备编号
   -p   1->icmp, 6->tcp        ＃分析哪种协议，ICMP或TCP
   -i   icmp type            ＃-p 1前提下指定ICMP的Type
         0    Echo Reply
         3    Destination Unreachable
         4    Source Quench
         5    Redirect
         8    Echo
        11    Time Exceeded
        12    Parameter Problem
        13    Timestamp
        14    Timestamp Reply
        17    Address Mask Request
        18    Address Mask Reply
        30    Traceroute
        37    Domain Name Request
   -s   x.x.x.x, source ip     ＃指定源地址
   -t   x.x.x.x, dest ip      ＃指定目的地址
   -u   x.x.x.x, source/dest ip  ＃源地址或目的地址均可
   -x   source port          ＃指定源端口
   -y   dest port           ＃指定目的端口
   -z   source/dest port      ＃源端口或目的端口均可
           v1.0, by shanleiguang@he.chinamobile.com

（1）、>packetDump.plC:\Perl\scripts\iSniffer>packetDump.pl

   +-----------------------------------------------------------------------------------+
   | Supported Devices                                            |
   +---+------+------------------------------------------------------------------------+
   | 1 | dev  | \Device\NPF_GenericNdisWanAdapter                          |
   +---+------+------------------------------------------------------------------------+
   |  | desc | Generic NdisWan adapter                                |
   +---+------+------------------------------------------------------------------------+
   | 2 | dev  | \Device\NPF_{6A06FB50-D0BC-4908-A502-90322DC74B78}              |
   +---+------+------------------------------------------------------------------------+
   |  | desc | Intel(R) PRO/100 VE Network Connection (Microsoft's Packet Scheduler)  |
   +---+------+------------------------------------------------------------------------+
   | 3 | dev  | \Device\NPF_{762D2D02-BA2C-46E1-9C54-396D8B79055F}              |
   +---+------+------------------------------------------------------------------------+
   |  | desc | WAN (PPP/SLIP) Interface                                |
   +---+------+------------------------------------------------------------------------+

Which device u want to sniff? [1,2,3] ＃选择希望Dump的设备，下一次可直接用-d来指配

（2）、C:\Perl\scripts\iSniffer>packetDump.pl -d 3 -p 1
2005/07/31 11:15:58, Sniffing on \Device\NPF_{762D2D02-BA2C-46E1-9C54-396D8B79055F}... ...
=No.1===========================================================================
   +------------------------------------------------+
   | IP Header                          |
   +--------+------------+---------+----------------+
   | ver   | 4       | hlen   | 5          |
   +--------+------------+---------+----------------+
   | tos   | 0       | len    | 60         |
   +--------+------------+---------+----------------+
   | flags  | 0       | foffset | 0          |
   +--------+------------+---------+----------------+
   | id    | 50223    | ttl    | 128        |
   +--------+------------+---------+----------------+
   | src_ip | 60.6.41.89 | dest_ip | 64.233.189.104 |
   +--------+------------+---------+----------------+
   | proto  | 1       | cksum  | 4833        |
   +--------+------------+---------+----------------+
   +--------------------------------------------------------+
   | ICMP Message                             |
   +------+------+-------+----------------------------------+
   | type | code | cksum | data                    |
   +------+------+-------+----------------------------------+
   | 8   | 0   | 17756 | abcdefghijklmnopqrstuvwabcdefghi |
   +------+------+-------+----------------------------------+
=No.2===========================================================================
   +------------------------------------------------+
   | IP Header                          |
   +--------+----------------+---------+------------+
   | ver   | 4          | hlen   | 5       |
   +--------+----------------+---------+------------+
   | tos   | 0          | len    | 60      |
   +--------+----------------+---------+------------+
   | flags  | 0          | foffset | 0       |
   +--------+----------------+---------+------------+
   | id    | 50223       | ttl    | 242      |
   +--------+----------------+---------+------------+
   | src_ip | 64.233.189.104 | dest_ip | 60.6.41.89 |
   +--------+----------------+---------+------------+
   | proto  | 1          | cksum  | 41184    |
   +--------+----------------+---------+------------+
   +--------------------------------------------------------+
   | ICMP Message                             |
   +------+------+-------+----------------------------------+
   | type | code | cksum | data                    |
   +------+------+-------+----------------------------------+
   | 0   | 0   | 19804 | abcdefghijklmnopqrstuvwabcdefghi |
   +------+------+-------+----------------------------------+

... ...

（3）、C:\Perl\scripts\iSniffer>packetDump.pl -d 3 -p 6 －u xxx.xxx.xxx.xxx -z 23

7、源代码

#!C:\Perl\bin\perl.exe
#By shanleiguang@he.chinamobile.com, 2005/07
#ActiveState Perl 5.8.6, Winpcap 3.1 beta
#ppm install NetPacket
#ppm install http://www.bribes.org/perl/ppm/Net-Pcap.ppd
#ppm install http://www.bribes.org/perl/ppm/Net-PcapUtils.ppd
use strict;

use Net::PcapUtils;
use NetPacket::Ethernet;
use NetPacket::IP;
use NetPacket::ICMP;
use NetPacket::TCP;

use Getopt::Std;
use POSIX qw(strftime);

my %opts;
getopts('hvd:p:i:s:t:u:x:y:z:', \%opts);

print_help() and exit if(defined $opts{'h'});
print_help() and exit if(defined $opts{'d'} and ($opts{'d'} !~ m/^\d+$/));
print_help() and exit if(defined $opts{'p'} and ($opts{'p'} !~ m/^\d+$/));
print_help() and exit if(defined $opts{'i'} and ($opts{'i'} !~ m/^\d+$/));
print_help() and exit if(defined $opts{'s'} and ($opts{'s'} !~ m/^\d+.\d+.\d+.\d+$/));
print_help() and exit if(defined $opts{'t'} and ($opts{'t'} !~ m/^\d+.\d+.\d+.\d+$/));
print_help() and exit if(defined $opts{'u'} and ($opts{'u'} !~ m/^\d+.\d+.\d+.\d+$/));
print_help() and exit if(defined $opts{'x'} and ($opts{'x'} !~ m/^\d+$/));
print_help() and exit if(defined $opts{'y'} and ($opts{'y'} !~ m/^\d+$/));
print_help() and exit if(defined $opts{'z'} and ($opts{'z'} !~ m/^\d+$/));

$opts{'p'} = 6 if not defined($opts{'p'});

my $choice;
my %devices = get_supported_devices();

if(defined $opts{'d'}) {
   $choice = $opts{'d'};
} else {
   print_supported_devices();
   
   print "\nWhich device u want to sniff? [";
   print join &#39;,&#39;, sort {$a <=> $b} (keys %devices) and print &#39;] &#39;;
   
   $choice = <STDIN>;
   chomp($choice);
}

die "Invalid Device!\n" if not defined($devices{$choice});

my $pkt_descriptor = Net::PcapUtils::open(
   FILTER  => &#39;ip&#39;,
   SNAPLEN => 1500,
   PROMISC => 1,
   DEV    => $devices{$choice}{&#39;dev&#39;},
);

die "Net::PcapUtils::open returned: $pkt_descriptor\n" if (!ref($pkt_descriptor));

print strftime "%Y/%m/%d %H:%M:%S, ", localtime;
print "Sniffing on $devices{$choice}{&#39;dev&#39;}... ...\n";

my ($next_packet, %next_header);
my $packet_counter = 0;

while (($next_packet, %next_header) = Net::PcapUtils::next($pkt_descriptor)) {
   my ($ip_obj, $tcp_obj, $icmp_obj);
   $ip_obj = NetPacket::IP->decode(NetPacket::Ethernet::eth_strip($next_packet));
   
   next if (defined $opts{&#39;s&#39;} and ($ip_obj->{&#39;src_ip&#39;} ne $opts{&#39;s&#39;}));
   next if (defined $opts{&#39;t&#39;} and ($ip_obj->{&#39;dest_ip&#39;} ne $opts{&#39;t&#39;}));
   next if (defined $opts{&#39;u&#39;} and ($ip_obj->{&#39;src_ip&#39;} ne $opts{&#39;u&#39;})
      and ($ip_obj->{&#39;dest_ip&#39;} ne $opts{&#39;u&#39;}));
   
   next if ($ip_obj->{&#39;proto&#39;} != $opts{&#39;p&#39;});

   if ($ip_obj->{&#39;proto&#39;} == 1) {
      $icmp_obj = NetPacket::ICMP->decode($ip_obj->{&#39;data&#39;});
      next if (defined $opts{&#39;i&#39;} and ($icmp_obj->{&#39;type&#39;} ne $opts{&#39;i&#39;}));
   }
   
   if ($ip_obj->{&#39;proto&#39;} == 6) {
      $tcp_obj = NetPacket::TCP->decode($ip_obj->{&#39;data&#39;});
      next if (defined $opts{&#39;x&#39;} and ($tcp_obj->{&#39;src_port&#39;} ne $opts{&#39;x&#39;}));
      next if (defined $opts{&#39;y&#39;} and ($tcp_obj->{&#39;dest_port&#39;} ne $opts{&#39;y&#39;}));
      next if (defined $opts{&#39;z&#39;} and ($tcp_obj->{&#39;src_port&#39;} ne $opts{&#39;z&#39;})
        and ($tcp_obj->{&#39;dest_port&#39;} ne $opts{&#39;z&#39;}));
   }
   
   $packet_counter++;
   
   print "=No.$packet_counter=", &#39;=&#39; x (80 - length("=No.$packet_counter=")), "\n";
   if($opts{&#39;v&#39;}) {
      print display_capinfo(\%next_header);
      print display_frame_hdr(NetPacket::Ethernet->decode($next_packet));
   }
   print display_ip_hdr($ip_obj);
   print display_icmp_msg($icmp_obj) if ($ip_obj->{&#39;proto&#39;} == 1);
   print display_tcp_hdr($tcp_obj) if ($ip_obj->{&#39;proto&#39;} == 6);
}

sub print_help {
   print <<HELP
   
  #Please set the width of CMD window to 100
  > $0 [hvd:p:i:s:t:u::x:y:z:]
   -h   print this help
   -v   print more information
   -d   choice device, [1,2,3...]
   -p   1->icmp, 6->tcp
   -i   icmp type
         0    Echo Reply
         3    Destination Unreachable
         4    Source Quench
         5    Redirect
         8    Echo
        11    Time Exceeded               
        12    Parameter Problem
        13    Timestamp
        14    Timestamp Reply
        17    Address Mask Request
        18    Address Mask Reply
        30    Traceroute
        37    Domain Name Request
   -s   x.x.x.x, source ip
   -t   x.x.x.x, dest ip
   -u   x.x.x.x, source/dest ip
   -x   source port
   -y   dest port
   -z   source/dest port
           v1.0, by shanleiguang\@he.chinamobile.com

HELP
}

sub get_supported_devices {
   my ($error, %description, %devices);
   my $index = 0;
   
   foreach (Net::Pcap::findalldevs(\$error, \%description)) {
      die "Net::Pcap::finealldevs Error!\n" if defined $error;
      $index++;
      $devices{$index}{&#39;dev&#39;} = $_;
      $devices{$index}{&#39;desc&#39;} = $description{$_};
   }
   
   return %devices;
}

sub print_supported_devices {
   my ($error, %description);
   my (@indexes, @fields, @values);
   my $index = 0;
   
   foreach (Net::Pcap::findalldevs(\$error, \%description)) {
      die "Net::Pcap::finealldevs Error!\n" if defined $error;
      $index++;
      push @indexes, ($index, &#39; &#39;);
      push @fields, (&#39;dev&#39;, &#39;desc&#39;);
      push @values, ($_, $description{$_});
   }

   print "\n", pretty_table(&#39;Supported Devices&#39;, (\@indexes, \@fields, \@values));
}

sub display_capinfo {
   my $capinfo = shift;
   my @capinfo;
   push @capinfo, [$_, $capinfo->{$_}] foreach (qw(tv_sec tv_usec len caplen));
   return pretty_table(&#39;Pcap Info&#39;, @capinfo);
}

sub display_frame_hdr {
   my $frame_obj = shift;
   my @eth_frame;
   push @eth_frame, [$_, $frame_obj->{$_}] foreach (qw(src_mac dest_mac type));
   return pretty_table(&#39;Ethernet Frame Header&#39;, @eth_frame);
}

sub display_ip_hdr {
   my $ip_obj = shift;
   my @ip_hdr;
   push @ip_hdr, [qw(ver tos flags id src_ip proto)];
   push @{$ip_hdr[1]}, $ip_obj->{$_} foreach (qw(ver tos flags id src_ip proto));
   push @ip_hdr, [qw(hlen len foffset ttl dest_ip cksum)];
   push @{$ip_hdr[3]}, $ip_obj->{$_} foreach (qw(hlen len foffset ttl dest_ip cksum));
   return pretty_table(&#39;IP Header&#39;, @ip_hdr);
}

sub display_icmp_msg {
   my $icmp_obj = shift;
   my @icmp_msg;
   $icmp_obj->{&#39;data&#39;} =~ s/\W//g;
   push @icmp_msg, [$_, $icmp_obj->{$_}] foreach (qw(type code cksum data));
   return pretty_table(&#39;ICMP Message&#39;, @icmp_msg);
}

sub display_tcp_hdr {
   my $tcp_obj = shift;
   my @tcp_hdr;
   push @tcp_hdr, [qw(src_port seqnum hlen flags)];
   push @{$tcp_hdr[1]}, $tcp_obj->{$_} foreach (qw(src_port seqnum hlen flags));
   push @tcp_hdr, [qw(dest_port acknum reserved winsize)];
   push @{$tcp_hdr[3]}, $tcp_obj->{$_} foreach (qw(dest_port acknum reserved winsize));
   return pretty_table(&#39;TCP Header&#39;, @tcp_hdr);
   #my $data = unpack &#39;a*&#39;, $tcp_obj->{&#39;data&#39;};
   #print "$data\n";
}

sub display_udp_hdr {
   my $udp_obj = shift;
   my @udp_hdr;
   push @udp_hdr, [$_, $udp_obj->{$_}] foreach (qw(src_port dest_port cksum));
   return pretty_table(&#39;UDP Header&#39;, @udp_hdr);
}

sub pretty_table {
   # pretty_table($aString, @aList); @aList = ( [...], [...] );
   my ($title, @data) = @_;
   my @temp;
   my @maxLength;
   my $rowLength;
   my $indent = 4;
   my $theTable;

   foreach my $col (0..$#{$data[0]}) { push @{$temp[$col]}, $_->[$col] foreach (@data); }
   $maxLength[$_] = length( (sort{length($b) <=> length($a)} @{$data[$_]} )[0]) + 2 foreach (0..$#data);
   $rowLength+= $maxLength[$_] foreach (0..$#{$temp[0]});  
   $rowLength+= $#data;

   $theTable = &#39; &#39; x $indent.&#39;+&#39;.&#39;-&#39; x $rowLength."+\n";
   $theTable.= &#39; &#39; x $indent.&#39;| &#39;.$title.&#39; &#39; x ($rowLength - length($title) - 1)."|\n";
   foreach my $row (0..$#temp) {
      $theTable.= &#39; &#39; x $indent;
      $theTable.= &#39;+&#39;.&#39;-&#39; x $maxLength[$_] foreach (0.. $#{$temp[0]});
      $theTable.= "+\n";
      $theTable.= &#39; &#39; x $indent;
      $theTable.= &#39;| &#39;.@{$temp[$row]}[$_].&#39; &#39; x ($maxLength[$_] - length(@{$temp[$row]}[$_]) - 1)
        foreach (0.. $#{$temp[0]});
      $theTable.= "|\n";
   }
   $theTable.= &#39; &#39; x $indent;
   $theTable.= &#39;+&#39;.&#39;-&#39; x $maxLength[$_] foreach (0.. $#{$temp[0]});
   $theTable.= "+\n";
   
   return $theTable;
}