File Coverage

blib/lib/FusionInventory/Agent/Task/WakeOnLan.pm
Criterion Covered Total %
statement 27 119 22.6
branch 0 38 0.0
condition n/a
subroutine 9 17 52.9
pod 2 2 100.0
total 38 176 21.5


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