File Coverage

blib/lib/FusionInventory/Agent/Task/WakeOnLan.pm
Criterion Covered Total %
statement 43 120 35.8
branch 8 38 21.0
condition n/a
subroutine 11 17 64.7
pod 2 2 100.0
total 64 177 36.1


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Task::WakeOnLan;
2              
3 3     3   22305281 use strict;
  3         11  
  3         116  
4 3     3   16 use warnings;
  3         5  
  3         148  
5 3     3   20 use base 'FusionInventory::Agent::Task';
  3         74  
  3         1776  
6              
7 3     3   15 use English qw(-no_match_vars);
  3         6  
  3         44  
8 3     3   1328 use List::Util qw(first);
  3         5  
  3         333  
9 3     3   1882 use Socket;
  3         7718  
  3         2244  
10 3     3   20 use UNIVERSAL::require;
  3         5  
  3         21  
11              
12 3     3   75 use FusionInventory::Agent::Tools;
  3         11  
  3         597  
13 3     3   1959 use FusionInventory::Agent::Tools::Network;
  3         10  
  3         5028  
14              
15             our $VERSION = '2.0';
16              
17             sub isEnabled {
18 0     0 1 0 my ($self, $response) = @_;
19              
20 0 0       0 if (!$self->{target}->isa('FusionInventory::Agent::Target::Server')) {
21 0         0 $self->{logger}->debug("WakeOnLan task not compatible with local target");
22 0         0 return;
23             }
24              
25 0         0 my @options = $response->getOptionsInfoByName('WAKEONLAN');
26 0 0       0 if (!@options) {
27 0         0 $self->{logger}->debug("WakeOnLan task execution not requested");
28 0         0 return;
29             }
30              
31 0         0 my @addresses;
32 0         0 foreach my $option (@options) {
33 0         0 foreach my $param (@{$option->{PARAM}}) {
  0         0  
34 0         0 my $address = $param->{MAC};
35 0 0       0 if ($address !~ /^$mac_address_pattern$/) {
36 0         0 $self->{logger}->error("invalid MAC address $address, skipping");
37 0         0 next;
38             }
39 0         0 $address =~ s/://g;
40 0         0 push @addresses, $address;
41             }
42             }
43              
44 0 0       0 if (!@addresses) {
45 0         0 $self->{logger}->error("no mac address defined");
46 0         0 return;
47             }
48              
49 0         0 $self->{addresses} = \@addresses;
50 0         0 return 1;
51             }
52              
53             sub run {
54 0     0 1 0 my ($self, %params) = @_;
55              
56 0 0       0 my @methods = $params{methods} ? @{$params{methods}} : qw/ethernet udp/;
  0         0  
57              
58 0         0 METHODS: foreach my $method (@methods) {
59 0         0 my $function = '_send_magic_packet_' . $method;
60 0         0 ADDRESSES: foreach my $address (@{$self->{addresses}}) {
  0         0  
61 0         0 eval {
62 0         0 $self->$function($address);
63             };
64 0 0       0 if ($EVAL_ERROR) {
65             $self->{logger}->error(
66 0         0 "Impossible to use $method method: $EVAL_ERROR"
67             );
68             # this method doesn't work, skip remaining addresses
69 0         0 last ADDRESSES;
70             }
71             }
72             # all addresses have been processed, skip other methods
73 0         0 last METHODS;
74             }
75             }
76              
77             sub _send_magic_packet_ethernet {
78 0     0   0 my ($self, $target) = @_;
79              
80 0 0       0 die "root privileges needed\n" unless $UID == 0;
81 0 0       0 die "Net::Write module needed\n" unless Net::Write::Layer2->require();
82              
83 0         0 my $interface = $self->_getInterface();
84 0         0 my $source = $interface->{MACADDR};
85 0         0 $source =~ s/://g;
86              
87 0         0 my $packet =
88             pack('H12', $target) .
89             pack('H12', $source) .
90             pack('H4', "0842") .
91             $self->_getPayload($target);
92              
93             $self->{logger}->debug(
94 0         0 "Sending magic packet to $target as ethernet frame"
95             );
96              
97             my $writer = Net::Write::Layer2->new(
98             dev => $interface->{DESCRIPTION}
99 0         0 );
100              
101 0         0 $writer->open();
102 0         0 $writer->send($packet);
103 0         0 $writer->close();
104             }
105              
106             sub _send_magic_packet_udp {
107 0     0   0 my ($self, $target) = @_;
108              
109 0 0       0 socket(my $socket, PF_INET, SOCK_DGRAM, getprotobyname('udp'))
110             or die "can't open socket: $ERRNO\n";
111 0 0       0 setsockopt($socket, SOL_SOCKET, SO_BROADCAST, 1)
112             or die "can't do setsockopt: $ERRNO\n";
113              
114 0         0 my $packet = $self->_getPayload($target);
115 0         0 my $destination = sockaddr_in("9", inet_aton("255.255.255.255"));
116              
117             $self->{logger}->debug(
118 0         0 "Sending magic packet to $target as UDP packet"
119             );
120 0 0       0 send($socket, $packet, 0, $destination)
121             or die "can't send packet: $ERRNO\n";
122 0         0 close($socket);
123             }
124              
125             sub _getInterface {
126 0     0   0 my ($self) = @_;
127              
128 0         0 my @interfaces;
129              
130             SWITCH: {
131 0 0       0 if ($OSNAME eq 'linux') {
  0         0  
132 0         0 FusionInventory::Agent::Tools::Linux->require();
133             @interfaces = FusionInventory::Agent::Tools::Linux::getInterfacesFromIfconfig(
134             logger => $self->{logger}
135 0         0 );
136 0         0 last;
137             }
138              
139 0 0       0 if ($OSNAME =~ /freebsd|openbsd|netbsd|gnukfreebsd|gnuknetbsd|dragonfly/) {
140 0         0 FusionInventory::Agent::Tools::BSD->require();
141             @interfaces = FusionInventory::Agent::Tools::BSD::getInterfacesFromIfconfig(
142             logger => $self->{logger}
143 0         0 );
144 0         0 last;
145             }
146              
147 0 0       0 if ($OSNAME eq 'MSWin32') {
148 0         0 FusionInventory::Agent::Tools::Win32->require();
149             @interfaces = FusionInventory::Agent::Tools::Win32::getInterfaces(
150             logger => $self->{logger}
151 0         0 );
152 0         0 last;
153             }
154             }
155              
156             # let's take the first interface with an IP adress, a MAC address
157             # different from the loopback
158             my $interface =
159 0     0   0 first { $_->{DESCRIPTION} ne 'lo' }
160 0         0 grep { $_->{IPADDRESS} }
161 0         0 grep { $_->{MACADDR} }
  0         0  
162             @interfaces;
163              
164             # on Windows, we have to use internal device name instead of litteral name
165             $interface->{DESCRIPTION} =
166             $self->_getWin32InterfaceId($interface->{PNPDEVICEID})
167 0 0       0 if $OSNAME eq 'MSWin32';
168              
169 0         0 return $interface;
170             }
171              
172             sub _getPayload {
173 2     2   1114 my ($self, $target) = @_;
174              
175             return
176 2         16 pack('H12', 'FF' x 6) .
177             pack('H12', $target) x 16;
178             }
179              
180             sub _getWin32InterfaceId {
181 2     2   941 my ($self, $pnpid) = @_;
182              
183 2         26 FusionInventory::Agent::Tools::Win32->require();
184              
185 2         93 my $key = FusionInventory::Agent::Tools::Win32::getRegistryKey(
186             path => "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Network",
187             );
188              
189 2         55742 foreach my $subkey_id (keys %$key) {
190             # we're only interested in GUID subkeys
191 20 100       72 next unless $subkey_id =~ /^\{\S+\}\/$/;
192 9         20 my $subkey = $key->{$subkey_id};
193 9         48 foreach my $subsubkey_id (keys %$subkey) {
194 89         174 my $subsubkey = $subkey->{$subsubkey_id};
195 89 100       244 next unless $subsubkey->{'Connection/'};
196 27 100       72 next unless $subsubkey->{'Connection/'}->{'/PnpInstanceID'};
197 4 100       16 next unless $subsubkey->{'Connection/'}->{'/PnpInstanceID'} eq $pnpid;
198 2         5 my $device_id = $subsubkey_id;
199 2         12 $device_id =~ s{/$}{};
200              
201 2         176 return '\Device\NPF_' . $device_id;
202             }
203             }
204              
205             }
206              
207             1;
208             __END__