view release on metacpan or  search on metacpan

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

Helper functions for L<SNMP::Info> instances.

There are no default exports, however the C<:all> tag will export all
subroutines.

=head1 EXPORT_OK

=head2 load_cache_for_device( $device )

Tries to find a device cache in database or on disk, or build one from
a net-snmp snmpwalk on disk. Returns a cache.

=cut

sub load_cache_for_device {
  my $device = shift;
  return {} unless ($device->is_pseudo or not $device->in_storage);

  my $pseudo_cache = catfile( catdir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'logs', 'snapshots'), $device->ip );
  my $loadmibs = schema('netdisco')->resultset('SNMPObject')->count;

  if (-f $pseudo_cache and not $loadmibs) {
      warning "device snapshot exists ($pseudo_cache) but no MIB data available.";
      warning 'skipping offline cache load - run a "loadmibs" job if you want this!';
      return {};
  }

  my %oids = ();

  # ideally we have a cache in the db
  if ($device->is_pseudo
      and not $device->oids->search({ -or => [
        -bool => \q{ array_length(oid_parts, 1) IS NULL },
        -bool => \q{ jsonb_typeof(value) != 'array' }, ] })->count) {

      my @rows = $device->oids->search({},{
          join => 'oid_fields',
          columns => [qw/oid value/],
          select => [qw/oid_fields.mib oid_fields.leaf/], as => [qw/mib leaf/],
      })->hri->all;

      $oids{$_->{oid}} = {
          %{ $_ },
          value => (@{ from_json($_->{value}) })[0],
      } for @rows;
  }
  # or we have an snmpwalk file on disk
  elsif (-f $pseudo_cache and not $device->in_storage) {
      debug sprintf "importing snmpwalk from disk ($pseudo_cache)";

      my @lines = read_lines($pseudo_cache);
      my %store = ();

      # sometimes we're given a snapshot with iso. instead of .1.
      if ($lines[0] !~ m/^.\d/) {
          warning 'snapshot file rejected - has translated names/values instead of numeric';
          return {};
      }

      # parse the snmpwalk output which looks like
      # .1.0.8802.1.1.2.1.1.1.0 = INTEGER: 30
      foreach my $line (@lines) {
          my ($oid, $type, $value) = $line =~ m/^(\S+)\s+=\s+(?:([^:]+):\s+)?(.+)$/;
          next unless $oid and $value;

          # empty string makes the capture go wonky
          $value = '' if $value =~ m/^[^:]+: ?$/;

          # remove quotes from strings
          $value =~ s/^"//;
          $value =~ s/"$//;

          $store{$oid} = {
            oid       => $oid,
            oid_parts => [], # not needed temporarily 
            value     => to_json([ ((defined $type and $type eq 'BASE64') ? $value
                                                                          : encode_base64(trim($value), '')) ]),
          };
      }

      # put into the database (temporarily)
      # this MUST happen here and not be refactored into make_snmpwalk_browsable
      # because make_snmpwalk_browsable is also called from snapshot job.
      # it will all be cleaned up after
      schema('netdisco')->txn_do(sub {
        $device->oids->delete;
        $device->oids->populate([values %store]);
      });

      # get back out of the database as tables with related snmp_object (for the enum)
      %oids = make_snmpwalk_browsable($device);
      $oids{$_}->{value} = (@{ from_json( $oids{$_}->{value} ) })[0]
        for keys %oids;
  }

  # inflate the cache to an SNMP::Info cache instance
  return snmpwalk_to_snmpinfo_cache(%oids);
}

=head2 make_snmpwalk_browsable( $device )

Takes the device_browser rows for a device and rewrites them to convert
table rows to hashref, enum values translated, and oid_parts filled.

=cut

sub make_snmpwalk_browsable {
  my $device = shift;
  my %oids = ();

  # to get relation from device_browser to snmp_object working for tables
  # we need to temporarily populate device_browser with potential table oids.
  # it will all be cleaned up after
  my %value_oids = map {($_ => 1)} $device->oids->get_column('oid')->all;
  my %table_oids = ();

  foreach my $orig_oid (keys %value_oids) {
      (my $oid = $orig_oid) =~ s/\.\d+$//;
      my $new_oid = '';