perl_xieyi.pl

perl 协议分析。

#!/usr/bin/perl

[转载]使用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 [e-mail]

（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、源代码
=cut
#!C:\Perl\bin\perl.exe
#By [e-mail], 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 ',', sort {$a <=> $b} (keys %devices) and print '] ';
  
  $choice = <STDIN>;
  chomp($choice);
}

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

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

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}{'dev'}... ...\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{'s'} and ($ip_obj->{'src_ip'} ne $opts{'s'}));
  next if (defined $opts{'t'} and ($ip_obj->{'dest_ip'} ne $opts{'t'}));
  next if (defined $opts{'u'} and ($ip_obj->{'src_ip'} ne $opts{'u'})
    and ($ip_obj->{'dest_ip'} ne $opts{'u'}));
  
  next if ($ip_obj->{'proto'} != $opts{'p'});

  if ($ip_obj->{'proto'} == 1) {
    $icmp_obj = NetPacket::ICMP->decode($ip_obj->{'data'});
    next if (defined $opts{'i'} and ($icmp_obj->{'type'} ne $opts{'i'}));
  }
  
  if ($ip_obj->{'proto'} == 6) {
    $tcp_obj = NetPacket::TCP->decode($ip_obj->{'data'});
    next if (defined $opts{'x'} and ($tcp_obj->{'src_port'} ne $opts{'x'}));
    next if (defined $opts{'y'} and ($tcp_obj->{'dest_port'} ne $opts{'y'}));
    next if (defined $opts{'z'} and ($tcp_obj->{'src_port'} ne $opts{'z'})
        and ($tcp_obj->{'dest_port'} ne $opts{'z'}));
  }
  
  $packet_counter++;
  
  print "=No.$packet_counter=", '=' x (80 - length("=No.$packet_counter=")), "\n";
  if($opts{'v'}) {
    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->{'proto'} == 1);
  print display_tcp_hdr($tcp_obj) if ($ip_obj->{'proto'} == 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}{'dev'} = $_;
    $devices{$index}{'desc'} = $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, ' ');
    push @fields, ('dev', 'desc');
    push @values, ($_, $description{$_});
  }

  print "\n", pretty_table('Supported Devices', (\@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('Pcap Info', @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('Ethernet Frame Header', @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('IP Header', @ip_hdr);
}

sub display_icmp_msg {
  my $icmp_obj = shift;
  my @icmp_msg;
  $icmp_obj->{'data'} =~ s/\W//g;
  push @icmp_msg, [$_, $icmp_obj->{$_}] foreach (qw(type code cksum data));
  return pretty_table('ICMP Message', @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('TCP Header', @tcp_hdr);
  #my $data = unpack 'a*', $tcp_obj->{'data'};
  #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('UDP Header', @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 = ' ' x $indent.'+'.'-' x $rowLength."+\n";
  $theTable.= ' ' x $indent.'| '.$title.' ' x ($rowLength - length($title) - 1)."|\n";
  foreach my $row (0..$#temp) {
    $theTable.= ' ' x $indent;
    $theTable.= '+'.'-' x $maxLength[$_] foreach (0.. $#{$temp[0]});
    $theTable.= "+\n";
    $theTable.= ' ' x $indent;
    $theTable.= '| '.@{$temp[$row]}[$_].' ' x ($maxLength[$_] - length(@{$temp[$row]}[$_]) - 1)
        foreach (0.. $#{$temp[0]});
    $theTable.= "|\n";
  }
  $theTable.= ' ' x $indent;
  $theTable.= '+'.'-' x $maxLength[$_] foreach (0.. $#{$temp[0]});
  $theTable.= "+\n";
  
  return $theTable;
}