File Coverage

blib/lib/Net/Packet/Env.pm
Criterion Covered Total %
statement 15 17 88.2
branch n/a
condition 1 2 50.0
subroutine 6 6 100.0
pod n/a
total 22 25 88.0


line stmt bran cond sub pod time code
1             #
2             # $Id: Env.pm 1643 2009-11-09 18:21:00Z gomor $
3             #
4             package Net::Packet::Env;
5 29     29   279813 use strict;
  29         72  
  29         1284  
6 29     29   307 use warnings;
  29         64  
  29         22062  
7              
8             require Exporter;
9             require Class::Gomor::Array;
10             our @ISA = qw(Exporter Class::Gomor::Array);
11             our @EXPORT_OK = qw($Env);
12              
13 29     29   180 use Carp qw(croak);
  29         58  
  29         6357  
14             require Net::Libdnet;
15             require Net::IPv6Addr;
16              
17             our @AS = qw(
18             dev
19             ip
20             ip6
21             mac
22             subnet
23             gatewayIp
24             gatewayMac
25             desc
26             dump
27             err
28             errString
29             noFrameAutoDesc
30             noFrameAutoDump
31             noDescAutoSet
32             noDumpAutoSet
33             noFramePadding
34             noFrameComputeChecksums
35             noFrameComputeLengths
36             doFrameReturnList
37             doIPv4Checksum
38             doMemoryOptimizations
39             _dnet
40             );
41             our @AO = qw(
42             debug
43             );
44             __PACKAGE__->cgBuildIndices;
45             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
46              
47 29     29   163 no strict 'vars';
  29         224  
  29         2853  
48              
49             BEGIN {
50 29     29   293 my $osname = {
51             cygwin => [ \&_getDevWin32, ],
52             MSWin32 => [ \&_getDevWin32, ],
53             };
54              
55 29   50     1922 *getDev = $osname->{$^O}->[0] || \&_getDevOther;
56             }
57              
58 29     29   32567 use Net::Packet::Utils qw(getGatewayIp);
  0            
  0            
59              
60             our $Env = __PACKAGE__->new;
61              
62             sub new {
63             my $self = shift->SUPER::new(
64             debug => 0,
65             noFrameAutoDesc => 0,
66             noFrameAutoDump => 0,
67             noDescAutoSet => 0,
68             noDumpAutoSet => 0,
69             noFramePadding => 0,
70             noFrameComputeChecksums => 0,
71             noFrameComputeLengths => 0,
72             doFrameReturnList => 0,
73             doIPv4Checksum => 0,
74             doMemoryOptimizations => 0,
75             err => 0,
76             errString => '',
77             @_,
78             );
79              
80             $self->[$__dev]
81             ? do { $self->[$__dev] = $self->getDevInfoFor($self->[$__dev]) }
82             : do { $self->[$__dev] = $self->getDevInfo };
83              
84             $self->[$__mac] = $self->getMac unless $self->[$__mac];
85             $self->[$__subnet] = $self->getSubnet unless $self->[$__subnet];
86             $self->[$__ip] = $self->getIp unless $self->[$__ip];
87             $self->[$__ip6] = $self->getIp6 unless $self->[$__ip6];
88             $self->[$__gatewayIp] = getGatewayIp() unless $self->[$__gatewayIp];
89              
90             print STDERR "*** Net::Packet is obsolete, you will receive no ".
91             "support.\n*** Now use Net::Frame::* modules.\n";
92              
93             $self;
94             }
95              
96             sub getDevInfo {
97             my $self = shift;
98             # By default, we take outgoing device to Internet
99             $self->[$___dnet] = Net::Libdnet::intf_get_dst(shift() || '1.1.1.1');
100             $self->getDev;
101             }
102              
103             sub getDevInfoFor {
104             my $self = shift;
105             $self->[$___dnet] = Net::Libdnet::intf_get(shift());
106             $self->getDev;
107             }
108              
109             sub updateDevInfo {
110             my $self = shift;
111             my ($ip) = @_;
112             $self->getDevInfo($ip);
113             $self->[$__dev] = $self->getDev;
114             $self->[$__ip] = $self->getIp;
115             $self->[$__ip6] = $self->getIp6;
116             $self->[$__mac] = $self->getMac;
117             $self->[$__subnet] = $self->getSubnet;
118             $self->[$__gatewayIp] = getGatewayIp($ip);
119             }
120              
121             # Thanx to Maddingue
122             sub _toDotQuad {
123             my ($i) = @_;
124             ($i >> 24 & 255).'.'.($i >> 16 & 255).'.'.($i >> 8 & 255).'.'.($i & 255);
125             }
126              
127             sub _getDevWin32 {
128             my $self = shift;
129              
130             croak("@{[(caller(0))[3]]}: unable to find a suitable device\n")
131             unless $self->[$___dnet]->{name};
132              
133             # Get dnet interface name and its subnet
134             my $dnet = $self->[$___dnet]->{name};
135             my $subnet = Net::Libdnet::addr_net($self->[$___dnet]->{addr});
136             croak("@{[(caller(0))[3]]}: Net::Libdnet::addr_net() error\n")
137             unless $subnet;
138              
139             require Net::Pcap;
140             my %dev;
141             my $err;
142             Net::Pcap::findalldevs(\%dev, \$err);
143             croak("@{[(caller(0))[3]]}: Net::Pcap::findalldevs() error: $err\n")
144             if $err;
145              
146             # Search for corresponding WinPcap interface, via subnet value.
147             # I can't use IP address or MAC address, they are not available
148             # through Net::Pcap (as of version 0.15_01).
149             for my $d (keys %dev) {
150             my $net;
151             my $mask;
152             if (Net::Pcap::lookupnet($d, \$net, \$mask, \$err) < 0) {
153             croak("@{[(caller(0))[3]]}: Net::Pcap::lookupnet(): $d: $err\n")
154             }
155             $net = _toDotQuad($net);
156             if ($net eq $subnet) {
157             #print STDERR "[$dnet] => [$d]\n";
158             return $d;
159             }
160             }
161             undef;
162             }
163              
164             sub _getDevOther {
165             shift->[$___dnet]->{name} || (($^O eq 'linux') ? 'lo' : 'lo0');
166             }
167              
168             sub getSubnet {
169             Net::Libdnet::addr_net(shift->[$___dnet]->{addr}) || '127.0.0.0';
170             }
171              
172             sub getMac { shift->[$___dnet]->{link_addr} || 'ff:ff:ff:ff:ff:ff' }
173              
174             sub getIp {
175             my $ip = shift->[$___dnet]->{addr} || '127.0.0.1';
176             $ip =~ s/\/\d+$//;
177             $ip;
178             }
179              
180             sub _getIp6 {
181             my $self = shift;
182             # XXX: No IP6 under Windows for now
183             return '::1' if $^O =~ m/MSWin32|cygwin/i;
184             my $dev = $self->[$__dev];
185             my $mac = $self->[$__mac];
186             my $buf = `/sbin/ifconfig $dev 2> /dev/null`;
187             $buf =~ s/$dev//;
188             $buf =~ s/$mac//i;
189             my ($ip6) = ($buf =~ /((?:[a-f0-9]{1,4}(?::|%|\/){1,2})+)/i); # XXX: better
190             if ($ip6) {
191             $ip6 =~ s/%|\///g;
192             $ip6 = lc($ip6);
193             }
194             ($ip6 && Net::IPv6Addr::ipv6_chkip($ip6) && $ip6) || '::1';
195             }
196              
197             sub getIp6 {
198             my $self = shift;
199             $self->_getIp6($self->[$__dev]);
200             }
201              
202             sub debug {
203             my $self = shift;
204             @_ ? do { $self->[$__debug] = $Class::Gomor::Debug = shift }
205             : $self->[$__debug];
206             }
207              
208             1;
209              
210             =head1 NAME
211              
212             Net::Packet::Env - environment object used for frame capture/injection
213              
214             =head1 SYNOPSIS
215              
216             use Net::Packet::Env qw($Env);
217              
218             # Get default values from system
219             my $env = Net::Packet::Env->new;
220              
221             # Get values from a specific device
222             my $env2 = Net::Packet::Env->new(dev => 'vmnet1');
223              
224             print "dev: ", $env->dev, "\n";
225             print "mac: ", $env->mac, "\n";
226             print "ip : ", $env->ip, "\n" if $env->ip;
227             print "ip6: ", $env->ip6, "\n" if $env->ip6;
228              
229             =head1 DESCRIPTION
230              
231             Basically, this module is used to tell where to inject a frame, and B default behaviour regarding auto creation of B and B objects.
232              
233             =head1 ATTRIBUTES
234              
235             =over 4
236              
237             =item B
238              
239             The device on which frames will be injected.
240              
241             =item B
242              
243             The IPv4 address of B. It will be used by default for all created frames.
244              
245             =item B
246              
247             The IPv6 address of B. It will be used by default for all created frames.
248              
249             =item B
250              
251             The MAC address of B. It will be used by default for all created frames.
252              
253             =item B
254              
255             The subnet address of B. It will be set automatically.
256              
257             =item B
258              
259             The gateway IP address of B. It is set automatically under all platforms.
260              
261             =item B
262              
263             The gateway MAC address of B. It will not be set automatically. Due to the implementation of ARP lookup within B, we can't do it within this module. It is done within B under Windows, to automatically build the layer 2 header.
264              
265             =item B
266              
267             The B object used to inject frames to network.
268              
269             =item B
270              
271             The B object used to receive frames from network.
272              
273             =item B
274              
275             This attribute controls B behaviour regarding B autocreation. If set to 0, when a B is created for the first time, a B object will be created if none has been set in B attribute for default B<$Env> object. Setting it to 1 avoids this behaviour.
276              
277             =item B
278              
279             Same as above, but for B object.
280              
281             =item B
282              
283             This attribute controls B behaviour regarding global B<$Env> autosetting behaviour. If set to 0, when a B is created for the first time, the created B object will have a pointer to it stored in B attribute of B<$Env> default object. Setting it to 1 avoids this behaviour.
284              
285             =item B
286              
287             Same as above, but for B object.
288              
289             =item B
290              
291             By default, when a B object is created from analyzing a raw string (either by taking from B object or from user), padding is achieved to complete the size of 60 bytes. Set this attribute to 1 if you do not want this behaviour.
292              
293             =item B
294              
295             By default, when a B object is created from analyzing a raw string (either by taking from B object or from user), only the first found frame is returned. If you set it to true, an arrayref of B objects will be returned. For example, if you put an IPv6 frame within IPv4, or you get one from network, you will need to use this attribute.
296              
297             =item B
298              
299             =item B
300              
301             By default, when a B object is packed, all layers checksums and lengths are computed (if respective layers implement that). If you want to do it yourself, set this to true. See B for the exception.
302              
303             =item B
304              
305             This parameter exists to improve performances of the framework. When you send an IPv4 frame at layer 3 (using a B object), under Unix systems, you MUST not compute IPv4 checksum. The kernel does it. Because this is the more general case (sending IPv4 at layer 3), this parameter is set to false by default. Note: under Windows, because B is a wrapper around B, this parameter will be set to true on B object creation.
306              
307             So, even if you let the framework compute checksums, IPv4 checksum will not be computed. If you want to send IPv4 frames at layer 2, you will need to also set this parameter to true.
308              
309             =item B
310              
311             By default, no memory optimizations are made to improve speed. You can enable those optimizations (mostly done in B) in order to gain ~ 10% in memory, at the cost of ~ 10% in speed.
312              
313             =item B
314              
315             The environment debug directive. Set it to a number greater than 0 to increase the level of debug messages. Up to 3, default 0.
316              
317             =back
318              
319             =head1 METHODS
320              
321             =over 4
322              
323             =item B
324              
325             Object constructor. You can pass attributes that will overwrite default ones. Default values:
326              
327             debug: 0
328              
329             noFrameAutoDesc: 0
330              
331             noFrameAutoDump: 0
332              
333             noDescAutoSet: 0
334              
335             noDumpAutoSet: 0
336              
337             dev: if not user provided, default interface is used, by calling B method. If user provided, all B, B and B attributes will be used for that B.
338              
339             ip: if not user provided, default interface IP is used, by calling B method. If user provided, it is overwritten by the user.
340              
341             ip6: if not user provided, default interface IPv6 is used, by calling B method. If user provided, it is overwritten by the user.
342              
343             mac: if not user provided, default interface MAC is used, by calling B method. If user provided, it is overwritten by the user.
344              
345             =item B [ (scalar) ]
346              
347             By default, network device to use is the one used by default gateway. If you provide an IP address as a parameter, the interface used will be the one which have direct access to this IP address.
348              
349             =item B (scalar)
350              
351             Will set internal attributes for network interface passed as a parameter. Those internal attributes are used to get IP, IPv6 and MAC attributes.
352              
353             =item B (scalar)
354              
355             This is a helper method. You pass an IP address as a parameter, and all attributes for elected network interface will be updated (B, B, B, B, B, B).
356              
357             =item B
358              
359             Returns network interface, by looking at internal attribute.
360              
361             =item B
362              
363             Returns MAC address, by looking at internal attribute.
364              
365             =item B
366              
367             Returns subnet address, by looking at internal attribute.
368              
369             =item B
370              
371             Returns IP address, by looking at internal attribute.
372              
373             =item B
374              
375             Returns IPv6 address, by looking at internal attribute.
376              
377             =back
378              
379             =head1 AUTHOR
380              
381             Patrice EGomoRE Auffret
382              
383             =head1 COPYRIGHT AND LICENSE
384            
385             Copyright (c) 2004-2009, Patrice EGomoRE Auffret
386            
387             You may distribute this module under the terms of the Artistic license.
388             See LICENSE.Artistic file in the source distribution archive.
389            
390             =head1 RELATED MODULES
391            
392             L, L, L
393            
394             =cut