package DOCSIS::ConfigFile::Decode; =head1 NAME DOCSIS::ConfigFile::Decode - Decode functions for a DOCSIS config-file =head1 SYNOPSIS { oid => $str, type => $str, value = $str, } = snmp_object($binary_str); $bigint_object = bigint($binary_str); $int = int($binary_str); $uint = uint($binary_str); $ushort = ushort($binary_str); $uchar = uchar($binary_str); ( '0x001337' => [ { type => 24, # vendor specific type value => 42, # vendor specific value length => 1, # the length of the value meassured in bytes }, ... ], ) = vendorspec($binary_str); $ip_str = ip($binary_str); $hex_str = ether($binary_str); $uint = ether($binary_str); $str = string($binary_str); $hex_str = string($binary_str); $hex_str = hexstr($binary_str); $hex_str = mic($binary_str); =head1 DESCRIPTION This module has functions which is used to decode binary data into either plain strings or complex data structures, dependent on the function called. =cut use strict; use warnings; use bytes; use Carp qw/confess/; use Math::BigInt; use Socket; use DOCSIS::ConfigFile::Syminfo; our %SNMP_TYPE = ( 0x02 => [ 'INTEGER', \&int ], 0x04 => [ 'STRING', \&string, ], 0x05 => [ 'NULLOBJ', sub {} ], 0x40 => [ 'IPADDRESS', \&ip ], 0x41 => [ 'COUNTER', \&uint ], 0x42 => [ 'UNSIGNED', \&uint ], 0x43 => [ 'TIMETICKS', \&uint ], 0x44 => [ 'OPAQUE', \&uint ], 0x46 => [ 'COUNTER64', \&bigint ], ); =head1 FUNCTIONS =head2 snmp_object Will take a binary string and decode it into a complex datastructure, with "oid", "type" and "value". =cut sub snmp_object { my $bin = $_[0]; my($byte, $length, $oid, $type, $value); # message $type = _truncate_and_unpack(\$bin, 'C1'); # 0x30 $length = _snmp_length(\$bin); # oid $type = _truncate_and_unpack(\$bin, 'C1'); # 0x06 $length = _snmp_length(\$bin); $oid = _snmp_oid(\$bin, $length); # value $type = $SNMP_TYPE{ _truncate_and_unpack(\$bin, 'C1') }; $length = _snmp_length(\$bin); $value = $type->[1]->($bin); return { oid => $oid, type => $type->[0], value => $value }; } sub _snmp_length { my $length = _truncate_and_unpack($_[0], 'C1'); # length? if($length <= 0x80) { return $length; } elsif($length == 0x81) { return _truncate_and_unpack($_[0], 'C1'); } elsif($length == 0x82) { $length = 0; for my $byte (_truncate_and_unpack($_[0], 'C2')) { $length = $length << 8 | $byte; } return $length; } confess "Too long SNMP length: ($length)"; } sub _snmp_oid { my @bytes = _truncate_and_unpack($_[0], 'C' .$_[1]); my @oid = (0); my $subid = 0; for my $id (@bytes) { if($subid & 0xfe000000) { confess "_snmp_oid(@bytes): Sub-identifier too large: ($subid)" } $subid = ($subid << 7) | ($id & 0x7f); unless($id & 0x80) { confess "_snmp_oid(@bytes): Exceeded max length" if(128 <= @oid); push @oid, $subid; $subid = 0; } } # the first two sub-id are in the first id if($oid[1] == 0x2b) { # Handle the most common case $oid[0] = 1; $oid[1] = 3; } elsif($oid[1] < 40) { $oid[0] = 0; } elsif($oid[1] < 80) { $oid[0] = 1; $oid[1] -= 40; } else { $oid[0] = 2; $oid[1] -= 80; } return join '.', @oid; } sub _truncate_and_unpack { my($bin_ref, $type) = @_; my $n = ($type =~ /C/ ? 1 : 2) * ($type =~ /(\d+)/)[0]; if($$bin_ref =~ s/^(.{$n})//s) { return unpack $type, $1; } else { confess "_truncate_and_unpack('...', $type) failed to truncate binary string"; } } =head2 bigint $bigint_obj = bigint($bytestring); Returns a C<Math::BigInt> object. =cut sub bigint { my @bytes = unpack 'C*', _test_length(int => $_[0]); my $negative = $bytes[0] & 0x80; my $int64 = Math::BigInt->new(0); # setup int64 for my $chunk (@bytes) { $chunk ^= 0xff if($negative); $int64 = ($int64 << 8) | $chunk; } if($negative) { $int64 *= -1; $int64 -= 1; } return $int64; } =head2 int Will unpack the input string and return an integer, from -2147483648 to 2147483647. =cut sub int { my @bytes = unpack 'C*', _test_length(int => $_[0], 'int'); my $negative = $bytes[0] & 0x80; my $int = 0; for my $chunk (@bytes) { $chunk ^= 0xff if($negative); $int = ($int << 8) | $chunk; } if($negative) { $int *= -1; $int -= 1; } return $int; } =head2 uint Will unpack the input string and return an integer, from 0 to 4294967295. =cut sub uint { my @bytes = unpack 'C*', _test_length(uint => $_[0], 'int'); my $value = 0; $value = ($value << 8) | $_ for(@bytes); return $value; } =head2 ushort Will unpack the input string and return a short integer, from 0 to 65535. =cut sub ushort { return unpack 'n', _test_length(ushort => $_[0], 'short int'); } =head2 uchar Will unpack the input string and return a short integer, from 0 to 255. =cut sub uchar { return unpack 'C', _test_length(uchar => $_[0], 'char'); } =head2 vendorspec Will unpack the input string and return a complex datastructure, representing the vendor specific data. =cut sub vendorspec { my $bin = $_[0] || ''; my($vendor, @ret, $length); # extract length (not sure what the first byte is...) if($bin =~ s/^.(.)//) { $length = unpack 'C', $1; } else { confess 'Invalid vendorspec input. Could not extract length'; } # extract vendor if($bin =~ s/^(.{$length})//) { # find vendor $vendor = sprintf '0x' .('%02x' x $length), unpack 'C*', $1; } else { confess 'Invalid vendorspec input. Could not extract vendor'; } # extract TLV while($bin =~ s/^(.)(.)//) { my $type = unpack 'C*', $1; my $length = unpack 'C*', $2; if($bin =~ s/^(.{$length})//) { push @ret, { type => $type, length => $length, value => hexstr($1) }; } } if(my $length = length $bin) { confess "vendorspec('...') is left with ($length) bytes after decoding"; } return $vendor, \@ret; } =head2 ip Will unpack the input string and return a human readable IPv4 address. =cut sub ip { return inet_ntoa($_[0]) or confess 'inet_ntoa(...) failed to unpack binary string'; } =head2 ether Will unpack the input string and return a MAC address in this format: "00112233" or "00112233445566". =cut sub ether { my $bin = $_[0]; my $length = length $bin; unless($length == 6 or $length == 12) { confess "Invalid ether input. Invalid length ($length)"; } return join '', unpack 'H2' x $length, $bin; } =head2 string Returns human-readable string, where special characters are "uri encoded". Example: "%" = "%25" and " " = "%20". It can also return the value from L</hexstr> if it starts with a weird character, such as C<\x00>. =cut sub string { # not sure why this is able to join - may be removed later my $bin = @_ > 1 ? join('', map { chr $_ } @_) : $_[0]; if($bin =~ /^[^\t\n\r\x20-\xEF]/) { return hexstr($bin); } else { $bin =~ s/([^\x20-\x24\x26-\x7e])/{ sprintf "%%%02x", ord $1 }/ge; return $bin; } } =head2 hexstr Will unpack the input string and a string with leading "0x", followed by hexidesimal characters. =cut sub hexstr { return '0x' .join '', unpack 'H*', $_[0]; } =head2 mic Returns a value, printed as hex. =cut sub mic { &hexstr } =head2 no_value This method will return an empty string. It is used by DOCSIS types, which has zero length. =cut sub no_value { return ''; } sub _test_length { my $name = $_[0]; my $length = length $_[1]; if(!$length) { confess "$name(...) bytestring length is zero"; } if($_[2]) { my $max = DOCSIS::ConfigFile::Syminfo->byte_size($_[2]); confess "$name(...) bytestring length is invalid: $max < $length" if($max < $length); } return $_[1]; } =head1 AUTHOR =head1 BUGS =head1 SUPPORT =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE See L<DOCSIS::ConfigFile> =cut 1;