sub update results from the CPAN

sub update

App-Netdisco

view release on metacpan or search on metacpan

lib/App/Netdisco/Util/PortAccessEntity.pm view on Meta::CPAN


App::Netdisco::Util::PortAccessEntity

=head1 DESCRIPTION

Helper subroutines to update PAE details in device_port_properties
These are updated both during discover and macsuck.

=cut

sub update_pae_attributes {
  my ($device) = @_;
  no warnings "uninitialized";

  my $snmp = App::Netdisco::Transport::SNMP->reader_for($device)
    or return Status->defer("pae failed: could not SNMP connect to $device");
  debug sprintf ' [%s] pae - updating PortAccessEntity details', $device->ip;

  # device property
  my $pae_control = $snmp->pae_control();

lib/App/Netdisco/Util/Statistics.pm view on Meta::CPAN


=head1 EXPORT_OK

=head2 update_stats()

Update the Netdisco statistics, either new for today or updating today's
figures.

=cut

sub update_stats {
  my $schema = schema(vars->{'tenant'});
  eval { require SNMP::Info };
  my $snmpinfo_ver = ($@ ? 'n/a' : $SNMP::Info::VERSION);
  my $postgres_ver = postgres_version($schema->storage->dbh->{pg_server_version});

  # roll everything back if we're testing
  my $txn_guard = $ENV{ND2_DB_ROLLBACK}
    ? $schema->storage->txn_scope_guard : undef;

  # TODO: (when we have the capabilities table?)

xt/120-hint-over-stored-tag.t view on Meta::CPAN


use Test::More 0.88;
use App::Netdisco;
use App::Netdisco::Util::SNMP 'get_communities';
use Dancer qw/:script !pass/;

package FakeCommunity;
sub new    { my ($class, %v) = @_; return bless {%v}, $class }
sub snmp_auth_tag_read { return $_[0]->{snmp_auth_tag_read} }
sub snmp_comm_rw       { return $_[0]->{snmp_comm_rw} }
sub update { my ($self, $v) = @_; @$self{keys %$v} = values %$v; return $self }

package FakeDevice;
sub new       { my ($class, %v) = @_; return bless {%v}, $class }
sub ip        { return '192.0.2.1' }
sub dns       { return 'switch1.example.com' }
sub in_storage { return 1 }
sub snmp_comm { return $_[0]->{snmp_comm} }
sub community { return $_[0]->{community} }

package main;

xt/136-vrf-context-discovery.t view on Meta::CPAN


package FakeSNMP;
sub new { my ($class, %vals) = @_; return bless {context => '', %vals}, $class }
sub snmp_ver { $_[0]{snmp_ver} || 2 }
sub snmp_comm { 'labro' }
sub vtp_version { undef }
sub class { 'SNMP::Info::Layer3::Nexus' }
sub cache { }
sub cisco_comm_indexing { 1 }
sub vrf_name { { '3.114.101.100' => 'red', '4.98.108.117.101' => 'blue' } }
sub update {
  my ($self, %args) = @_;
  $self->{context} = exists $args{Context} ? $args{Context}
    : ($args{Community} =~ m/\@(.+)$/ ? $1 : '');
  push @{ $self->{contexts_asked} }, $self->{context};
}
sub _answer { my ($self, $table) = @_; return $self->{answers}{ $self->{context} }{$table} }
sub ip_index   { $_[0]->_answer('ip_index') }
sub ip_table   { $_[0]->_answer('ip_table') }
sub ip_netmask { $_[0]->_answer('ip_netmask') }
sub interfaces { $_[0]->_answer('interfaces') }

xt/145-topology-del-only-matched.t view on Meta::CPAN

sub new       { return bless {}, $_[0] }
sub txn_do    { return $_[1]->() }
sub resultset { return $_[0] }
sub search    { return $_[0] }
sub delete    { return $deleted }

package FakePorts;
sub new    { return bless { ip => $_[1] }, $_[0] }
sub search { my ($s, $q) = @_; return bless { %$s, port => $q->{port} }, ref $s }
sub single { return $_[0] }
sub update { my ($s, $v) = @_; push @updated, [ $s->{ip}, $s->{port}, $v ]; return $s }

package FakeDevice;
sub new        { return bless { ip => $_[1] }, $_[0] }
sub in_storage { 1 }
sub ports      { return FakePorts->new($_[0]->{ip}) }

package main;

no warnings 'redefine';
*Dancer::Plugin::Auth::Extensible::logged_in_user = sub { return { username => 'someone' } };

xt/159-macsuck-redundant-writes.t view on Meta::CPAN


set logger => 'null';

my $NODES = 'App::Netdisco::Worker::Plugin::Macsuck::Nodes';
my (@searched, @port_updates, $port_macs);

package FakeNodes;
sub new       { return bless {}, $_[0] }
sub resultset { return $_[0] }
sub search    { push @searched, $_[1]; return $_[0] }
sub update    { return 3 }

package FakePort;
sub new { my ($class, %col) = @_; return bless {%col}, $class }
sub port   { $_[0]{port} }
sub update {
  my ($self, $set) = @_;
  push @port_updates, [$self->{port}, $set];
  $self->{$_} = $set->{$_} for keys %$set;
  return $self;
}
for my $col (qw/is_uplink neighbor remote_ip remote_id remote_type slave_of is_master/) {
  no strict 'refs';
  *{"FakePort::$col"} = sub { $_[0]{$col} };
}

xt/165-incomplete-walks-for.t view on Meta::CPAN

}

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

package RecordingSNMP; # keeps walk_failures and walk_status
# the port tags worker runs inside discover::properties; its clear writes nothing here
{ package NoopTagsSchema; sub resultset { return $_[0] } sub search { return $_[0] } sub update { return 0 } }

sub new { my ($class, %vals) = @_; return bless { walk_failures => [], walk_status => {}, %vals }, $class; }
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { $_[0]{walk_status}{$_[1]} }

package PlainSNMP; # an SNMP::Info with no walk record
sub new { return bless {}, shift }

package FakeSNMP;
our $AUTOLOAD;

xt/167-discover-device-ip-upsert.t view on Meta::CPAN

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'];

package FakeSNMP;
our $AUTOLOAD;
# the port tags worker runs inside discover::properties; its clear writes nothing here
{ package NoopTagsSchema; sub resultset { return $_[0] } sub search { return $_[0] } sub update { return 0 } }

sub new { my ($class, %vals) = @_; return bless { walk_failures => [], %vals }, $class; }
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { $_[0]{walk_status}{$_[1]} }
sub AUTOLOAD {
  my $self = shift;
  (my $method = $AUTOLOAD) =~ s/.*:://;
  return if $method eq 'DESTROY';
  $self->{reads}{$method}++;
  # a failing walk records itself on its first read only, as a cached table does

xt/172-discover-device-port-upsert.t view on Meta::CPAN


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

package FakeSNMP;
our $AUTOLOAD;
# the port tags worker runs inside discover::properties; its clear writes nothing here
{ package NoopTagsSchema; sub resultset { return $_[0] } sub search { return $_[0] } sub update { return 0 } }

sub new { my ($class, %vals) = @_; return bless { walk_failures => [], %vals }, $class; }
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { $_[0]{walk_status}{$_[1]} }
sub AUTOLOAD {
  my $self = shift;
  (my $method = $AUTOLOAD) =~ s/.*:://;
  return if $method eq 'DESTROY';
  # a failing walk records itself on its first read only, as a cached table does
  if (my $failure = delete $self->{fail_on_read}{$method}) {

xt/175-discover-neighbor-columns.t view on Meta::CPAN

sub new { my ($class, %cols) = @_; return bless { manual_topo => 0, %cols }, $class; }
sub port { $_[0]{port} }
sub manual_topo { $_[0]{manual_topo} }
sub slave_of { $_[0]{slave_of} }
sub is_master { $_[0]{is_master} }
sub remote_port { $_[0]{remote_port} }
sub remote_ip { $_[0]{remote_ip} }
sub is_uplink { $_[0]{is_uplink} }
sub discard_changes { $_[0] }
sub store_column { my ($self, $col, $value) = @_; $self->{$col} = $value }
sub update {
  my ($self, $values) = @_;
  push @main::row_updates,
    [ $self->{owner}, $self->{port}, $values, $self, { map {($_ => $self->{$_})} keys %$values } ];
  push @main::update_depths, [ $self->{port}, $main::txn_depth ]
    if ref $values->{manual_topo} and ${ $values->{manual_topo} } eq 'true';
  foreach my $col (keys %$values) {
    my $value = $values->{$col};
    $self->{$col} = ref $value ? (${$value} eq 'true' ? 1 : 0) : $value;
  }
  return $self;

xt/175-discover-neighbor-columns.t view on Meta::CPAN

sub single { my ($self, $cond) = @_; return (grep { $_->port eq $cond->{port} } $self->all)[0] }
sub get_column { $_[0] }
sub as_query { \['(SELECT port FROM device_port WHERE ip = ?)'] }

package FakeDevicePortRS;
sub search { my ($self, $where) = @_; return bless { where => $where }, ref $self }
sub single {
  my ($self, $cond) = @_;
  return (grep { $_->{owner} eq $cond->{ip} and $_->port eq $cond->{port} } @main::port_rows)[0];
}
sub update {
  my ($self, $set) = @_;
  my ($sql, @bind) = DBIx::Class::SQLMaker->new->update('device_port', $set, $self->{where});
  push @main::port_updates, { sql => $sql, bind => [@bind], set => $set, depth => $main::txn_depth };
  return 0;
}

package FakeTopologyRS;
sub search { $_[0] }
sub delete { push @main::topology_delete_depths, $main::txn_depth; 0 }
sub next { shift @{ $_[0]{links} } }

xt/176-discover-port-tags-clear.t view on Meta::CPAN

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

config->{'device_auth'} = [{driver => 'snmp'}];

package RecordingRows;
our (@writes, @clears);
sub new { my ($class, $real, $is_clear) = @_; return bless { real => $real, clear => $is_clear }, $class }
sub update {
  my ($self, $set) = @_;
  my ($sql, @bind) = @{ ${ $self->{real}->as_query } };
  push @{ $self->{clear} ? \@clears : \@writes }, { set => $set, sql => $sql, bind => \@bind };
  return $self->{clear} ? 3 : 1;
}

package RecordingSchema;
# an offline PostgreSQL schema, so as_query builds the real SQL without a connection
our $offline = do {
  local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /unversioned/ };

xt/191-vrf-snmp-context.t view on Meta::CPAN

sub new {
  my ($class, %vals) = @_;
  return bless {session => {Community => 'labro', Context => ''}, updates => [], %vals}, $class;
}
sub snmp_ver { $_[0]{snmp_ver} || 2 }
sub snmp_comm { 'labro' }
sub vtp_version { undef }
sub class { 'SNMP::Info::Layer3::Fake' }
sub cache { }
sub session { $_[0]{session} }
sub update {
  my ($self, %args) = @_;
  push @{ $self->{updates} }, {%args};
  # SNMP::Info::update() keeps the old session and returns false on failure
  return if $self->{fail_update};
  $self->{session}{$_} = $args{$_} for keys %args;
  return $self->{session};
}

package main;

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

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;
}

xt/193-arpnip-vrf-collection.t view on Meta::CPAN

our $AUTOLOAD;

sub new {
  my ($class, %vals) = @_;
  return bless { walk_failures => [], context => '', contexts_asked => [], %vals }, $class;
}
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { undef }
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};
  return 1;
}

sub _context_of {
  my ($self, $name) = @_;
  my $ctx = $self->{instances}{$name}{contexts}[0];

xt/194-arpnip-subnets-vrf.t view on Meta::CPAN

our $AUTOLOAD;

sub new {
  my ($class, %vals) = @_;
  return bless { walk_failures => [], context => '', contexts_asked => [], %vals }, $class;
}
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { undef }
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};
  return 1;
}

sub _context_of {
  my ($self, $name) = @_;
  my $ctx = $self->{instances}{$name}{contexts}[0];

xt/195-arpnip-retire-unvouched.t view on Meta::CPAN

}

# stored: the VRFs this router's active rows sit in
sub run_retire {
  my ($stored, @args) = @_;
  @ran = (); $txns = 0; @stored_vrfs = @$stored;
  my $count = retire_unvouched_arps(device(), @args);
  return ($count, @ran);
}

sub updates_of { return grep { $_->[0] =~ m/^\s*UPDATE node_ip/ } @_ }
sub update_of { return (updates_of(@_))[0] }

# the named VRFs' UPDATE binds its list; the default table's names it in the SQL
sub retired_vrfs {
  my @updates = updates_of(@_) or return undef;
  my @vrfs = map { ($_->[0] =~ m/ANY/ ? @{ $_->[-1] } : ($_->[0] =~ m/vrf = ''\s*$/ ? '' : ())) } @updates;
  return [ sort @vrfs ];
}

subtest 'retire__switch_on__complete_vrfs_and_uncovered_vrfs_retired' => sub {
  my ($count, @stmts) = run_retire(['', 'gone', 'red'], $now, { '' => 1, red => 1 }, 1);

xt/204-arpnip-cli-subnets-vrf.t view on Meta::CPAN

}

# the SNMP side, as xt/194 fakes it: each context answers only for its VRF
package FakeSNMP;
our $AUTOLOAD;
sub new { my ($class, %vals) = @_; return bless { walk_failures => [], context => '', %vals }, $class }
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { undef }
sub snmp_ver { 2 }
sub snmp_comm { 'public' }
sub update {
  my ($self, %args) = @_;
  $self->{context} = exists $args{Context} ? $args{Context}
    : ($args{Community} =~ m/\@(.+)$/ ? $1 : '');
  return 1;
}
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};

xt/205-each-vrf-instance-context-probe.t view on Meta::CPAN

  $self->{session} = FakeSession->new($self);
  return $self;
}
sub snmp_ver { 2 }
sub snmp_comm { 'public' }
sub class { 'SNMP::Info::Layer3::Fake' }
sub session { $_[0]{session} }
sub walk_failures { $_[0]{walk_failures} }
sub error { my $self = shift; my $error = $self->{error}; $self->{error} = undef; return $error }
sub vrf_read_complete { 1 }
sub update {
  my ($self, %args) = @_;
  my $target = ($args{Community} =~ m/\@(.+)$/ ? $1 : '');
  # SNMP::Info::update() keeps the old session and returns false on failure
  if ($self->{fail_update_to}{$target}) {
    $self->{error} = $self->{update_error} if exists $self->{update_error};
    return;
  }
  $self->{context} = $target;
  return $self->{session} || 1;
}

xt/206-vrf-helper-branches.t view on Meta::CPAN

  my $got = with_settings(sub { vrf_instances_for($device, $snmp) }, store_vrfs => 1);
  is_deeply $got, {}, 'no instances, not undef';
};

{
  package ContextSNMP;
  sub new { bless { updates => [] }, shift }
  sub snmp_ver { 2 }
  sub snmp_comm { 'public' }
  sub class { 'SNMP::Info::Layer3' }
  sub update { my ($self, %args) = @_; push @{ $self->{updates} }, \%args; return 1 }
}

subtest 'snmp_vrf_context__context_without_kind_or_name__switched_or_refused' => sub {
  my $snmp = ContextSNMP->new;
  is snmp_vrf_context($snmp, $device, { contexts => [{ v2c => '%s@red' }] }), 1,
    'a context with no kind and no instance name is switched to';
  is_deeply $snmp->{updates}, [{ Community => 'public@red' }], 'with its template';
  is snmp_vrf_context($snmp, $device, { name => 'blue', contexts => [{ kind => 'vrf' }] }), undef,
    'no template for the version, no switch, undef as for a refused suffix';
  is scalar @{ $snmp->{updates} }, 1, 'nothing more sent';

xt/208-vrf-default-leak-exclusion.t view on Meta::CPAN

                     exclusions => [], complete => {}, %vals }, $class;
  $self->{session} = FakeSession->new($self);
  return $self;
}
sub snmp_ver { 2 }
sub snmp_comm { 'public' }
sub class { 'SNMP::Info::Layer3::Fake' }
sub session { $_[0]{session} }
sub walk_failures { $_[0]{walk_failures} }
sub error { my $self = shift; my $error = $self->{error}; $self->{error} = undef; return $error }
sub update {
  my ($self, %args) = @_;
  my $target = ($args{Community} =~ m/\@(.+)$/ ? $1 : '');
  # SNMP::Info::update() keeps the old session and returns false on failure
  return if $self->{fail_update_to}{$target};
  $self->{context} = $target;
  $self->{updates}++;
  # update() calls clear_cache(), which forgets recorded exclusions
  $self->{excluded} = {};
  return $self->{session};
}

xt/51-updated-device-hook.t view on Meta::CPAN


config->{'device_auth'} = [{driver => 'snmp'}];
config->{'enable_field_protection'} = 0; # unrelated feature, keep it out of the way
config->{'enable_incomplete_walk_protection'} = 1;
config->{'ignore_deviceports'} = [];     # ditto - avoid its device_ips() DB lookup
config->{'dns'}->{'no'} = ['0.0.0.0/0']; # skip real DNS resolution of the alias worker

package FakeSNMP;
our $AUTOLOAD;
# the port tags worker runs inside discover::properties; its clear writes nothing here
{ package NoopTagsSchema; sub resultset { return $_[0] } sub search { return $_[0] } sub update { return 0 } }

sub new { my ($class, %vals) = @_; return bless { walk_failures => [], %vals }, $class; }
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { $_[0]{walk_status}{$_[1]} }
sub AUTOLOAD {
  my $self = shift;
  (my $method = $AUTOLOAD) =~ s/.*:://;
  return if $method eq 'DESTROY';
  return $self->{$method};
}

xt/92-password-rehash-on-login.t view on Meta::CPAN

use Dancer::Plugin::Passphrase;
use App::Netdisco::Web::Auth::Provider::DBIC;

{ package Test::FakeRealm;
  sub new { bless {}, shift }
  sub realm_settings { return {} }
}
{ package Test::FakeUser;
  sub new { my ($c, %a) = @_; return bless { %a, updates => [] }, $c }
  sub password { $_[0]->{password} }
  sub update {
      my ($self, $data) = @_;
      push @{ $self->{updates} }, $data;
      $self->{password} = $data->{password};
      return $self;
  }
}

my $match    = \&App::Netdisco::Web::Auth::Provider::DBIC::match_with_local_pass;
my $is_stale = \&App::Netdisco::Web::Auth::Provider::DBIC::password_hash_is_stale;
my $PASSWORD = 'correct horse battery staple';

( run in 2.268 seconds using v1.01-cache-2.11-cpan-145b269f2f3 )