1package App::Netdisco::DB::ResultSet::Device; 2use base 'App::Netdisco::DB::ResultSet'; 3 4use strict; 5use warnings; 6 7use Try::Tiny; 8use Regexp::Common 'net'; 9use NetAddr::IP::Lite ':lower'; 10use NetAddr::MAC (); 11 12require Dancer::Logger; 13 14=head1 ADDITIONAL METHODS 15 16=head2 device_ips_with_address_or_name( $address_or_name ) 17 18Returns a correlated subquery for the set of C<device_ip> entries for each 19device. The IP alias or dns matches the supplied C<address_or_name>, using 20C<ILIKE>. 21 22=cut 23 24sub device_ips_with_address_or_name { 25 my ($rs, $q, $ipbind) = @_; 26 $q ||= '255.255.255.255/32'; 27 28 return $rs->search(undef,{ 29 # NOTE: bind param list order is significant 30 join => ['device_ips_by_address_or_name'], 31 bind => [$q, $ipbind, $q], 32 }); 33} 34 35=head2 ports_with_mac( $mac ) 36 37Returns a correlated subquery for the set of C<device_port> entries for each 38device. The port MAC address matches the supplied C<mac>, using C<ILIKE>. 39 40=cut 41 42sub ports_with_mac { 43 my ($rs, $mac) = @_; 44 $mac ||= '00:00:00:00:00:00'; 45 46 return $rs->search(undef,{ 47 # NOTE: bind param list order is significant 48 join => ['ports_by_mac'], 49 bind => [$mac], 50 }); 51} 52 53=head2 with_times 54 55This is a modifier for any C<search()> (including the helpers below) which 56will add the following additional synthesized columns to the result set: 57 58=over 4 59 60=item uptime_age 61 62=item first_seen_stamp 63 64=item last_discover_stamp 65 66=item last_macsuck_stamp 67 68=item last_arpnip_stamp 69 70=item since_first_seen 71 72=item since_last_discover 73 74=item since_last_macsuck 75 76=item since_last_arpnip 77 78=back 79 80=cut 81 82sub with_times { 83 my ($rs, $cond, $attrs) = @_; 84 85 return $rs 86 ->search_rs($cond, $attrs) 87 ->search({}, 88 { 89 '+columns' => { 90 uptime_age => \("replace(age(timestamp 'epoch' + me.uptime / 100 * interval '1 second', " 91 ."timestamp '1970-01-01 00:00:00-00')::text, 'mon', 'month')"), 92 first_seen_stamp => \"to_char(me.creation, 'YYYY-MM-DD HH24:MI')", 93 last_discover_stamp => \"to_char(me.last_discover, 'YYYY-MM-DD HH24:MI')", 94 last_macsuck_stamp => \"to_char(me.last_macsuck, 'YYYY-MM-DD HH24:MI')", 95 last_arpnip_stamp => \"to_char(me.last_arpnip, 'YYYY-MM-DD HH24:MI')", 96 since_first_seen => \"extract(epoch from (age(now(), me.creation)))", 97 since_last_discover => \"extract(epoch from (age(now(), me.last_discover)))", 98 since_last_macsuck => \"extract(epoch from (age(now(), me.last_macsuck)))", 99 since_last_arpnip => \"extract(epoch from (age(now(), me.last_arpnip)))", 100 }, 101 }); 102} 103 104=head2 search_aliases( {$name or $ip or $prefix}, \%options? ) 105 106Tries to find devices in Netdisco which have an identity corresponding to 107C<$name>, C<$ip> or C<$prefix>. 108 109The search is across all aliases of the device, as well as its "root IP" 110identity. Note that this search will try B<not> to use DNS, in case the current 111name for an IP does not correspond to the data within Netdisco. 112 113Passing a zero value to the C<partial> key of the C<options> hashref will 114prevent partial matching of a host name. Otherwise the default is to perform 115a partial, case-insensitive search on the host name fields. 116 117=cut 118 119sub search_aliases { 120 my ($rs, $q, $options) = @_; 121 $q ||= '255.255.255.255'; # hack to return empty resultset on error 122 $options ||= {}; 123 $options->{partial} = 1 if !defined $options->{partial}; 124 125 # rough approximation of IP addresses (v4 in v6 not supported). 126 # this helps us avoid triggering any DNS. 127 my $by_ip = ($q =~ m{^(?:$RE{net}{IPv4}|$RE{net}{IPv6})$}i) ? 1 : 0; 128 129 my $clause; 130 if ($by_ip) { 131 my $ip = NetAddr::IP::Lite->new($q) 132 or return undef; # could be a MAC address! 133 $clause = [ 134 'me.ip' => { '<<=' => $ip->cidr }, 135 'device_ips.alias' => { '<<=' => $ip->cidr }, 136 ]; 137 } 138 else { 139 $q = "\%$q\%" if ($options->{partial} and $q !~ m/\%/); 140 $clause = [ 141 'me.name' => { '-ilike' => $q }, 142 'me.dns' => { '-ilike' => $q }, 143 'device_ips.dns' => { '-ilike' => $q }, 144 ]; 145 } 146 147 return $rs->search( 148 { 149 -or => $clause, 150 }, 151 { 152 order_by => [qw/ me.dns me.ip /], 153 join => 'device_ips', 154 distinct => 1, 155 } 156 ); 157} 158 159=head2 search_for_device( $name or $ip or $prefix ) 160 161This is a wrapper for C<search_aliases> which: 162 163=over 4 164 165=item * 166 167Disables partial matching on host names 168 169=item * 170 171Returns only the first result of any found devices 172 173=back 174 175If no matching devices are found, C<undef> is returned. 176 177=cut 178 179sub search_for_device { 180 my ($rs, $q, $options) = @_; 181 $options ||= {}; 182 $options->{partial} = 0; 183 return $rs->search_aliases($q, $options)->first(); 184} 185 186=head2 search_by_field( \%cond, \%attrs? ) 187 188This variant of the standard C<search()> method returns a ResultSet of Device 189entries. It is written to support web forms which accept fields that match and 190locate Devices in the database. 191 192The hashref parameter should contain fields from the Device table which will 193be intelligently used in a search query. 194 195In addition, you can provide the key C<matchall> which, given a True or False 196value, controls whether fields must all match or whether any can match, to 197select a row. 198 199Supported keys: 200 201=over 4 202 203=item matchall 204 205If a True value, fields must all match to return a given row of the Device 206table, otherwise any field matching will cause the row to be included in 207results. 208 209=item name 210 211Can match the C<name> field as a substring. 212 213=item location 214 215Can match the C<location> field as a substring. 216 217=item description 218 219Can match the C<description> field as a substring (usually this field contains 220a description of the vendor operating system). 221 222=item mac 223 224Will match exactly the C<mac> field of the Device or any of its Interfaces. 225 226=item model 227 228Will match exactly the C<model> field. 229 230=item os 231 232Will match exactly the C<os> field, which is the operating system. 233 234=item os_ver 235 236Will match exactly the C<os_ver> field, which is the operating system software version. 237 238=item vendor 239 240Will match exactly the C<vendor> (manufacturer). 241 242=item dns 243 244Can match any of the Device IP address aliases as a substring. 245 246=item ip 247 248Can be a string IP or a NetAddr::IP object, either way being treated as an 249IPv4 or IPv6 prefix within which the device must have one IP address alias. 250 251=item layers 252 253OSI Layers which the device must support. 254 255=back 256 257=cut 258 259sub search_by_field { 260 my ($rs, $p, $attrs) = @_; 261 262 die "condition parameter to search_by_field must be hashref\n" 263 if ref {} ne ref $p or 0 == scalar keys %$p; 264 265 my $op = $p->{matchall} ? '-and' : '-or'; 266 267 # this is a bit of an inelegant trick to catch junk data entry, 268 # whilst avoiding returning *all* entries in the table 269 if ($p->{ip} and 'NetAddr::IP::Lite' ne ref $p->{ip}) { 270 $p->{ip} = ( NetAddr::IP::Lite->new($p->{ip}) 271 || NetAddr::IP::Lite->new('255.255.255.255') ); 272 } 273 274 # For Search on Layers 275 my $layers = $p->{layers}; 276 my @layer_select = (); 277 if ( defined $layers && ref $layers ) { 278 foreach my $layer (@$layers) { 279 next unless defined $layer and length($layer); 280 next if ( $layer < 1 || $layer > 7 ); 281 push @layer_select, 282 \[ 'substring(me.layers,9-?, 1)::int = 1', $layer ]; 283 } 284 } 285 elsif ( defined $layers ) { 286 push @layer_select, 287 \[ 'substring(me.layers,9-?, 1)::int = 1', $layers ]; 288 } 289 290 # get IEEE MAC format 291 my $mac = NetAddr::MAC->new(mac => ($p->{mac} || '')); 292 undef $mac if 293 ($mac and $mac->as_ieee 294 and (($mac->as_ieee eq '00:00:00:00:00:00') 295 or ($mac->as_ieee !~ m/$RE{net}{MAC}/))); 296 297 return $rs 298 ->search_rs({}, $attrs) 299 ->search({ 300 $op => [ 301 ($p->{name} ? ('me.name' => 302 { '-ilike' => "\%$p->{name}\%" }) : ()), 303 ($p->{location} ? ('me.location' => 304 { '-ilike' => "\%$p->{location}\%" }) : ()), 305 ($p->{description} ? ('me.description' => 306 { '-ilike' => "\%$p->{description}\%" }) : ()), 307 308 ($mac ? ( 309 -or => [ 310 'me.mac' => $mac->as_ieee, 311 'ports.mac' => $mac->as_ieee, 312 ]) : ()), 313 314 ($p->{model} ? ('me.model' => 315 { '-in' => $p->{model} }) : ()), 316 ($p->{os} ? ('me.os' => 317 { '-in' => $p->{os} }) : ()), 318 ($p->{os_ver} ? ('me.os_ver' => 319 { '-in' => $p->{os_ver} }) : ()), 320 ($p->{vendor} ? ('me.vendor' => 321 { '-in' => $p->{vendor} }) : ()), 322 323 ($p->{layers} ? (-or => \@layer_select) : ()), 324 325 ($p->{dns} ? ( 326 -or => [ 327 'me.dns' => { '-ilike' => "\%$p->{dns}\%" }, 328 'device_ips.dns' => { '-ilike' => "\%$p->{dns}\%" }, 329 ]) : ()), 330 331 ($p->{ip} ? ( 332 -or => [ 333 'me.ip' => { '<<=' => $p->{ip}->cidr }, 334 'device_ips.alias' => { '<<=' => $p->{ip}->cidr }, 335 ]) : ()), 336 ], 337 }, 338 { 339 order_by => [qw/ me.dns me.ip /], 340 (($p->{dns} or $p->{ip}) ? ( 341 join => [qw/device_ips ports/], 342 distinct => 1, 343 ) : ()), 344 } 345 ); 346} 347 348=head2 search_fuzzy( $value ) 349 350This method accepts a single parameter only and returns a ResultSet of rows 351from the Device table where one field matches the passed parameter. 352 353The following fields are inspected for a match: 354 355=over 4 356 357=item contact 358 359=item serial 360 361=item module serials (exact) 362 363=item location 364 365=item name 366 367=item mac (including port addresses) 368 369=item description 370 371=item dns 372 373=item ip (including aliases) 374 375=back 376 377=cut 378 379sub search_fuzzy { 380 my ($rs, $q) = @_; 381 382 die "missing param to search_fuzzy\n" 383 unless $q; 384 $q = "\%$q\%" if $q !~ m/\%/; 385 (my $qc = $q) =~ s/\%//g; 386 387 # basic IP check is a string match 388 my $ip_clause = [ 389 'me.ip::text' => { '-ilike' => $q }, 390 'device_ips_by_address_or_name.alias::text' => { '-ilike' => $q }, 391 ]; 392 my $ipbind = '255.255.255.255/32'; 393 394 # but also allow prefix search 395 if (my $ip = NetAddr::IP::Lite->new($qc)) { 396 $ip_clause = [ 397 'me.ip' => { '<<=' => $ip->cidr }, 398 'device_ips_by_address_or_name.alias' => { '<<=' => $ip->cidr }, 399 ]; 400 $ipbind = $ip->cidr; 401 } 402 403 # get IEEE MAC format 404 my $mac = NetAddr::MAC->new(mac => ($q || '')); 405 undef $mac if 406 ($mac and $mac->as_ieee 407 and (($mac->as_ieee eq '00:00:00:00:00:00') 408 or ($mac->as_ieee !~ m/$RE{net}{MAC}/))); 409 $mac = ($mac ? $mac->as_ieee : $q); 410 411 return $rs->ports_with_mac($mac) 412 ->device_ips_with_address_or_name($q, $ipbind) 413 ->search( 414 { 415 -or => [ 416 'me.contact' => { '-ilike' => $q }, 417 'me.serial' => { '-ilike' => $q }, 418 'me.location' => { '-ilike' => $q }, 419 'me.name' => { '-ilike' => $q }, 420 'me.description' => { '-ilike' => $q }, 421 'me.ip' => { '-in' => 422 $rs->search({ 'modules.serial' => $qc }, 423 { join => 'modules', columns => 'ip' })->as_query() 424 }, 425 -or => [ 426 'me.mac::text' => { '-ilike' => $mac}, 427 'ports_by_mac.mac::text' => { '-ilike' => $mac}, 428 ], 429 -or => [ 430 'me.dns' => { '-ilike' => $q }, 431 'device_ips_by_address_or_name.dns' => { '-ilike' => $q }, 432 ], 433 -or => $ip_clause, 434 ], 435 }, 436 { 437 order_by => [qw/ me.dns me.ip /], 438 distinct => 1, 439 } 440 ); 441} 442 443=head2 carrying_vlan( \%cond, \%attrs? ) 444 445 my $set = $rs->carrying_vlan({ vlan => 123 }); 446 447Like C<search()>, this returns a ResultSet of matching rows from the Device 448table. 449 450The returned devices each are aware of the given Vlan. 451 452=over 4 453 454=item * 455 456The C<cond> parameter must be a hashref containing a key C<vlan> with 457the value to search for. 458 459=item * 460 461Results are ordered by the Device DNS and IP fields. 462 463=item * 464 465Column C<pcount> gives a count of the number of ports on the device 466that are actually configured to carry the VLAN. 467 468=back 469 470=cut 471 472sub carrying_vlan { 473 my ($rs, $cond, $attrs) = @_; 474 475 die "vlan number required for carrying_vlan\n" 476 if ref {} ne ref $cond or !exists $cond->{vlan}; 477 478 return $rs unless $cond->{vlan}; 479 480 return $rs 481 ->search_rs({ 'vlans.vlan' => $cond->{vlan} }, 482 { 483 order_by => [qw/ me.dns me.ip /], 484 select => [{ count => 'ports.vlan' }], 485 as => ['pcount'], 486 columns => [ 487 'me.ip', 'me.dns', 488 'me.model', 'me.os', 489 'me.vendor', 'vlans.vlan', 490 'vlans.description' 491 ], 492 join => {'vlans' => 'ports'}, 493 distinct => 1, 494 }) 495 ->search({}, $attrs); 496} 497 498=head2 carrying_vlan_name( \%cond, \%attrs? ) 499 500 my $set = $rs->carrying_vlan_name({ name => 'Branch Office' }); 501 502Like C<search()>, this returns a ResultSet of matching rows from the Device 503table. 504 505The returned devices each are aware of the named Vlan. 506 507=over 4 508 509=item * 510 511The C<cond> parameter must be a hashref containing a key C<name> with 512the value to search for. The value may optionally include SQL wildcard 513characters. 514 515=item * 516 517Results are ordered by the Device DNS and IP fields. 518 519=item * 520 521Column C<pcount> gives a count of the number of ports on the device 522that are actually configured to carry the VLAN. 523 524=back 525 526=cut 527 528sub carrying_vlan_name { 529 my ($rs, $cond, $attrs) = @_; 530 531 die "vlan name required for carrying_vlan_name\n" 532 if ref {} ne ref $cond or !exists $cond->{name}; 533 534 $cond->{'vlans.vlan'} = { '>' => 0 }; 535 $cond->{'vlans.description'} = { '-ilike' => delete $cond->{name} }; 536 537 return $rs 538 ->search_rs({}, { 539 order_by => [qw/ me.dns me.ip /], 540 select => [{ count => 'ports.vlan' }], 541 as => ['pcount'], 542 columns => [ 543 'me.ip', 'me.dns', 544 'me.model', 'me.os', 545 'me.vendor', 'vlans.vlan', 546 'vlans.description' 547 ], 548 join => {'vlans' => 'ports'}, 549 distinct => 1, 550 }) 551 ->search($cond, $attrs); 552} 553 554=head2 has_layer( $layer ) 555 556 my $rset = $rs->has_layer(3); 557 558This predefined C<search()> returns a ResultSet of matching rows from the 559Device table of devices advertising support of the supplied layer in the 560OSI Model. 561 562=over 4 563 564=item * 565 566The C<layer> parameter must be an integer between 1 and 7. 567 568=cut 569 570sub has_layer { 571 my ( $rs, $layer ) = @_; 572 573 die "layer required and must be between 1 and 7\n" 574 if !$layer || $layer < 1 || $layer > 7; 575 576 return $rs->search_rs( \[ 'substring(layers,9-?, 1)::int = 1', $layer ] ); 577} 578 579=back 580 581=head2 get_platforms 582 583Returns a sorted list of Device models with the following columns only: 584 585=over 4 586 587=item vendor 588 589=item model 590 591=item count 592 593=back 594 595Where C<count> is the number of instances of that Vendor's Model in the 596Netdisco database. 597 598=cut 599 600sub get_platforms { 601 my $rs = shift; 602 return $rs->search({}, { 603 'columns' => [ 'vendor', 'model' ], 604 '+select' => [{ count => 'ip' }], 605 '+as' => ['count'], 606 group_by => [qw/vendor model/], 607 order_by => [{-asc => 'vendor'}, {-asc => 'model'}], 608 }); 609} 610 611=head2 get_releases 612 613Returns a sorted list of Device OS releases with the following columns only: 614 615=over 4 616 617=item os 618 619=item os_ver 620 621=item count 622 623=back 624 625Where C<count> is the number of devices running that OS release in the 626Netdisco database. 627 628=cut 629 630sub get_releases { 631 my $rs = shift; 632 return $rs->search({}, { 633 columns => ['os', 'os_ver'], 634 '+select' => [ { count => 'ip' } ], 635 '+as' => [qw/count/], 636 group_by => [qw/os os_ver/], 637 order_by => [{-asc => 'os'}, {-asc => 'os_ver'}], 638 }) 639 640} 641 642=head2 with_port_count 643 644This is a modifier for any C<search()> which 645will add the following additional synthesized column to the result set: 646 647=over 4 648 649=item port_count 650 651=back 652 653=cut 654 655sub with_port_count { 656 my ($rs, $cond, $attrs) = @_; 657 658 return $rs 659 ->search_rs($cond, $attrs) 660 ->search({}, 661 { 662 '+columns' => { 663 port_count => 664 $rs->result_source->schema->resultset('DevicePort') 665 ->search( 666 { 667 'dp.ip' => { -ident => 'me.ip' }, 668 'dp.type' => { '!=' => 'propVirtual' }, 669 }, 670 { alias => 'dp' } 671 )->count_rs->as_query, 672 }, 673 }); 674} 675 676=head1 SPECIAL METHODS 677 678=head2 delete( \%options? ) 679 680Overrides the built-in L<DBIx::Class> delete method to more efficiently 681handle the removal or archiving of nodes. 682 683=cut 684 685sub _plural { (shift || 0) == 1 ? 'entry' : 'entries' }; 686 687sub delete { 688 my $self = shift; 689 690 my $schema = $self->result_source->schema; 691 my $devices = $self->search(undef, { columns => 'ip' }); 692 693 my $ip = undef; 694 { 695 no autovivification; 696 try { $ip ||= $devices->{attrs}->{where}->{ip} }; 697 try { $ip ||= $devices->{attrs}->{where}->{'me.ip'} }; 698 } 699 $ip ||= 'netdisco'; 700 701 foreach my $set (qw/ 702 DeviceIp 703 DeviceVlan 704 DevicePower 705 DeviceModule 706 Community 707 /) { 708 my $gone = $schema->resultset($set)->search( 709 { ip => { '-in' => $devices->as_query } }, 710 )->delete; 711 712 Dancer::Logger::debug sprintf ' [%s] db/device - removed %d %s from %s', 713 $ip, $gone, _plural($gone), $set if defined Dancer::Logger::logger(); 714 } 715 716 foreach my $set (qw/ 717 Admin 718 DeviceSkip 719 /) { 720 $schema->resultset($set)->search( 721 { device => { '-in' => $devices->as_query } }, 722 )->delete; 723 } 724 725 my $gone = $schema->resultset('Topology')->search({ 726 -or => [ 727 { dev1 => { '-in' => $devices->as_query } }, 728 { dev2 => { '-in' => $devices->as_query } }, 729 ], 730 })->delete; 731 732 Dancer::Logger::debug sprintf ' [%s] db/device - removed %d manual topology %s', 733 $ip, $gone, _plural($gone) if defined Dancer::Logger::logger(); 734 735 $schema->resultset('DevicePort')->search( 736 { ip => { '-in' => $devices->as_query } }, 737 )->delete(@_); 738 739 # now let DBIC do its thing 740 return $self->next::method(); 741} 742 7431; 744