1package App::Netdisco::Util::Device; 2 3use Dancer qw/:syntax :script/; 4use Dancer::Plugin::DBIC 'schema'; 5use App::Netdisco::Util::Permission qw/check_acl_no check_acl_only/; 6 7use base 'Exporter'; 8our @EXPORT = (); 9our @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/; 18our %EXPORT_TAGS = (all => \@EXPORT_OK); 19 20=head1 NAME 21 22App::Netdisco::Util::Device 23 24=head1 DESCRIPTION 25 26A set of helper subroutines to support parts of the Netdisco application. 27 28There are no default exports, however the C<:all> tag will export all 29subroutines. 30 31=head1 EXPORT_OK 32 33=head2 get_device( $ip ) 34 35Given an IP address, returns a L<DBIx::Class::Row> object for the Device in 36the Netdisco database. The IP can be for any interface on the device. 37 38If for any reason C<$ip> is already a C<DBIx::Class> Device object, then it is 39simply returned. 40 41If the device or interface IP is not known to Netdisco a new Device object is 42created for the IP, and returned. This object is in-memory only and not yet 43stored to the database. 44 45=cut 46 47sub get_device { 48 my $ip = shift; 49 return unless $ip; 50 51 # naive check for existing DBIC object 52 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 68Given an IP address, deletes the device from Netdisco, including all related 69data such as logs and nodes. If the C<$archive> parameter is true, then nodes 70will be maintained in an archive state. 71 72Returns true if the transaction completes, else returns false. 73 74=cut 75 76sub 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 102Will update all records in Netdisco referring to the device with 103C<$current_ip> to use C<$new_ip> instead, followed by renumbering the 104device itself. 105 106Returns true if the transaction completes, else returns false. 107 108=cut 109 110sub 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 134Given a C<$type> (which may be any text value), returns true if any of the 135list of regular expressions in C<$setting_name> is matched, otherwise returns 136false. 137 138=cut 139 140sub match_to_setting { 141 my ($type, $setting_name) = @_; 142 return 0 unless $type and $setting_name; 143 return (scalar grep {$type =~ m/$_/} 144 @{setting($setting_name) || []}); 145} 146 147sub _bail_msg { debug $_[0]; return 0; } 148 149=head2 is_discoverable( $ip, [$device_type, \@device_capabilities]? ) 150 151Given an IP address, returns C<true> if Netdisco on this host is permitted by 152the local configuration to discover the device. 153 154The configuration items C<discover_no> and C<discover_only> are checked 155against the given IP. 156 157If C<$device_type> is also given, then C<discover_no_type> will be checked. 158Also respects C<discover_phones> and C<discover_waps> if either are set to 159false. 160 161Also checks if the device is a pseudo device (vendor is C<netdisco>). 162 163Returns false if the host is not permitted to discover the target device. 164 165=cut 166 167sub is_discoverable { 168 my ($ip, $remote_type, $remote_cap) = @_; 169 my $device = get_device($ip) or return 0; 170 $remote_type ||= ''; 171 $remote_cap ||= []; 172 173 return _bail_msg("is_discoverable: $device is pseudo-device") 174 if $device->is_pseudo; 175 176 return _bail_msg("is_discoverable: $device matches wap_platforms but discover_waps is not enabled") 177 if ((not setting('discover_waps')) and 178 (match_to_setting($remote_type, 'wap_platforms') or 179 scalar grep {match_to_setting($_, 'wap_capabilities')} @$remote_cap)); 180 181 return _bail_msg("is_discoverable: $device matches phone_platforms but discover_phones is not enabled") 182 if ((not setting('discover_phones')) and 183 (match_to_setting($remote_type, 'phone_platforms') or 184 scalar grep {match_to_setting($_, 'phone_capabilities')} @$remote_cap)); 185 186 return _bail_msg("is_discoverable: $device matched discover_no_type") 187 if (match_to_setting($remote_type, 'discover_no_type')); 188 189 return _bail_msg("is_discoverable: $device matched discover_no") 190 if check_acl_no($device, 'discover_no'); 191 192 return _bail_msg("is_discoverable: $device failed to match discover_only") 193 unless check_acl_only($device, 'discover_only'); 194 195 return 1; 196} 197 198=head2 is_discoverable_now( $ip, $device_type? ) 199 200Same as C<is_discoverable>, but also compares the C<last_discover> field 201of the C<device> to the C<discover_min_age> configuration. 202 203Returns false if the host is not permitted to discover the target device. 204 205=cut 206 207sub is_discoverable_now { 208 my ($ip, $remote_type) = @_; 209 my $device = get_device($ip) or return 0; 210 211 if ($device->in_storage 212 and $device->since_last_discover and setting('discover_min_age') 213 and $device->since_last_discover < setting('discover_min_age')) { 214 215 return _bail_msg("is_discoverable: $device last discover < discover_min_age"); 216 } 217 218 return is_discoverable(@_); 219} 220 221=head2 is_arpnipable( $ip ) 222 223Given an IP address, returns C<true> if Netdisco on this host is permitted by 224the local configuration to arpnip the device. 225 226The configuration items C<arpnip_no> and C<arpnip_only> are checked 227against the given IP. 228 229Also checks if the device reports layer 3 capability. 230 231Returns false if the host is not permitted to arpnip the target device. 232 233=cut 234 235sub is_arpnipable { 236 my $ip = shift; 237 my $device = get_device($ip) or return 0; 238 239 return _bail_msg("is_arpnipable: $device has no layer 3 capability") 240 if ($device->in_storage() and not $device->has_layer(3)); 241 242 return _bail_msg("is_arpnipable: $device matched arpnip_no") 243 if check_acl_no($device, 'arpnip_no'); 244 245 return _bail_msg("is_arpnipable: $device failed to match arpnip_only") 246 unless check_acl_only($device, 'arpnip_only'); 247 248 return 1; 249} 250 251=head2 is_arpnipable_now( $ip ) 252 253Same as C<is_arpnipable>, but also compares the C<last_arpnip> field 254of the C<device> to the C<arpnip_min_age> configuration. 255 256Returns false if the host is not permitted to arpnip the target device. 257 258=cut 259 260sub is_arpnipable_now { 261 my ($ip) = @_; 262 my $device = get_device($ip) or return 0; 263 264 if ($device->in_storage 265 and $device->since_last_arpnip and setting('arpnip_min_age') 266 and $device->since_last_arpnip < setting('arpnip_min_age')) { 267 268 return _bail_msg("is_arpnipable: $device last arpnip < arpnip_min_age"); 269 } 270 271 return is_arpnipable(@_); 272} 273 274=head2 is_macsuckable( $ip ) 275 276Given an IP address, returns C<true> if Netdisco on this host is permitted by 277the local configuration to macsuck the device. 278 279The configuration items C<macsuck_no> and C<macsuck_only> are checked 280against the given IP. 281 282Also checks if the device reports layer 2 capability. 283 284Returns false if the host is not permitted to macsuck the target device. 285 286=cut 287 288sub is_macsuckable { 289 my $ip = shift; 290 my $device = get_device($ip) or return 0; 291 292 return _bail_msg("is_macsuckable: $device has no layer 2 capability") 293 if ($device->in_storage() and not $device->has_layer(2)); 294 295 return _bail_msg("is_macsuckable: $device matched macsuck_no") 296 if check_acl_no($device, 'macsuck_no'); 297 298 return _bail_msg("is_macsuckable: $device failed to match macsuck_only") 299 unless check_acl_only($device, 'macsuck_only'); 300 301 return 1; 302} 303 304=head2 is_macsuckable_now( $ip ) 305 306Same as C<is_macsuckable>, but also compares the C<last_macsuck> field 307of the C<device> to the C<macsuck_min_age> configuration. 308 309Returns false if the host is not permitted to macsuck the target device. 310 311=cut 312 313sub is_macsuckable_now { 314 my ($ip) = @_; 315 my $device = get_device($ip) or return 0; 316 317 if ($device->in_storage 318 and $device->since_last_macsuck and setting('macsuck_min_age') 319 and $device->since_last_macsuck < setting('macsuck_min_age')) { 320 321 return _bail_msg("is_macsuckable: $device last macsuck < macsuck_min_age"); 322 } 323 324 return is_macsuckable(@_); 325} 326 3271; 328