File Coverage

blib/lib/NetPacket/Ethernet.pm
Criterion Covered Total %
statement 68 81 83.9
branch 2 4 50.0
condition n/a
subroutine 19 21 90.4
pod 3 3 100.0
total 92 109 84.4


line stmt bran cond sub pod time code
1             package NetPacket::Ethernet;
2             BEGIN {
3 7     7   130967 $NetPacket::Ethernet::AUTHORITY = 'cpan:YANICK';
4             }
5             # ABSTRACT: Assemble and disassemble ethernet packets.
6             $NetPacket::Ethernet::VERSION = '1.5.0';
7 7     7   62 use strict;
  7         15  
  7         283  
8 7     7   52 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  7         14  
  7         1309  
9              
10             BEGIN {
11 7     7   159 @ISA = qw(Exporter NetPacket);
12              
13 7         40 @EXPORT = qw();
14              
15 7         34 my @eth_types = qw/ ETH_TYPE_IP
16             ETH_TYPE_ARP
17             ETH_TYPE_APPLETALK
18             ETH_TYPE_RARP
19             ETH_TYPE_SNMP
20             ETH_TYPE_IPv6
21             ETH_TYPE_PPP
22             ETH_TYPE_802_1Q
23             ETH_TYPE_IPX
24             ETH_TYPE_PPPOED
25             ETH_TYPE_PPPOES /;
26              
27 7         27 @EXPORT_OK = ( 'eth_strip', @eth_types );
28              
29 7         301 %EXPORT_TAGS = (
30             ALL => [@EXPORT, @EXPORT_OK],
31             strip => [qw(eth_strip)],
32             types => \@eth_types,
33             );
34             }
35              
36             #
37             # Partial list of ethernet protocol types from
38             # http://www.isi.edu/in-notes/iana/assignments/ethernet-numbers
39             #
40              
41 7     7   42 use constant ETH_TYPE_IP => 0x0800;
  7         12  
  7         1125  
42 7     7   40 use constant ETH_TYPE_ARP => 0x0806;
  7         12  
  7         366  
43 7     7   38 use constant ETH_TYPE_APPLETALK => 0x809b;
  7         14  
  7         320  
44 7     7   36 use constant ETH_TYPE_RARP => 0x8035;
  7         20  
  7         319  
45 7     7   36 use constant ETH_TYPE_SNMP => 0x814c;
  7         13  
  7         4528  
46 7     7   645 use constant ETH_TYPE_IPv6 => 0x86dd;
  7         17  
  7         1411  
47 7     7   36 use constant ETH_TYPE_PPP => 0x880b;
  7         9  
  7         493  
48 7     7   43 use constant ETH_TYPE_802_1Q => 0x8100;
  7         92  
  7         374  
49 7     7   37 use constant ETH_TYPE_IPX => 0x8137;
  7         12  
  7         339  
50 7     7   33 use constant ETH_TYPE_PPPOED => 0x8863;
  7         11  
  7         276  
51 7     7   33 use constant ETH_TYPE_PPPOES => 0x8864;
  7         16  
  7         340  
52              
53             #
54             # VLAN Tag field masks
55             #
56              
57 7     7   33 use constant VLAN_MASK_PCP => 0xE000;
  7         14  
  7         489  
58 7     7   44 use constant VLAN_MASK_CFI => 0x1000;
  7         13  
  7         448  
59 7     7   41 use constant VLAN_MASK_VID => 0x0FFF;
  7         13  
  7         4224  
60              
61             #
62             # Decode the packet
63             #
64              
65             sub decode {
66 6     6 1 2627 my $class = shift;
67 6         17 my($pkt, $parent) = @_;
68 6         17 my $self = {};
69              
70             # Class fields
71              
72 6         25 $self->{_parent} = $parent;
73 6         64 $self->{_frame} = $pkt;
74              
75             # Decode ethernet packet
76              
77 6 50       26 if (defined($pkt)) {
78              
79 6         16 my($sm_lo, $sm_hi, $dm_lo, $dm_hi, $tcid);
80              
81 6         53 ($dm_hi, $dm_lo, $sm_hi, $sm_lo, $self->{type}) = unpack('NnNnn' ,
82             $pkt);
83              
84             # Check for 802.1Q VLAN tag and unpack to account for 4-byte offset
85 6 50       29 if ($self->{type} == ETH_TYPE_802_1Q) {
86 0         0 $self->{tpid} = ETH_TYPE_802_1Q;
87              
88 0         0 ( $tcid, $self->{type}, $self->{data} ) = unpack('x14nna*' , $pkt);
89              
90             # Break down VLAN tag TCI into: PCP, CFI, VID
91 0         0 $self->{pcp} = $tcid & VLAN_MASK_PCP >> 13;
92 0         0 $self->{cfi} = $tcid & VLAN_MASK_CFI >> 12;
93 0         0 $self->{vid} = $tcid & VLAN_MASK_VID;
94             }
95             else {
96 6         37 ( $self->{data} ) = unpack('x14a*' , $pkt);
97             }
98              
99             # Convert MAC addresses to hex string to avoid representation problems
100              
101 6         47 $self->{src_mac} = sprintf "%08x%04x", $sm_hi, $sm_lo;
102 6         23 $self->{dest_mac} = sprintf "%08x%04x", $dm_hi, $dm_lo;
103             }
104              
105             # Return a blessed object
106              
107 6         19 bless($self, $class);
108 6         20 return $self;
109             }
110              
111             #
112             # Strip header from packet and return the data contained in it
113             #
114              
115             undef ð_strip; # Create eth_strip alias
116             *eth_strip = \&strip;
117              
118             sub strip {
119 0     0 1   my ($pkt) = @_;
120              
121 0           my $eth_obj = NetPacket::Ethernet->decode($pkt);
122 0           return $eth_obj->{data};
123             }
124              
125             #
126             # Encode a packet - not implemented!
127             #
128              
129             sub encode {
130 0     0 1   my ($self) = shift;
131              
132 0           (my $dest = $self->{src_mac}) =~ s/://g;
133 0           (my $src = $self->{dest_mac}) =~ s/://g;
134              
135 0           my $frame = pack('H12H12n a*', $dest, $src, 0x0800, $self->{data});
136 0           return $frame;
137             }
138              
139             #
140             # Module initialisation
141             #
142              
143             1;
144              
145             # autoloaded methods go after the END token (&& pod) below
146              
147             =pod
148              
149             =head1 NAME
150              
151             NetPacket::Ethernet - Assemble and disassemble ethernet packets.
152              
153             =head1 VERSION
154              
155             version 1.5.0
156              
157             =head1 SYNOPSIS
158              
159             use NetPacket::Ethernet;
160              
161             $eth_obj = NetPacket::Ethernet->decode($raw_pkt);
162             $eth_pkt = NetPacket::Ethernet->encode(params...); # Not implemented
163             $eth_data = NetPacket::Ethernet::strip($raw_pkt);
164              
165             =head1 DESCRIPTION
166              
167             C provides a set of routines for assembling and
168             disassembling packets using the Ethernet protocol.
169              
170             =head2 Methods
171              
172             =over
173              
174             =item Cdecode([RAW PACKET])>
175              
176             Decode the raw packet data given and return an object containing
177             instance data. This method will quite happily decode garbage input.
178             It is the responsibility of the programmer to ensure valid packet data
179             is passed to this method.
180              
181             =item Cencode(param =E value)>
182              
183             Return an ethernet packet encoded with the instance data specified.
184             Not implemented.
185              
186             =back
187              
188             =head2 Functions
189              
190             =over
191              
192             =item C
193              
194             Return the encapsulated data (or payload) contained in the ethernet
195             packet. This data is suitable to be used as input for other
196             C modules.
197              
198             This function is equivalent to creating an object using the
199             C constructor and returning the C field of that
200             object.
201              
202             =back
203              
204             =head2 Instance data
205              
206             The instance data for the C object consists of
207             the following fields.
208              
209             =over
210              
211             =item src_mac
212              
213             The source MAC address for the ethernet packet as a hex string.
214              
215             =item dest_mac
216              
217             The destination MAC address for the ethernet packet as a hex string.
218              
219             =item type
220              
221             The protocol type for the ethernet packet.
222              
223             =item data
224              
225             The payload for the ethernet packet.
226              
227             =back
228              
229             =head2 Exports
230              
231             =over
232              
233             =item default
234              
235             none
236              
237             =item exportable
238              
239             ETH_TYPE_IP ETH_TYPE_ARP ETH_TYPE_APPLETALK ETH_TYPE_SNMP
240             ETH_TYPE_IPv6 ETH_TYPE_PPP
241              
242             =item tags
243              
244             The following tags group together related exportable items.
245              
246             =over
247              
248             =item C<:types>
249              
250             ETH_TYPE_IP ETH_TYPE_ARP ETH_TYPE_APPLETALK ETH_TYPE_SNMP
251             ETH_TYPE_IPv6 ETH_TYPE_PPP
252              
253             =item C<:strip>
254              
255             Import the strip function C which is an alias for
256             C
257              
258             =item C<:ALL>
259              
260             All the above exportable items.
261              
262             =back
263              
264             =back
265              
266             =head1 EXAMPLE
267              
268             The following script dumps ethernet frames by mac address and protocol
269             to standard output.
270              
271             #!/usr/bin/perl -w
272              
273             use strict;
274             use Net::PcapUtils;
275             use NetPacket::Ethernet;
276              
277             sub process_pkt {
278             my($arg, $hdr, $pkt) = @_;
279              
280             my $eth_obj = NetPacket::Ethernet->decode($pkt);
281             print("$eth_obj->{src_mac}:$eth_obj->{dest_mac} $eth_obj->{type}\n");
282             }
283              
284             Net::PcapUtils::loop(\&process_pkt);
285              
286             =head1 TODO
287              
288             =over
289              
290             =item Implement C function
291              
292             =back
293              
294             =head1 COPYRIGHT
295              
296             Copyright (c) 2001 Tim Potter and Stephanie Wehner.
297              
298             Copyright (c) 1995,1996,1997,1998,1999 ANU and CSIRO on behalf of
299             the participants in the CRC for Advanced Computational Systems
300             ('ACSys').
301              
302             This module is free software. You can redistribute it and/or
303             modify it under the terms of the Artistic License 2.0.
304              
305             This program is distributed in the hope that it will be useful,
306             but without any warranty; without even the implied warranty of
307             merchantability or fitness for a particular purpose.
308              
309             =head1 AUTHOR
310              
311             Tim Potter Etpot@samba.orgE
312              
313             =cut
314              
315             __END__