our
%SNMP_TYPE
= (
INTEGER
=> [ 0x02, \
&int
],
STRING
=> [ 0x04, \
&string
],
NULLOBJ
=> [ 0x05,
sub
{} ],
IPADDRESS
=> [ 0x40, \
&ip
],
COUNTER
=> [ 0x41, \
&uint
],
UNSIGNED
=> [ 0x42, \
&uint
],
TIMETICKS
=> [ 0x43, \
&uint
],
OPAQUE
=> [ 0x44, \
&uint
],
COUNTER64
=> [ 0x46, \
&bigint
],
);
sub
snmp_object {
my
$obj
= _test_value(
snmp_object
=>
$_
[0]);
my
$type
=
$SNMP_TYPE
{
$obj
->{
'type'
}} or confess
'Usage: snmp_object({ value => { type => ... })'
;
my
@value
=
$type
->[1]->({
value
=>
$obj
->{
'value'
},
snmp
=> 1 });
my
@oid
= _snmp_oid(
$obj
->{
'oid'
});
unless
(
@value
) {
confess
'Failed to decode SNMP value: '
.
$obj
->{
'value'
};
}
my
@oid_length
= _snmp_length(0 +
@oid
);
my
@value_length
= _snmp_length(0 +
@value
);
my
@total_length
= _snmp_length(3 +
@value
+
@oid
+
@value_length
);
return
(
0x30,
@total_length
,
0x06,
@oid_length
,
@oid
,
$type
->[0],
@value_length
,
@value
,
);
}
sub
_snmp_length {
my
$length
=
$_
[0];
my
@bytes
;
if
(
$length
< 0x80) {
return
$length
;
}
elsif
(
$length
< 0xff) {
return
0x81,
$length
;
}
elsif
(
$length
< 0xffff) {
while
(
$length
) {
unshift
@bytes
,
$length
& 0xff;
$length
>>= 8;
}
return
0x82,
@bytes
;
}
confess
"Too long snmp length: ($length)"
;
}
sub
_snmp_oid {
my
$string
=
$_
[0] or confess
'Usage: _snmp_oid($str)'
;
my
@input_oid
=
split
/\./,
$string
;
my
$subid
= 0;
my
@encoded_oid
;
{
my
$first
=
shift
@input_oid
;
my
$second
=
shift
@input_oid
;
push
@encoded_oid
,
$first
* 40 +
$second
;
}
SUB_OID:
for
my
$id
(
@input_oid
) {
if
(
$id
<= 0x7f) {
push
@encoded_oid
,
$id
;
}
else
{
my
@suboid
;
while
(
$id
) {
unshift
@suboid
, 0x80 | (
$id
& 0x7f);
$id
>>= 7;
}
$suboid
[-1] &= 0x7f;
push
@encoded_oid
,
@suboid
;
}
}
return
@encoded_oid
;
}
sub
bigint {
my
$value
= _test_value(
bigint
=>
$_
[0]);
my
$int64
= Math::BigInt->new(
$value
);
$int64
->is_nan and confess
"$value is not a number"
;
my
$negative
=
$int64
< 0;
my
@bytes
=
$negative
? (0x80) : ();
while
(
$int64
) {
my
$value
=
$int64
& 0xff;
$int64
>>= 8;
$value
^= 0xff
if
(
$negative
);
unshift
@bytes
,
$value
;
}
return
@bytes
?
@bytes
: (0);
}
sub
int
{
my
$obj
=
$_
[0];
my
$int
= _test_value(
int
=>
$obj
,
qr{^[+-]?\d{1,10}
$});
my
$negative
=
$int
< 0;
my
@bytes
;
while
(
$int
) {
my
$value
=
$int
& 0xff;
$int
>>= 8;
$value
^= 0xff
if
(
$negative
);
unshift
@bytes
,
$value
;
}
if
(!
$obj
->{
'snmp'
}) {
$bytes
[0] |= 0x80
if
(
$negative
);
unshift
@bytes
, 0
for
(1..4-
@bytes
);
}
if
(
@bytes
== 0) {
@bytes
= (0);
}
if
(
$obj
->{
'snmp'
}) {
unshift
@bytes
, 0
if
(!
$negative
and
$bytes
[0] > 0x79);
}
return
@bytes
;
}
sub
uint {
my
$obj
=
$_
[0];
my
$uint
= _test_value(
uint
=>
$obj
,
qr{^\+?\d{1,10}
$});
my
@bytes
;
while
(
$uint
) {
my
$value
=
$uint
& 0xff;
$uint
>>= 8;
unshift
@bytes
,
$value
;
}
if
(!
$obj
->{
'snmp'
}) {
unshift
@bytes
, 0
for
(1..4-
@bytes
);
}
if
(
@bytes
== 0) {
@bytes
= (0);
}
if
(
$obj
->{
'snmp'
}) {
unshift
@bytes
, 0
if
(
$bytes
[0] > 0x79);
}
return
@bytes
;
}
sub
ushort {
my
$obj
=
$_
[0];
my
$ushort
= _test_value(
ushort
=>
$obj
,
qr{^\+?\d{1,5}
$});
my
@bytes
;
if
(
$obj
->{
'snmp'
}) {
unshift
@bytes
, 0
if
(
$ushort
> 0x79);
}
while
(
$ushort
) {
my
$value
=
$ushort
& 0xff;
$ushort
>>= 8;
unshift
@bytes
,
$value
;
}
if
(!
$obj
->{
'snmp'
}) {
unshift
@bytes
, 0
for
(1..2-
@bytes
);
}
if
(
@bytes
== 0) {
@bytes
= (0);
}
return
@bytes
;
}
sub
uchar {
return
_test_value(
uchar
=>
$_
[0],
qr{\+?\d{1,3}
$});
}
sub
vendorspec {
my
$obj
=
$_
[0];
my
(
@vendor
,
@bytes
);
unless
(
ref
$obj
->{
'nested'
} eq
'ARRAY'
) {
confess
"vendor({ nested => ... }) is not an array ref"
;
}
@vendor
= ether(
$obj
);
@bytes
= (8, CORE::
int
(
@vendor
),
@vendor
);
TLV:
for
my
$tlv
(@{
$obj
->{
'nested'
} }) {
my
@value
= hexstr(
$tlv
);
push
@bytes
, uchar({
value
=>
$tlv
->{
'type'
} });
push
@bytes
, CORE::
int
(
@value
);
push
@bytes
,
@value
;
}
return
@bytes
;
}
sub
ip {
return
split
/\./, _test_value(
ip
=>
$_
[0],
qr{^(?:\d{1,3}
\.){3}\d{1,3}$});
}
sub
ether {
my
$string
= _test_value(
ether
=>
$_
[0]);
if
(
$string
=~
qr{^\+?[0-4294967295]$}
) {
return
uint({
value
=>
$string
});
}
elsif
(
$string
=~ /^(?:0x)?([0-9a-f]+)$/i) {
return
hexstr({
value
=> $1 });
}
confess
"ether({ value => $string }) is invalid"
;
}
sub
string {
my
$string
= _test_value(
string
=>
$_
[0]);
if
(
$string
=~ /^0x[a-f0-9]+$/i) {
return
hexstr(
@_
);
}
else
{
$string
=~ s/%(\w\w)/{
chr
hex
$1 }/ge;
return
map
{
ord
$_
}
split
//,
$string
;
}
}
sub
hexstr {
my
$string
= _test_value(
hexstr
=>
$_
[0],
qr{(?:0x)?([a-f0-9]+)}
i);
my
@bytes
;
$string
=~ s/^(?:0x)//;
while
(
$string
=~ s/(\w{1,2})$//) {
unshift
@bytes
,
hex
$1;
}
if
(
$string
) {
confess
"hexstr({ value => ... }) is left with ($string) after decoding"
;
}
return
@bytes
;
}
sub
mic {}
sub
no_value {}
sub
_test_value {
my
(
$name
,
$obj
,
$test
) =
@_
;
if
(!
defined
$obj
->{
'value'
}) {
confess
"$name({ value => ... }) received undefined value"
;
}
if
(
$test
and not
$obj
->{
'value'
} =~
$test
) {
confess
"$name({ value => "
.
$obj
->{
'value'
} .
" }) does not match $test"
;
}
return
$obj
->{
'value'
};
}
1;