Profile of App/Netdisco/Util/Device.pm

Filename	/appl/netdisco/netdisco_github_official/lib/App/Netdisco/Util/Device.pm
Statements	Executed 1914 statements in 3.61ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
57	1	1	1.42ms	10.5s	App::Netdisco::Util::Device::is_discoverable
171	3	1	805µs	2.33ms	App::Netdisco::Util::Device::get_device
57	1	1	789µs	10.5s	App::Netdisco::Util::Device::is_macsuckable
57	1	1	779µs	10.5s	App::Netdisco::Util::Device::is_arpnipable
33	3	1	258µs	10.6ms	App::Netdisco::Util::Device::_bail_msg
114	2	1	184µs	184µs	App::Netdisco::Util::Device::match_to_setting
0	0	0	0s	0s	App::Netdisco::Util::Device::::BEGINApp::Netdisco::Util::Device::BEGIN
0	0	0	0s	0s	App::Netdisco::Util::Device::__ANON__[:127]
0	0	0	0s	0s	App::Netdisco::Util::Device::__ANON__[:95]
0	0	0	0s	0s	App::Netdisco::Util::Device::delete_device
0	0	0	0s	0s	App::Netdisco::Util::Device::is_arpnipable_now
0	0	0	0s	0s	App::Netdisco::Util::Device::is_discoverable_now
0	0	0	0s	0s	App::Netdisco::Util::Device::is_macsuckable_now
0	0	0	0s	0s	App::Netdisco::Util::Device::renumber_device

Call graph for these subroutines as a Graphviz dot language file.

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