-
-
Notifications
You must be signed in to change notification settings - Fork 72
/
Device.pm
329 lines (229 loc) · 9.19 KB
/
Device.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
package App::Netdisco::Util::Device;
use Dancer qw/:syntax :script/;
use Dancer::Plugin::DBIC 'schema';
use App::Netdisco::Util::Permission qw/check_acl_no check_acl_only/;
use base 'Exporter';
our @EXPORT = ();
our @EXPORT_OK = qw/
get_device
delete_device
renumber_device
match_to_setting
is_discoverable is_discoverable_now
is_arpnipable is_arpnipable_now
is_macsuckable is_macsuckable_now
/;
our %EXPORT_TAGS = (all => \@EXPORT_OK);
=head1 NAME
App::Netdisco::Util::Device
=head1 DESCRIPTION
A set of helper subroutines to support parts of the Netdisco application.
There are no default exports, however the C<:all> tag will export all
subroutines.
=head1 EXPORT_OK
=head2 get_device( $ip )
Given an IP address, returns a L<DBIx::Class::Row> object for the Device in
the Netdisco database. The IP can be for any interface on the device.
If for any reason C<$ip> is already a C<DBIx::Class> Device object, then it is
simply returned.
If the device or interface IP is not known to Netdisco a new Device object is
created for the IP, and returned. This object is in-memory only and not yet
stored to the database.
=cut
sub get_device {
my $ip = shift;
return unless $ip;
# naive check for existing DBIC object
return $ip if ref $ip;
# in case the management IP of one device is in use on another device,
# we first try to get an exact match for the IP as mgmt interface.
my $alias =
schema('netdisco')->resultset('DeviceIp')->find($ip, $ip)
||
schema('netdisco')->resultset('DeviceIp')->search({alias => $ip})->first;
$ip = $alias->ip if defined $alias;
return schema('netdisco')->resultset('Device')->with_times
->find_or_new({ip => $ip});
}
=head2 delete_device( $ip, $archive? )
Given an IP address, deletes the device from Netdisco, including all related
data such as logs and nodes. If the C<$archive> parameter is true, then nodes
will be maintained in an archive state.
Returns true if the transaction completes, else returns false.
=cut
sub delete_device {
my ($ip, $archive, $log) = @_;
my $device = get_device($ip) or return 0;
return 0 if not $device->in_storage;
my $happy = 0;
schema('netdisco')->txn_do(sub {
# will delete everything related too...
schema('netdisco')->resultset('Device')
->search({ ip => $device->ip })->delete({archive_nodes => $archive});
schema('netdisco')->resultset('UserLog')->create({
username => session('logged_in_user'),
userip => scalar eval {request->remote_address},
event => (sprintf "Delete device %s", $device->ip),
details => $log,
});
$happy = 1;
});
return $happy;
}
=head2 renumber_device( $current_ip, $new_ip )
Will update all records in Netdisco referring to the device with
C<$current_ip> to use C<$new_ip> instead, followed by renumbering the
device itself.
Returns true if the transaction completes, else returns false.
=cut
sub renumber_device {
my ($ip, $new_ip) = @_;
my $device = get_device($ip) or return 0;
return 0 if not $device->in_storage;
my $happy = 0;
schema('netdisco')->txn_do(sub {
$device->renumber($new_ip)
or die "cannot renumber to: $new_ip"; # rollback
schema('netdisco')->resultset('UserLog')->create({
username => session('logged_in_user'),
userip => scalar eval {request->remote_address},
event => (sprintf "Renumber device %s to %s", $ip, $new_ip),
});
$happy = 1;
});
return $happy;
}
=head2 match_to_setting( $type, $setting_name )
Given a C<$type> (which may be any text value), returns true if any of the
list of regular expressions in C<$setting_name> is matched, otherwise returns
false.
=cut
sub match_to_setting {
my ($type, $setting_name) = @_;
return 0 unless $type and $setting_name;
return (scalar grep {$type =~ m/$_/}
@{setting($setting_name) || []});
}
sub _bail_msg { debug $_[0]; return 0; }
=head2 is_discoverable( $ip, [$device_type, \@device_capabilities]? )
Given an IP address, returns C<true> if Netdisco on this host is permitted by
the local configuration to discover the device.
The configuration items C<discover_no> and C<discover_only> are checked
against the given IP.
If C<$device_type> is also given, then C<discover_no_type> will be checked.
Also respects C<discover_phones> and C<discover_waps> if either are set to
false.
Returns false if the host is not permitted to discover the target device.
=cut
sub is_discoverable {
my ($ip, $remote_type, $remote_cap) = @_;
my $device = get_device($ip) or return 0;
$remote_type ||= '';
$remote_cap ||= [];
return _bail_msg("is_discoverable: $device matches wap_platforms but discover_waps is not enabled")
if ((not setting('discover_waps')) and
(match_to_setting($remote_type, 'wap_platforms') or
scalar grep {match_to_setting($_, 'wap_capabilities')} @$remote_cap));
return _bail_msg("is_discoverable: $device matches phone_platforms but discover_phones is not enabled")
if ((not setting('discover_phones')) and
(match_to_setting($remote_type, 'phone_platforms') or
scalar grep {match_to_setting($_, 'phone_capabilities')} @$remote_cap));
return _bail_msg("is_discoverable: $device matched discover_no_type")
if (match_to_setting($remote_type, 'discover_no_type'));
return _bail_msg("is_discoverable: $device matched discover_no")
if check_acl_no($device, 'discover_no');
return _bail_msg("is_discoverable: $device failed to match discover_only")
unless check_acl_only($device, 'discover_only');
return 1;
}
=head2 is_discoverable_now( $ip, $device_type? )
Same as C<is_discoverable>, but also checks the last_discover field if the
device is in storage, and returns false if that host has been too recently
discovered.
Returns false if the host is not permitted to discover the target device.
=cut
sub is_discoverable_now {
my ($ip, $remote_type) = @_;
my $device = get_device($ip) or return 0;
if ($device->in_storage
and $device->since_last_discover and setting('discover_min_age')
and $device->since_last_discover < setting('discover_min_age')) {
return _bail_msg("is_discoverable: $device last discover < discover_min_age");
}
return is_discoverable(@_);
}
=head2 is_arpnipable( $ip )
Given an IP address, returns C<true> if Netdisco on this host is permitted by
the local configuration to arpnip the device.
The configuration items C<arpnip_no> and C<arpnip_only> are checked
against the given IP.
Returns false if the host is not permitted to arpnip the target device.
=cut
sub is_arpnipable {
my $ip = shift;
my $device = get_device($ip) or return 0;
return _bail_msg("is_arpnipable: $device matched arpnip_no")
if check_acl_no($device, 'arpnip_no');
return _bail_msg("is_arpnipable: $device failed to match arpnip_only")
unless check_acl_only($device, 'arpnip_only');
return 1;
}
=head2 is_arpnipable_now( $ip )
Same as C<is_arpnipable>, but also compares the C<last_arpnip> field
of the C<device> to the C<arpnip_min_age> configuration. Also checks
for pseudo devices and for devices not supporting layer 3, with some
exceptions.
Returns false if the host is not permitted to arpnip the target device.
=cut
sub is_arpnipable_now {
my ($ip) = @_;
my $device = get_device($ip) or return 0;
return _bail_msg("is_arpnipable: $device is pseudo-device")
if $device->is_pseudo;
return _bail_msg("is_arpnipable: $device has no layer 3 capability")
unless $device->has_layer(3);
if ($device->in_storage
and $device->since_last_arpnip and setting('arpnip_min_age')
and $device->since_last_arpnip < setting('arpnip_min_age')) {
return _bail_msg("is_arpnipable: $device last arpnip < arpnip_min_age");
}
return is_arpnipable(@_);
}
=head2 is_macsuckable( $ip )
Given an IP address, returns C<true> if Netdisco on this host is permitted by
the local configuration to macsuck the device.
The configuration items C<macsuck_no> and C<macsuck_only> are checked
against the given IP.
Returns false if the host is not permitted to macsuck the target device.
=cut
sub is_macsuckable {
my $ip = shift;
my $device = get_device($ip) or return 0;
return _bail_msg("is_macsuckable: $device matched macsuck_no")
if check_acl_no($device, 'macsuck_no');
return _bail_msg("is_macsuckable: $device failed to match macsuck_only")
unless check_acl_only($device, 'macsuck_only');
return 1;
}
=head2 is_macsuckable_now( $ip )
Same as C<is_macsuckable>, but also compares the C<last_macsuck> field
of the C<device> to the C<macsuck_min_age> configuration. Also checks
for pseudo devices and for devices not supporting layer 2, with some
exceptions.
Returns false if the host is not permitted to macsuck the target device.
=cut
sub is_macsuckable_now {
my ($ip) = @_;
my $device = get_device($ip) or return 0;
return _bail_msg("is_macsuckable: $device is pseudo-device")
if $device->is_pseudo;
return _bail_msg("is_macsuckable: $device has no layer 2 capability")
unless $device->has_layer(2);
if ($device->in_storage
and $device->since_last_macsuck and setting('macsuck_min_age')
and $device->since_last_macsuck < setting('macsuck_min_age')) {
return _bail_msg("is_macsuckable: $device last macsuck < macsuck_min_age");
}
return is_macsuckable(@_);
}
1;