File Coverage

blib/lib/Metabrik/Network/Device.pm
Criterion Covered Total %
statement 9 105 8.5
branch 0 58 0.0
condition 0 34 0.0
subroutine 3 12 25.0
pod 2 9 22.2
total 14 218 6.4


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::device Brik
5             #
6             package Metabrik::Network::Device;
7 2     2   790 use strict;
  2         4  
  2         58  
8 2     2   10 use warnings;
  2         4  
  2         65  
9              
10 2     2   13 use base qw(Metabrik::System::Package);
  2         4  
  2         2905  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable interface) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             device => [ qw(device) ],
20             enable_warnings => [ qw(0|1) ],
21             },
22             attributes_default => {
23             enable_warnings => 0,
24             },
25             commands => {
26             install => [ ], # Inherited
27             list => [ ],
28             get => [ qw(device|OPTIONAL) ],
29             default => [ qw(destination_ip|OPTIONAL) ],
30             show => [ qw(device_array|OPTIONAL) ],
31             internet_address => [ ],
32             my_ipv4 => [ qw(device|OPTIONAL) ],
33             my_ipv6 => [ qw(device|OPTIONAL) ],
34             },
35             require_modules => {
36             'Net::Libdnet::Intf' => [ ],
37             'Net::Pcap' => [ ],
38             'Net::Routing' => [ ],
39             'Net::IPv4Addr' => [ ],
40             'Metabrik::Client::Www' => [ ],
41             },
42             need_packages => {
43             ubuntu => [ qw(libpcap-dev libnet-libdnet-perl) ],
44             debian => [ qw(libpcap-dev libnet-libdnet-perl) ],
45             kali => [ qw(libpcap-dev libnet-libdnet-perl) ],
46             freebsd => [ qw(p5-Net-Pcap libdnet) ],
47             },
48             };
49             }
50              
51             sub brik_use_properties {
52 0     0 1   my $self = shift;
53              
54             return {
55 0   0       attributes_default => {
56             device => defined($self->global) && $self->global->device || 'eth0',
57             },
58             };
59             }
60              
61             sub list {
62 0     0 0   my $self = shift;
63              
64 0           my $dev = {};
65 0           my $err = '';
66 0           my @devs = Net::Pcap::findalldevs($dev, \$err);
67 0 0         if (length($err)) {
    0          
68 0           return $self->log->error("list: findalldevs failed with error [$err]");
69             }
70             elsif (@devs == 0) {
71 0           return $self->log->error("list: findalldevs found no device");
72             }
73              
74 0           return \@devs;
75             }
76              
77             sub get {
78 0     0 0   my $self = shift;
79 0           my ($device) = @_;
80              
81 0   0       $device ||= $self->device;
82 0 0         $self->brik_help_run_undef_arg('get', $device) or return;
83              
84 0           my $intf = Net::Libdnet::Intf->new;
85 0 0         if (! defined($intf)) {
86 0 0         $self->enable_warnings
87             && $self->log->warning("get: Net::Libdnet::Intf new failed for device [$device]");
88 0           return {};
89             }
90              
91 0           my $get = $intf->get($device);
92 0 0         if (! defined($get)) {
93 0 0         $self->enable_warnings
94             && $self->log->error("get: Net::Libdnet::Intf get failed for device [$device]");
95 0           return {};
96             }
97              
98             # Populate HASH from Net::Libdnet::Entry::Intf object
99 0           my $dev = {
100             device => $device,
101             };
102              
103 0 0         if (my $ip = $get->ip) {
104 0           $dev->{ipv4} = $ip;
105             }
106 0 0         if (my $broadcast = $get->broadcast) {
107 0           $dev->{broadcast} = $get->broadcast;
108             }
109 0 0         if (my $netmask = $get->cidr2mask) {
110 0           $dev->{netmask} = $get->cidr2mask;
111             }
112 0 0         if (my $cidr = $get->cidr) {
113 0           $dev->{cidr} = $cidr;
114             }
115 0 0         if (my $mac = $get->linkAddr) {
116 0           $dev->{mac} = $mac;
117             }
118 0           my $cidr;
119             my $subnet;
120 0 0 0       if ($subnet = $get->subnet and $cidr = $get->cidr) {
121 0           $dev->{subnet4} = "$subnet/$cidr";
122             }
123 0           my @aliases = $get->aliasAddrs;
124 0 0         if (@aliases > 0) {
125             # IPv6 are within aliases. First one if the main IPv6 address.
126 0 0         if (defined($aliases[0])) {
127 0           my $subnet6 = $aliases[0];
128 0           (my $ipv6 = $subnet6) =~ s/\/\d+$//;
129 0           $dev->{ipv6} = $ipv6;
130 0           $dev->{subnet6} = $subnet6;
131             }
132             }
133              
134 0           return $dev;
135             }
136              
137             sub default {
138 0     0 0   my $self = shift;
139 0           my ($destination) = @_;
140              
141             # Default route to Internet using Google DNS nameserver
142 0   0       $destination ||= '8.8.8.8';
143              
144 0           my $family = Net::Routing::NR_FAMILY_INET4();
145              
146 0           my $nr = Net::Routing->new(
147             target => $destination,
148             family => $family,
149             );
150 0 0         if (! defined($nr)) {
151 0           return $self->log->error("default: new failed: $Net::Routing::Error");
152             }
153              
154 0 0         my $list = $nr->get
155             or return $self->log->error("default: get failed: $Net::Routing::Error");
156             # Only one possibility, that's great
157 0 0         if (@$list == 1) {
158 0           return $list->[0]->{interface};
159             }
160             # Or we return every possible interface
161             else {
162 0           my %interfaces = ();
163 0           for my $i (@$list) {
164 0           $interfaces{$i->{interface}}++;
165             }
166 0           return [ keys %interfaces ];
167             }
168              
169             # Error
170 0           return;
171             }
172              
173             sub show {
174 0     0 0   my $self = shift;
175 0           my ($devices) = @_;
176              
177 0 0 0       $devices ||= $self->list or return;
178              
179 0           for my $this (@$devices) {
180 0           $self->log->debug("show: found device [$this]");
181 0           my $device = $self->get($this);
182 0 0 0       if (! defined($device) || ! exists($device->{device})) {
183 0 0         $self->enable_warnings
184             && $self->log->warning("show: get failed for device [$this]");
185 0           next;
186             }
187              
188             printf("device: %s\nipv4: %s subnet4: %s\nipv6: %s subnet6: %s\n\n",
189             $device->{device} || 'undef',
190             $device->{ipv4} || 'undef',
191             $device->{subnet4} || 'undef',
192             $device->{ipv6} || 'undef',
193 0   0       $device->{subnet6} || 'undef'
      0        
      0        
      0        
      0        
194             );
195             }
196              
197 0           return 1;
198             }
199              
200             sub internet_address {
201 0     0 0   my $self = shift;
202              
203 0 0         my $cw = Metabrik::Client::Www->new_from_brik_init($self) or return;
204              
205             #my $url = 'http://ip.nu';
206 0           my $url = 'http://www.whatsmyip.net/';
207 0 0         my $get = $cw->get($url) or return;
208              
209 0           my $html = $get->{content};
210              
211 0           my ($ip) = $html =~ /(\d+\.\d+\.\d+\.\d+)/;
212              
213 0   0       return $ip || 'undef';
214             }
215              
216             sub my_ipv4 {
217 0     0 0   my $self = shift;
218 0           my ($device) = @_;
219              
220 0   0       $device ||= $self->device;
221 0 0         $self->brik_help_run_undef_arg('my_ipv4', $device) or return;
222              
223 0 0         my $get = $self->get($device) or return;
224              
225 0           my $ip = $get->{ipv4};
226 0 0         if (! defined($ip)) {
227 0           return $self->log->error("my_ipv4: IPv4 address not found for device [$device]");
228             }
229              
230 0           return $ip;
231             }
232              
233             sub my_ipv6 {
234 0     0 0   my $self = shift;
235 0           my ($device) = @_;
236              
237 0   0       $device ||= $self->device;
238 0 0         $self->brik_help_run_undef_arg('my_ipv6', $device) or return;
239              
240 0 0         my $get = $self->get($device) or return;
241              
242 0           my $ip = $get->{ipv6};
243 0 0         if (! defined($ip)) {
244 0           return $self->log->error("my_ipv6: IPv6 address not found for device [$device]");
245             }
246              
247 0           return $ip;
248             }
249              
250             1;
251              
252             __END__