view release on metacpan or  search on metacpan

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

  return [ map { decode_snmp_data($_, $device, $field_label) } @$data ]
    if $type eq 'ARRAY';
  return { map { $_ => decode_snmp_data($data->{$_}, $device, $field_label) } keys %$data }
    if $type eq 'HASH';
  return $data if $type;

  return decode_snmp_text($data, $device, $field_label);
}

=head2 decode_cli_extra( $extra )

Decodes the C<-e> text given to C<netdisco-do> for a C<cf_> action, which
arrives as raw octets, with no device charsets. Undef and empty values are
returned unchanged.

=cut

sub decode_cli_extra {
  my ($extra) = @_;
  return decode_text_with($extra, []);
}

=head2 looks_garbled( $string )

True when the string holds a character from U+00C2 to U+00F4 followed by one
from U+0080 to U+00BF, which is how UTF-8 octets look when read as Latin-1,
and its characters read as octets are valid UTF-8. Correct text such as an
accented letter before a non-breaking space or a closing guillemet fails the
second test.

=cut

sub looks_garbled {
  my ($string) = @_;
  return 0 unless defined $string and $string =~ m/[\x{C2}-\x{F4}][\x{80}-\x{BF}]/;
  my $bytes = try { Encode::encode('iso-8859-1', $string, $CHECK) };
  return 0 unless defined $bytes;
  return (defined try { Encode::decode('UTF-8', $bytes, $CHECK) }) ? 1 : 0;
}

=head2 ungarble( $string, \@charsets )

Returns the text that C<$string> would have been had its characters been read
as octets, using C<decode_text_with>. Returns undef when the string holds a
character which Latin-1 cannot encode, so it cannot be garbled in that way.

=cut

sub ungarble {
  my ($string, $charsets) = @_;
  my $bytes = try { Encode::encode('iso-8859-1', $string, $CHECK) };
  return undef unless defined $bytes;
  return scalar decode_text_with($bytes, $charsets || []);
}

=head2 scan_config_encoding( $config )

Walks hashes (keys and values) and arrays in C<$config> and returns a list of
C<< { path => 'discover_no[2]', value => ..., suggestion => ... } >> for every
string which C<looks_garbled>. Other references are skipped. Reads only the
data it is given. Under the settings which hold device credentials
(C<device_auth>, C<snmp_auth>, C<community>, C<community_rw>) the value and
suggestion are C<(hidden)>.

=cut

my $CREDENTIAL_SETTINGS = qr/^(?:device_auth|snmp_auth|community|community_rw)\b/;

sub scan_config_encoding {
  my ($config) = @_;
  my @findings;
  _walk_config($config, '', \@findings);
  foreach my $finding (grep { $_->{path} =~ $CREDENTIAL_SETTINGS } @findings) {
    $finding->{$_} = '(hidden)' for qw/value suggestion/;
  }
  return @findings;
}

sub _walk_config {
  my ($node, $path, $findings) = @_;
  my $type = ref $node;

  if (!$type) {
    return unless looks_garbled($node);
    push @$findings, { path => $path, value => $node,
                       suggestion => ungarble($node, []) };
  }
  elsif ($type eq 'ARRAY') {
    _walk_config($node->[$_], "$path\[$_]", $findings) for 0 .. $#$node;
  }
  elsif ($type eq 'HASH') {
    foreach my $key (sort keys %$node) {
      my $child = length $path ? "$path.$key" : $key;
      _walk_config($key, "$child (key)", $findings) if looks_garbled($key);
      _walk_config($node->{$key}, $child, $findings);
    }
  }
}

=head2 scan_stored_encoding( $schema, $limit )

Reads the database only. Returns findings for stored text that looks garbled
or holds U+FFFD, in C<device.name>, C<description>, C<vendor>, C<os> and
C<os_ver>, C<device_port.descr>, C<device_vlan.description> and
C<device_port_ssid.ssid>. Each finding is
C<< { ip, column, value, suggestion } >> where C<suggestion> is undef for
U+FFFD, whose original octets are not recoverable. At most C<$limit>
findings are returned per column, followed by C<< { column, more => $count } >>
for the rest.

=cut

my @STORED_COLUMNS = (
  [Device => 'device', 'name'], [Device => 'device', 'description'],
  [Device => 'device', 'vendor'], [Device => 'device', 'os'],
  [Device => 'device', 'os_ver'], [DevicePort => 'device_port', 'descr'],
  [DeviceVlan => 'device_vlan', 'description'],
  [DevicePortSsid => 'device_port_ssid', 'ssid'],
);

sub scan_stored_encoding {