Use Perl to write a protocol analysis script

Use Perl to write a protocol analysis script

Created on: updated on:
Article attributes: original
Article submission: r00t (I _am_jo_at_msn.com)

1. software environment: Windows, ActiveState Perl 5.8.6, Winpcap 3.1 beta;
2. Perl modules: Net: pcap, net: pcaputils, and 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 is the Winpcap interface. Net: pcaputils provides common packet capture functions. netpacket is used to parse various Protocol structures;
3. Analyze only the ICMP and TCP protocol structures and print the header structures in a text table;
4. Provides a filtering method that combines the source address, Destination Address, source port, and destination port;
5. If dump ARP packets are required, netpacket does not support ARP parsing based on the additional modules;
6. You can use the perl2exe tool to convert it to the EXE file format;

(0), C:/perl/scripts/isnifer> packetdump. pl-H

# Please set the width of CMD window to 100 # Set the Window Length to 100 in order to format the display
> C:/perl/scripts/isniffer/packetdump. pl [HVD: P: I: S: T: U: X: Y: Z:]
-H print this help
-V print more information # Show more information
-D choice device, [1, 2, 3...] # specify the device number
-P 1-> ICMP, 6-> TCP # analyze which protocol, ICMP or TCP
-I ICMP Type # specify the type of ICMP under the premise of-P 1
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, Source IP # specifies the source address
-T x. x, dest ip # specify the destination address
-U x. x, source/dest ip # both the source address and target address can be used.
-X source port # specify the source port
-Y dest port # specify the destination port
-Z source/DEST port # both the source port and destination port can be used
V1.0, by shanleiguang@he.chinamobile.com

(1)> packetdump. PLC:/perl/scripts/isnifer> packetdump. pl

+ Shards +
| 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 schedconnection) |
+ --- + ------ + ------------------------------------------------------------------------ +
| 3 | Dev |/device/NPF _ {762d2d02-ba2c-46e1-9c54-0000d8b79055f} |
+ --- + ------ + ------------------------------------------------------------------------ +
| DESC | Wan (PPP/slip) interface |
+ --- + ------ + ------------------------------------------------------------------------ +

Which device u want to sniff? [1, 2, 3] # select the device you want to dump. You can use-D to specify the configuration next time.

(2) c:/perl/scripts/isnifer> packetdump. pl-D 3-P 1
11:15:58, sniffing on/device/NPF _ {762d2d02-ba2c-46e1-9c54-109d8b79055f }......
= 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/isnifer> packetdump. pl-D 3-P 6-u xxx. XXX-Z 23

7. Source Code

#! 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 address;
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 + $ /));
Print_help () and exit if (defined $ opts {'T'} and ($ opts {'T '}!~ M/^/d +./d + $ /));
Print_help () and exit if (defined $ opts {'U'} and ($ opts {'U '}!~ M/^/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 = & gt; 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-> {'prop'} = 1 );
Print display_tcp_hdr ($ tcp_obj) if ($ ip_obj-> {'proto'} = 6 );
}

Sub print_help {
Print
# 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, Source IP
-T x. x, DEST IP
-U 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 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;
}