view release on metacpan or  search on metacpan

xt/192-discover-vrf-collection.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict; use warnings;
no warnings 'once'; # local *glob = sub {} overrides below are single-use by design

BEGIN { $ENV{DANCER_ENVDIR} = '/dev/null'; }

use Test::More 0.88;
use Test::File::ShareDir::Dist { 'App-Netdisco' => 'share/' };

use lib 'xt/lib';

use App::Netdisco;
use App::Netdisco::DB;
use App::Netdisco::DB::Upsert ();
use App::Netdisco::Backend::Job;
use App::Netdisco::Transport::SNMP ();
use App::Netdisco::Worker::Plugin::Discover::Properties ();
use App::Netdisco::Worker::Plugin::Discover::Properties::Tags ();

use Try::Tiny;
use List::Util ();
use Dancer qw/:moose :script !pass/;

# The alias worker with store_vrfs on, run as in xt/167: SNMP and storage are
# stubbed and upsert and remove_unseen record their rows. The fake session
# answers a VRF's readers only in that VRF's context, so a read in the wrong
# context returns nothing, as SNMP::Info does.

my $CONFIG = config();
$CONFIG->{logger} = 'console';
$CONFIG->{log} = ($ENV{'DANCER_DEBUG'} ? 'debug' : 'error');
Dancer::Logger->init('console', $CONFIG);

{
  package MyWorker;
  use Moo;
  with 'App::Netdisco::Worker::Runner';
}

config->{'device_auth'} = [{driver => 'snmp'}];
config->{'enable_field_protection'} = 0;
config->{'enable_incomplete_walk_protection'} = 1;
config->{'ignore_deviceports'} = [];
config->{'ignore_private_nets'} = 0;
config->{'dns'}->{'no'} = ['0.0.0.0/0'];

our @events;

package FakeSNMP;
our $AUTOLOAD;
{ package NoopTagsSchema; sub resultset { return $_[0] } sub search { return $_[0] } sub update { return 0 } }

sub new {
  my ($class, %vals) = @_;
  return bless { walk_failures => [], context => '', contexts_asked => [], %vals }, $class;
}
sub walk_failures { $_[0]{walk_failures} }
# the latest outcome of a method, by the context it was walked in
sub walk_status { my ($self, $method) = @_; return $self->{walk_status_in}{ $self->{context} }{$method} }
sub snmp_ver { $_[0]{snmp_ver} || 2 }
sub snmp_comm { 'public' }
sub update {
  my ($self, %args) = @_;
  $self->{context} = exists $args{Context} ? $args{Context}
    : ($args{Community} =~ m/\@(.+)$/ ? $1 : '');
  push @{ $self->{contexts_asked} }, $self->{context};
  # a reconnect that fails after the session already moved
  die "update failed\n" if $self->{die_on_update_to}
    and $self->{context} eq $self->{die_on_update_to};
  return 1;
}

# the context SNMP::Info would expect the session in for this instance
sub _context_of {
  my ($self, $name) = @_;
  my $ctx = $self->{instances}{$name}{contexts}[0];
  return '' if not $ctx or ($ctx->{kind} || '') eq 'none';
  return $ctx->{id};
}
sub _in_default { return $_[0]{context} eq '' }

sub vrf_instances {
  my $self = shift;
  $self->{reads}{vrf_instances}++;
  return $self->_in_default ? $self->{instances} : undef;
}
sub vrf_instances_complete {
  my $self = shift;
  $self->{reads}{vrf_instances_complete}++;
  return $self->_in_default ? $self->{instances_complete} : undef;
}
sub interfaces {
  my $self = shift;
  # a cut-short walk records itself, as SNMP::Info's walk_failures does
  push @{ $self->{walk_failures} }, $self->{fail_interfaces_in}{ $self->{context} }
    if $self->{fail_interfaces_in}{ $self->{context} };
  return $self->{interfaces} if $self->_in_default;
  return $self->{context_interfaces}{ $self->{context} };
}
sub _vrf_answer {
  my ($self, $what, $name) = @_;
  push @{ $self->{vrf_reads}{$name} }, $what;
  return undef unless $self->{context} eq $self->_context_of($name);
  return $self->{vrf}{$name}{$what};
}
sub vrf_addresses { $_[0]->_vrf_answer('addresses', $_[1]) }
sub vrf_subnets { $_[0]->_vrf_answer('subnets', $_[1]) }
sub vrf_read_complete { $_[0]->_vrf_answer('complete', $_[1]) }

sub AUTOLOAD {
  my $self = shift;
  (my $method = $AUTOLOAD) =~ s/.*:://;
  return if $method eq 'DESTROY';
  $self->{reads}{$method}++;
  return $self->{$method};
}

package FakeRows;
sub new { my ($class, @rows) = @_; return bless { rows => [@rows] }, $class; }
sub reset { return $_[0] }
sub all { return @{ $_[0]->{rows}} }